>>SOURCE FREE REPLACE ==:BCOL:== BY ==BACKGROUND-COLOR== ==:FCOL:== BY ==FOREGROUND-COLOR==. IDENTIFICATION DIVISION. PROGRAM-ID. MASTER. *> GnuCOBOL sample ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. CRT STATUS IS wCRT-STATUS. CURSOR IS wCursorRowCol. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT Mas ASSIGN TO DISK "master.dat" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS mas-nom ALTERNATE KEY IS mas-pro WITH DUPLICATES FILE STATUS IS w-fsMas. SELECT Rep ASSIGN TO PRINTER "master-rep.txt" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS w-fsRep. DATA DIVISION. FILE SECTION. FD Mas LABEL RECORD IS STANDARD. 01 rec-mas. 02 mas-nom PIC X(20). 02 mas-ind. 03 mas-str PIC X(20). 03 mas-cit PIC X(15). 03 mas-pro PIC X(02). 02 mas-sex PIC A(01). 02 mas-age PIC 9(03). 02 mas-wei PIC 9(03). 02 mas-hei PIC 9(03). FD Rep LABEL RECORD IS OMITTED LINAGE IS 60 LINES LINES AT TOP 3 LINES AT BOTTOM 3. 01 rec-Rep. 02 Rep-row PIC X(80). WORKING-STORAGE SECTION. 77 K-ESCAPE PIC 9(04) VALUE 2005. 77 K-ENTER PIC 9(04) VALUE 0000. 77 K-PAGEUP PIC 9(04) VALUE 2001. 77 K-PAGEDOWN PIC 9(04) VALUE 2002. *> mouse mask, apply to COB_MOUSE_FLAGS 78 COB-AUTO-MOUSE-HANDLING VALUE 1. 78 COB-ALLOW-LEFT-DOWN VALUE 2. 78 COB-ALLOW-LEFT-UP VALUE 4. 78 COB-ALLOW-LEFT-DOUBLE VALUE 8. 78 COB-ALLOW-MIDDLE-DOWN VALUE 16. 78 COB-ALLOW-MIDDLE-UP VALUE 32. 78 COB-ALLOW-MIDDLE-DOUBLE VALUE 64. 78 COB-ALLOW-RIGHT-DOWN VALUE 128. 78 COB-ALLOW-RIGHT-UP VALUE 256. 78 COB-ALLOW-RIGHT-DOUBLE VALUE 512. 78 COB-ALLOW-MOUSE-MOVE VALUE 1024. 01 COB-MOUSE-FLAGS PIC 9(04). 01 wCRT-STATUS PIC 9(04) value zero. 01 wCursorRowCol PIC 9(06) value 000000. 01 redefines wCursorRowCol . 05 wCursorRow Pic 9(03). 05 wCursorCol Pic 9(03). 01 Black constant as 00. 01 Blue constant as 01. 01 Green constant as 02. 01 Cyan constant as 03. 01 Red constant as 04. 01 Magenta constant as 05. 01 Brown constant as 06. *> old color code as yellow 01 White constant as 07. *> or Light Gray 01 Grey constant as 08. *> or Dark Gray 01 LightBlack constant as 08. *> same color code as Grey 01 LightBlue constant as 09. 01 LightGreen constant as 10. 01 LightCyan constant as 11. 01 LightRed constant as 12. 01 LightMagenta constant as 13. 01 Pink constant as 13. 01 Yellow constant as 14. 01 LightWhite constant as 15. 77 w-fsMas PIC X(2). 77 w-fsRep PIC X(2). 77 w-flag PIC A(2). 01 w-rec-lock PIC A(2). 88 rec-available VALUE SPACES. 88 rec-blocked VALUE "xx". 77 w-dashes PIC X(80) VALUE ALL "-". 77 w-char PIC X(01). 77 w-char2 PIC 9(02). 77 w-Key PIC 9(02). 77 w-choice PIC 9(02). 77 w-operat PIC X(23). 77 w-mex PIC X(50). 77 w-EOF PIC A(02). 77 w-exist PIC A(02). 77 w-open-mode PIC A(3). 77 wROW PIC 9(02). 77 wCOL PIC 9(02). 77 wI PIC 9(02). 77 wJ PIC 9(02). 01 w-data. 02 w-yy PIC 9(2). 02 w-mm PIC 9(2). 02 w-dd PIC 9(2). 01 w-data-vis. 02 w-dd PIC X(2). 02 FILLER PIC X(1) VALUE "/". 02 w-mm PIC X(2). 02 FILLER PIC X(1) VALUE "/". 02 w-yy PIC X(2). 01 w-var-selection. 02 w-name1 PIC X. 02 w-name2 PIC X(20). 02 w-provx PIC A(02). 02 w-sexx PIC A(01). 02 w-ordi PIC A(01). 01 w-Rep-header. 02 FILLER PIC X(23) VALUE " MASTER - Master File ". 02 FILLER PIC X(09) VALUE "Name from". 02 w-r-n1 PIC X(10). 02 FILLER PIC X(04) VALUE "to: ". 02 w-r-n2 PIC X(10). 02 FILLER PIC X(10) VALUE " - Prov.: ". 02 w-r-pr PIC X(02). 02 FILLER PIC X(10) VALUE " - Sex : ". 02 w-r-sx PIC X(01). 01 w-Rep-and-List-head. 02 w-did PIC X(80) VALUE " Name Street City Prov Sex Age Wei Hei". 01 w-riga-mas. 02 FILLER PIC X(1) VALUE " ". 02 w-name PIC X(20). 02 FILLER PIC X(1) VALUE " ". 02 w-address. 03 w-str PIC X(20). 03 FILLER PIC X(1) VALUE " ". 03 w-city PIC X(15). 03 FILLER PIC X(1) VALUE " ". 03 w-prov PIC X(2). 03 FILLER PIC X(3) VALUE " ". 02 w-sex PIC A(1). 02 FILLER PIC X(2) VALUE " ". 02 w-age PIC Z(3) BLANK WHEN ZERO. 02 FILLER PIC X(1) VALUE " ". 02 w-weight PIC Z(3) BLANK WHEN ZERO. 02 FILLER PIC X(1) VALUE " ". 02 w-height PIC Z(3) BLANK WHEN ZERO. 01 w-statistics. 02 w-stat-rig OCCURS 4 TIMES. 03 w-stat OCCURS 4 TIMES PIC 9(6). SCREEN SECTION. 01 screen-cls. 02 BLANK SCREEN. 01 screen-menu. 02 BLANK SCREEN :FCOL: WHITE :BCOL: GREEN . 02 LINE + 1 COL 10 VALUE " MASTER " REVERSE. 02 COL 20 VALUE "GnuCOBOL utility program" :FCOL: LIGHTMAGENTA. 02 LINE + 1 COL 20 VALUE "Sample of Master File Management":FCOL: LIGHTCYAN . 02 LINE 02 COL 70 PIC X(8) FROM w-data-vis :FCOL: WHITE. 02 LINE 04 COL 01 BLANK ZERO :FCOL: BLACK :BCOL: WHITE. 02 LINE 07 COL 15 VALUE " 01 - Add ". 02 LINE + 2 COL 15 VALUE " 02 - Update ". 02 LINE + 2 COL 15 VALUE " 03 - Delete ". 02 LINE + 2 COL 15 VALUE " 04 - Inquiry ". 02 LINE + 2 COL 15 VALUE " 05 - List ". 02 LINE 07 COL 45 VALUE " 06 - Print ". 02 LINE + 2 COL 45 VALUE " 07 - Statistics ". 02 LINE + 2 COL 45 VALUE " 08 - ... ". 02 LINE + 2 COL 45 VALUE " 09 - ... ". 02 LINE + 2 COL 45 VALUE " 10 - Create/Delete ALL". 02 LINE 07 COL 15 VALUE " 01 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 15 VALUE " 02 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 15 VALUE " 03 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 15 VALUE " 04 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 15 VALUE " 05 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE 07 COL 45 VALUE " 06 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 45 VALUE " 07 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 45 VALUE " 08 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 45 VALUE " 09 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 2 COL 45 VALUE " 10 " :FCOL: BLACK :BCOL: YELLOW. 02 LINE + 3 COL 38 VALUE " Select (ESC to exit)" :FCOL: BLACK :BCOL: WHITE. 02 COL 33 PIC 9(2) TO w-char2 AUTO-SKIP :FCOL: WHITE :BCOL: BLUE. 02 LINE 24 COL 01 BLANK ZERO :FCOL: WHITE :BCOL: BLUE. 01 screen-intest. 02 BLANK SCREEN :FCOL: WHITE :BCOL: BLUE. 02 LINE 01 COL 01 BLANK LINE :BCOL: WHITE. 02 LINE 02 COL 01 BLANK LINE. 02 LINE 02 COL 10 VALUE " MASTER " :FCOL: WHITE :BCOL: BLUE. 02 LINE 02 COL 20 PIC X(23) FROM w-operat :FCOL: LIGHTWHITE :BCOL: CYAN. 02 LINE 03 COL 01 BLANK LINE. 02 LINE 04 COL 01 BLANK LINE :FCOL: WHITE :BCOL: BLUE. 02 LINE 24 COL 01 BLANK ZERO. 01 screen-mex-1. 02 LINE 24 COL 10 PIC X(48) FROM w-mex :FCOL: BLUE :BCOL: WHITE. 02 LINE 24 COL 60 PIC X(01) TO w-char AUTO. 01 screen-mex-2. 02 LINE 24 COL 10 VALUE " " BLANK ZERO :FCOL: BLUE :BCOL: WHITE. 02 LINE 23 COL 01 VALUE " " :FCOL: WHITE :BCOL: BLUE. 01 screen-mas-name. 02 LINE 06 COL 10 VALUE "Name" BLANK LINE. 02 LINE 06 COL 30 PIC X(20) AUTO-SKIP USING mas-nom. 02 LINE + 2 COL 10 VALUE "Address:Street" BLANK LINE. 02 LINE + 1 COL 10 VALUE " City" BLANK LINE. 02 LINE + 1 COL 10 VALUE " Province" BLANK LINE. 02 LINE + 2 COL 10 VALUE "Sex " BLANK LINE. 02 LINE + 2 COL 10 VALUE "Age" BLANK LINE. 02 LINE + 2 COL 10 VALUE "Weight" BLANK LINE. 02 LINE + 2 COL 10 VALUE "Height" BLANK LINE. 01 screen-mas-data. 02 LINE 06 COL 30 PIC X(20) FROM mas-nom HIGHLIGHT. 02 LINE + 2 COL 30 PIC X(20) AUTO-SKIP USING mas-str HIGHLIGHT. 02 LINE + 1 COL 30 PIC X(15) AUTO-SKIP USING mas-cit HIGHLIGHT. 02 LINE + 1 COL 30 PIC X(2) AUTO-SKIP USING mas-pro HIGHLIGHT. 02 LINE + 2 COL 30 PIC A(1) AUTO-SKIP USING mas-sex HIGHLIGHT. 02 LINE + 2 COL 30 PIC 9(3) AUTO-SKIP USING mas-age HIGHLIGHT. 02 LINE + 2 COL 30 PIC 9(3) AUTO-SKIP USING mas-wei HIGHLIGHT. 02 LINE + 2 COL 30 PIC 9(3) AUTO-SKIP USING mas-hei HIGHLIGHT. 01 screen-selection. 02 LINE 06 COL 20 VALUE " SELECTION FILTER " :FCOL: BLACK :BCOL: BROWN. 02 LINE 08 COL 20 VALUE "Sort by Name / Prov :" :FCOL: WHITE :BCOL: BLUE. 02 LINE + 2 COL 20 VALUE "Name from:". 02 LINE + 2 COL 20 VALUE "Name to :". 02 LINE + 2 COL 20 VALUE "Prov :". 02 LINE + 2 COL 20 VALUE "Sex :". 02 LINE 08 COL 50 PIC A(01) AUTO-SKIP USING w-ordi HIGHLIGHT. 02 LINE + 2 COL 35 PIC X(20) AUTO-SKIP USING w-name1 HIGHLIGHT. 02 LINE + 2 COL 35 PIC X(20) AUTO-SKIP USING w-name2 HIGHLIGHT. 02 LINE + 2 COL 35 PIC X(02) AUTO-SKIP USING w-provx HIGHLIGHT. 02 LINE + 2 COL 35 PIC A(01) AUTO-SKIP USING w-sexx HIGHLIGHT. 01 screen-List-header. 02 LINE 04 COL 01 BLANK ZERO. 02 LINE 04 COL 01 PIC X(80) FROM w-Rep-and-List-head. 02 LINE 05 COL 01 PIC X(80) FROM w-dashes. 01 screen-statistics. 02 LINE 04 COL 01 BLANK ZERO. 02 LINE 06 COL 24 VALUE "CALCULATED AVERAGE VALUES " :FCOL: BLACK :BCOL: BROWN. 02 LINE 08 COL 24 VALUE "Totals Age Weight Height " :FCOL: WHITE :BCOL: BLUE. 02 LINE 10 COL 10 VALUE "Male". 02 LINE 12 COL 10 VALUE "Female". 02 LINE 14 COL 10 VALUE "Other". 02 LINE 16 COL 10 VALUE "ALL". *> ****************************************************************** *> *> ****************************************************************** PROCEDURE DIVISION. DECLARATIVES. err-mas SECTION. USE AFTER ERROR PROCEDURE ON Mas. err-mas-x.*> ERRORS ON MASTER FILE "Mas" IF w-fsMas = "35" THEN *> if file not exist (after OPEN INPUT/I-O) it will be created DISPLAY "MASTER FILE does not exist" LINE 20 POS 10 OPEN OUTPUT Mas CLOSE Mas DISPLAY "MASTER FILE created - [ENTER]" LINE 21 POS 10 ACCEPT w-char LINE 21 POS 45 DISPLAY " " LINE 20 POS 1 ERASE EOL DISPLAY " " LINE 21 POS 1 ERASE EOL IF w-open-mode = "INP" THEN OPEN INPUT Mas END-IF IF w-open-mode = "I-O" THEN OPEN I-O Mas END-IF ELSE IF w-fsMas = "99" THEN *> try to read (I-O) a record for update or delete *> a blocked record (lock) from other user (in I-O) MOVE "xx" TO w-rec-lock ELSE DISPLAY "Error " w-fsMas " on MASTER FILE " STOP RUN END-IF END-IF. ex-err-mas-x. EXIT. err-Rep SECTION. USE AFTER ERROR PROCEDURE ON Rep. err-Rep-x.*> ERRORS ON REPORT IF w-fsRep = "30" THEN DISPLAY "Printer is not available. R-retry A-abort" LINE 20 POS 1 MOVE " " TO w-char PERFORM UNTIL w-char = "R" OR w-char = "r" OR w-char = "A" OR w-char = "a" ACCEPT w-char LINE 20 POS 65 END-PERFORM DISPLAY " " LINE 20 POS 1 ERASE EOL IF w-char = "R" OR w-char = "a" THEN OPEN OUTPUT Rep MOVE "ok" TO w-flag ELSE MOVE "N " TO w-flag END-IF ELSE DISPLAY "Error " w-fsRep " on REPORT FILE " STOP RUN END-IF. ex-err-Rep-x. EXIT. END DECLARATIVES. *> ****************************************************************** *> *> ****************************************************************** MAIN1 SECTION. MAIN-LOOP. perform InitialSettings thru InitialSettingsEx PERFORM UNTIL wCRT-STATUS = K-ESCAPE DISPLAY screen-menu ACCEPT screen-menu IF wCRT-STATUS = K-ESCAPE then EXIT perform END-IF IF w-char2 NOT < 01 AND w-char2 NOT > 10 THEN MOVE w-char2 TO w-Key END-IF MOVE w-Key TO w-choice EVALUATE w-choice WHEN 1 THRU 3 PERFORM add-upd-del WHEN 4 PERFORM inquiry WHEN 5 THRU 6 PERFORM sel-List-Rep WHEN 7 PERFORM statistics WHEN 10 PERFORM create END-EVALUATE END-PERFORM. STOP RUN. ex-MAIN-LOOP. *> ****************************************************************** *> *> *> ****************************************************************** add-upd-del.*> 01 / 02 / 03 : add / update /delete a Master File record MOVE SPACES TO rec-mas IF w-choice = 1 THEN MOVE " RECORD ADD " TO w-operat ELSE IF w-choice = 2 THEN MOVE " RECORD UPDATE " TO w-operat ELSE MOVE " RECORD DELETE " TO w-operat END-IF END-IF DISPLAY screen-intest MOVE "I-O" TO w-open-mode OPEN I-O Mas MOVE SPACES TO rec-mas PERFORM UNTIL wCRT-STATUS = K-ESCAPE DISPLAY screen-mas-data DISPLAY screen-mas-name DISPLAY "[ ESC/empty = end ]" LINE 6 POS 60 *> LOW ACCEPT screen-mas-name *> ACCEPT w-Key FROM ESCAPE KEY IF mas-nom = SPACES THEN MOVE K-ESCAPE to wCRT-STATUS END-IF IF wCRT-STATUS NOT = K-ESCAPE THEN PERFORM RecRead IF w-exist = "Y " AND w-choice = 1 THEN DISPLAY screen-mas-data MOVE "Record already exist" TO w-mex PERFORM aCommand ELSE IF w-exist = "N " AND ( w-choice = 2 OR w-choice = 3 ) THEN MOVE "Record not found " TO w-mex PERFORM aCommand ELSE IF w-choice = 1 THEN PERFORM RecAdd ELSE IF w-choice = 2 THEN PERFORM RecUpdate ELSE IF w-choice = 3 THEN PERFORM RecDelete END-IF END-IF END-IF END-IF END-IF END-IF MOVE SPACES TO rec-mas END-PERFORM. move zero to wCRT-STATUS CLOSE Mas MOVE 0 TO w-Key. ex-add-upd-del. EXIT. RecAdd. *> 01 DISPLAY screen-mas-data ACCEPT screen-mas-data MOVE "[C] Confirm Add [ESC] exit " TO w-mex PERFORM aCommand if wCRT-STATUS = K-ESCAPE then move zero to wCRT-STATUS go to ex-RecAdd end-if IF w-char = "C" OR w-char = "c" THEN WRITE rec-mas INVALID KEY DISPLAY "Add Error: Record alreay exist" BEEP LINE 22 POS 45 ACCEPT w-char LINE 22 POS 70 NOT INVALID KEY DISPLAY "Record added" BEEP LINE 22 POS 45 ACCEPT omitted LINE 22 POS 70 DISPLAY " " LINE 22 POS 45 END-WRITE END-IF. ex-RecAdd. EXIT. RecUpdate.*> 02 DISPLAY screen-mas-data ACCEPT screen-mas-data MOVE "[C] Confirm Update [ESC] exit " TO w-mex PERFORM aCommand if wCRT-STATUS = K-ESCAPE then move zero to wCRT-STATUS go to ex-RecUpdate end-if IF w-char = "C" OR w-char = "c" THEN REWRITE rec-mas INVALID KEY DISPLAY "Update Error Record not found" BEEP LINE 22 POS 45 ACCEPT w-char LINE 22 POS 70 NOT INVALID KEY DISPLAY "Record updated" BEEP LINE 22 POS 45 ACCEPT omitted LINE 22 POS 70 DISPLAY " " LINE 22 POSITION 45 END-REWRITE END-IF. ex-RecUpdate. EXIT. RecDelete.*> 03 DISPLAY screen-mas-data MOVE "[C] Confirm Delete [ESC] exit " TO w-mex PERFORM aCommand if wCRT-STATUS = K-ESCAPE then move zero to wCRT-STATUS go to ex-RecDelete end-if IF w-char = "C" OR w-char = "c" THEN DELETE Mas INVALID KEY DISPLAY "Delete Error Record not found " BEEP LINE 22 POS 45 ACCEPT w-char LINE 22 POS 70 NOT INVALID KEY DISPLAY "Record deleted" LINE 22 POS 45 BEEP ACCEPT omitted LINE 22 POS 70 DISPLAY " " LINE 22 POS 45 END-DELETE END-IF. ex-RecDelete. EXIT. inquiry.*> 04 MOVE SPACES TO rec-mas MOVE " INQUIRY " TO w-operat DISPLAY screen-intest MOVE "INP" TO w-open-mode OPEN INPUT Mas MOVE "N " TO w-exist PERFORM UNTIL wCRT-STATUS = K-ESCAPE DISPLAY "[ESC exit] [PgUp first] [PgDn next] [Enter pref]" LINE 22 POS 10 DISPLAY screen-mas-name DISPLAY screen-mas-data ACCEPT screen-mas-name IF wCRT-STATUS = K-ENTER AND mas-nom NOT = SPACES THEN PERFORM inq-prefix ELSE IF wCRT-STATUS = K-PAGEUP THEN PERFORM inq-first ELSE IF wCRT-STATUS = K-PAGEDOWN PERFORM inq-next END-IF END-IF END-IF IF w-exist = "Y " THEN DISPLAY screen-mas-data END-IF END-PERFORM. CLOSE Mas move zero to wCRT-STATUS MOVE 0 TO w-Key. ex-inquiry. EXIT. inq-prefix.*> read for prefix START Mas KEY IS NOT < mas-nom INVALID KEY MOVE "N " TO w-exist NOT INVALID KEY MOVE "Y " TO w-exist END-START IF w-exist = "Y " THEN READ Mas NEXT RECORD END-IF. ex-inq-prefix. EXIT. inq-first. MOVE SPACES TO mas-nom START Mas KEY IS NOT < mas-nom INVALID KEY MOVE "N " TO w-exist NOT INVALID KEY MOVE "Y " TO w-exist END-START IF w-exist = "Y " THEN READ Mas NEXT RECORD END-IF. ex-inq-first. EXIT. inq-next. IF w-exist = "Y " THEN READ Mas NEXT RECORD AT END MOVE "N " TO w-exist NOT AT END MOVE "Y " TO w-exist END-READ END-IF. ex-inq-next. EXIT. sel-List-Rep. *> 05 / 06 LIST , Print REPORT MOVE "ok" TO w-flag MOVE "INP" TO w-open-mode OPEN INPUT Mas IF w-choice = 6 THEN OPEN OUTPUT Rep END-IF IF w-choice = 5 THEN MOVE " LIST " TO w-operat ELSE IF w-choice = 6 THEN MOVE " PRINT " TO w-operat END-IF END-IF IF w-flag = "ok" THEN *> w-flag = "N " from DECLARATIVES . printer is off MOVE SPACES TO w-var-selection MOVE "zzzzz" TO w-name2 MOVE "N" TO w-ordi DISPLAY screen-intest DISPLAY screen-selection ACCEPT screen-selection IF wCRT-STATUS not = K-ESCAPE MOVE "[C] confirm selection [ESC] exit " TO w-mex PERFORM aCommand IF w-char = "C" OR w-char = "c" MOVE 6 TO wROW IF w-choice = 5 THEN PERFORM List-intest ELSE IF w-choice = 6 THEN PERFORM Rep-intest END-IF END-IF MOVE w-name1 TO mas-nom MOVE w-provx TO mas-pro IF w-ordi = "N" THEN *> primary key "mas-nom" START Mas KEY IS NOT < mas-nom INVALID KEY MOVE "Y " TO w-EOF NOT INVALID KEY MOVE "N " TO w-EOF END-START ELSE *> alternate index key START Mas KEY IS NOT < mas-pro INVALID KEY MOVE "Y " TO w-EOF NOT INVALID KEY MOVE "N " TO w-EOF END-START END-IF IF w-EOF = "N " THEN READ Mas NEXT RECORD *> check if must end for limit overcoming IF ( w-ordi = "N" AND mas-nom > w-name2 ) OR ( w-ordi = "P" AND w-provx NOT = SPACES AND mas-pro > w-provx ) MOVE "Y " TO w-EOF END-IF END-IF *> reading cycle for Inq/Rep PERFORM cycle-List-Rep UNTIL w-EOF = "Y " IF w-choice = 5 THEN MOVE "[ENTER]" TO w-mex PERFORM aCommand ELSE IF w-choice = 6 THEN MOVE SPACES TO rec-Rep WRITE rec-Rep BEFORE ADVANCING PAGE *> page break *> TEST TEST MOVE "REPORT master-rep.txt CREATED [ENTER] to return" TO w-mex PERFORM aCommand END-IF END-IF END-IF END-IF END-IF CLOSE Mas. IF w-choice = 6 AND w-flag = "ok" THEN CLOSE Rep END-IF MOVE 0 TO w-Key. move zero to wCRT-STATUS. ex-sel-List-Rep. EXIT. cycle-List-Rep. *> check selection filter IF ( w-sexx = SPACE OR w-sexx = mas-sex ) AND ( w-provx = SPACES OR w-provx = mas-pro ) AND ( w-name1 NOT > mas-nom AND mas-nom NOT > w-name2 ) THEN MOVE mas-nom TO w-name MOVE mas-str TO w-str MOVE mas-cit TO w-city MOVE mas-pro TO w-prov MOVE mas-sex TO w-sex MOVE mas-age TO w-age MOVE mas-wei TO w-weight MOVE mas-hei TO w-height IF w-choice = 5 THEN DISPLAY w-riga-mas LINE wROW POS 1 IF wROW = 20 THEN MOVE "[ENTER]" TO w-mex PERFORM aCommand MOVE 6 TO wROW PERFORM List-intest ELSE ADD 1 TO wROW END-IF ELSE WRITE rec-Rep FROM w-riga-mas END-IF END-IF READ Mas NEXT RECORD AT END MOVE "Y " TO w-EOF NOT AT END MOVE "N " TO w-EOF END-READ. *> check if must end for limit overcoming IF ( w-ordi = "N" AND mas-nom > w-name2 ) OR ( w-ordi = "P" AND w-provx NOT = SPACES AND mas-pro > w-provx ) MOVE "Y " TO w-EOF END-IF. ex-cycle-List-Rep. EXIT. List-intest. DISPLAY ' ' AT 0101 WITH ERASE EOS DISPLAY screen-intest DISPLAY screen-List-header. ex-List-intest. EXIT. Rep-intest.*> REPORT HEADER MOVE w-name1 TO w-r-n1 MOVE w-name2 TO w-r-n2 MOVE w-provx TO w-r-pr MOVE w-sexx TO w-r-sx WRITE rec-Rep FROM w-dashes AFTER ADVANCING 1 LINES WRITE rec-Rep FROM w-Rep-header WRITE rec-Rep FROM w-dashes WRITE rec-Rep FROM w-Rep-and-List-head AFTER ADVANCING 2 LINES WRITE rec-Rep FROM w-dashes. ex-Rep-intest. EXIT. statistics. MOVE "INP" TO w-open-mode OPEN INPUT Mas MOVE " STATISTICS " TO w-operat DISPLAY screen-intest MOVE "[C] confitm selection [ESC] exit " TO w-mex PERFORM aCommand IF w-char = "C" OR w-char = "c" DISPLAY "Please wait - System is running ... " LINE 20 POS 10 HIGHLIGHT BLINK MOVE ZEROES TO w-statistics MOVE SPACES TO mas-nom START Mas KEY IS NOT < mas-nom INVALID KEY MOVE "Y " TO w-EOF NOT INVALID KEY MOVE "N " TO w-EOF END-START IF w-EOF = "N " THEN READ Mas NEXT RECORD END-IF PERFORM UNTIL w-EOF = "Y " IF mas-sex = "M" OR mas-sex = "m" THEN MOVE 1 TO wI ELSE IF mas-sex = "F" OR mas-sex = "f" THEN MOVE 2 TO wI ELSE MOVE 3 TO wI END-IF END-IF ADD 1 TO w-stat(wI , 1) ADD mas-age TO w-stat(wI , 2) ADD mas-wei TO w-stat(wI , 3) ADD mas-hei TO w-stat(wI , 4) READ Mas NEXT RECORD AT END MOVE "Y " TO w-EOF END-READ END-PERFORM *> totals on last table row PERFORM VARYING wI FROM 1 BY 1 UNTIL wI > 3 AFTER wJ FROM 1 BY 1 UNTIL wJ > 4 ADD w-stat(wI , wJ) TO w-stat(4 , wJ) END-PERFORM *> average calculation PERFORM VARYING wI FROM 1 BY 1 UNTIL wI > 4 IF w-stat(wI , 1) > 0 COMPUTE w-stat(wI , 2) = w-stat(wI , 2) / w-stat(wI , 1) COMPUTE w-stat(wI , 3) = w-stat(wI , 3) / w-stat(wI , 1) COMPUTE w-stat(wI , 4) = w-stat(wI , 4) / w-stat(wI , 1) END-IF END-PERFORM DISPLAY screen-statistics PERFORM VARYING wI FROM 1 BY 1 UNTIL wI > 4 AFTER wJ FROM 1 BY 1 UNTIL wJ > 4 COMPUTE wROW = 8 + ( wI * 2 ) COMPUTE wCOL = 15 + ( wJ * 9 ) DISPLAY w-stat(wI , wJ) HIGHLIGHT LINE wROW POS wCOL *> CONVERT END-PERFORM END-IF MOVE "[ENTER]" To w-mex PERFORM aCommand CLOSE Mas. MOVE 0 TO w-Key. move zero to wCRT-STATUS. ex-statistics. EXIT. create.*> 10 MOVE " CREATION / (DELETE FILE IF EXIST !) " TO w-operat DISPLAY screen-intest DISPLAY "WARNING ! if FILE exist it will be DELETED !" LINE 5 POS 10 MOVE "[C] confirm [ESC] exit " TO w-mex PERFORM aCommand IF w-char = "C" OR w-char = "c" THEN MOVE "OUT" TO w-open-mode OPEN OUTPUT Mas CLOSE Mas MOVE "FILE CREATED" TO w-mex PERFORM aCommand END-IF. MOVE 0 TO w-Key. move zero to wCRT-STATUS. ex-create. EXIT. *> check to verify LOCK of record from other users *> if record is blocked "w-flag" = "xx" (DECLARATIVES) RecRead. MOVE SPACES TO w-rec-lock PERFORM WITH TEST AFTER UNTIL rec-available READ Mas KEY IS mas-nom INVALID KEY MOVE "N " TO w-exist NOT INVALID KEY MOVE "Y " TO w-exist END-READ IF rec-blocked THEN *> il record è attualmente bloccato da un altro utente MOVE SPACES TO w-fsMas MOVE "Record Blocked - [R] retry [A] abort" TO w-mex PERFORM aCommand IF w-char = "A" OR w-char = "a" THEN STOP RUN END-IF END-IF END-PERFORM. ex-RecRead. EXIT. aCommand. DISPLAY screen-mex-1. ACCEPT screen-mex-1. DISPLAY screen-mex-2. MOVE SPACES TO w-mex. ex-aCommand. EXIT. InitialSettings. set environment 'COB_SCREEN_EXCEPTIONS' TO 'Y'. set environment 'COB_SCREEN_ESC' TO 'Y'. set environment 'COB_LEGACY' TO '1' DISPLAY ' ' AT 0101 WITH ERASE EOS ACCEPT w-data FROM DATE MOVE CORR w-data TO w-data-vis *> make mouse active COMPUTE COB-MOUSE-FLAGS = COB-AUTO-MOUSE-HANDLING + COB-ALLOW-LEFT-DOWN + COB-ALLOW-MIDDLE-DOWN + COB-ALLOW-RIGHT-DOWN + COB-ALLOW-LEFT-UP + COB-ALLOW-MIDDLE-UP + COB-ALLOW-RIGHT-UP + COB-ALLOW-LEFT-DOUBLE + COB-ALLOW-MIDDLE-DOUBLE + COB-ALLOW-RIGHT-DOUBLE + COB-ALLOW-MOUSE-MOVE SET environment "COB_MOUSE_FLAGS" to COB-MOUSE-FLAGS continue. InitialSettingsEx. exit.