copy "cblproto.cpy". $set sourceformat(variable) program-id. generateprog. * Generate fview or fsrch program for a file which will need * subsequent editing. Does most of the legwork anyway. * Takes file name, select-assign copy member file name, * FD copy member file name and program type to generate as * parameters file-control. select sel-file assign sel-file-name organization line sequential file status ws-file-status. select fd-file assign fd-file-name organization line sequential file status ws-file-status. file section. fd sel-file. 01 sel-rec. 03 sel-char pic x occurs 100 times. fd fd-file. 01 fd-rec. 03 fd-char pic x occurs 100 times. working-storage section. copy "cbltypes.cpy". * Type definitions of C data types for use calling C programs 77 char pic s9(2) comp-5 is typedef. 77 uns-char pic 9(2) comp-5 is typedef. 77 short pic s9(4) comp-5 is typedef. 77 uns-short pic 9(4) comp-5 is typedef. 77 int pic s9(9) comp-5 is typedef. 77 uns-int pic 9(9) comp-5 is typedef. $IF P64 set 77 long pic s9(18) comp-5 is typedef. 77 uns-long pic 9(18) comp-5 is typedef. 77 size-t pic 9(18) comp-5 is typedef. 77 wchar-t pic 9(9) comp-5 is typedef. $ELSE 77 long pic s9(9) comp-5 is typedef. 77 uns-long pic 9(9) comp-5 is typedef. 77 size-t pic 9(9) comp-5 is typedef. 77 wchar-t pic 9(4) comp-5 is typedef. $END 77 l-long pic s9(18) comp-5 is typedef. 77 uns-l-long pic 9(18) comp-5 is typedef. 77 d-l-float comp-2 is typedef. 77 d-float comp-2 is typedef. 77 float comp-1 is typedef. 77 proc-pointer procedure-pointer is typedef. 77 data-pointer pointer is typedef. 77 void pic 9(2) comp-5 is typedef. 78 default-convention-val value 0. 78 cdecl-convention-val value 0. 78 pascal-convention-val value 11. 78 fast-convention-val value 2. 78 std-convention-val value 74. 78 sys-convention-val value 16. 78 opt-convention-val value 0. 78 pasc16-convention-val value 35. 78 cdec16-convention-val value 32. * End of type definitions 01 ws-command-line pic x(200). 01 ws-prog-file-name pic x(20). 01 sel-file-name pic x(50). 01 fd-file-name pic x(50). 01 ws-prog-type pic x. 88 view-prog values "v" "V". 88 srch-prog values "s" "S". 01 ws-file-status. 88 valid-io value "00" "02". 88 end-of-file value "10". 88 dupl-key value "22". 88 no-rec value "23". 88 no-file value "35". 88 file-locked value "9A". 88 rec-locked value "9D". 03 ws-file-status-1 pic x. 03 ws-file-status-2 pic x comp-x. 01 ws-disp-file-status-2 pic 9(3). 01 ws-disp-file-status pic x(5). * For declaratives 01 ws-file-operation pic x(20). 88 open-in-file value "Open Input". 88 open-out-file value "Open Output". 88 open-io-file value "Open I-O". 88 open-extend-file value "Open Extend". 88 close-file value "Close". 88 read-file value "Read". 88 read-next-file value "Read Next". 88 read-prev-file value "Read Previous". 88 write-file value "Write". 88 rewrite-file value "Rewrite". 88 start-file value "Start". 88 delete-file value "Delete Record". 88 file-delete-file value "Delete File". 01 ws-prog-name pic x(30). 01 ws-file-name pic x(30). 01 ws-dec-para-name pic x(30) value spaces. 01 ws-para-name-stack. 03 ws-para-ptr pic x(2) comp-5. 03 ws-para-name pic x(30) occurs 20 times. 01 ws-dummy pic x. 01 ws-cobcopy pic x(500). 01 ws-file-type pic x. 88 dynamic-file value "D". 88 external-file value "E". 88 literal-file value "L". 01 ws-counts-and-pointers. 03 ws-prog-file-name-len pic 9(4) comp. 03 ws-act-file-name-len pic 9(4) comp. 03 ws-act-rec-name-len pic 9(4) comp. 03 ws-temp-file-name-len pic 9(4) comp. 03 ws-temp-file-name-val-len pic 9(4) comp. 03 ws-temp-rec-name-len pic 9(4) comp. 03 ws-ws-rec-name-len pic 9(4) comp. 03 ws-phys-file-name-len pic 9(4) comp. 03 ws-term-file-name-len pic 9(4) comp. 03 ws-file-status-name-len pic 9(4) comp. 03 ws-space-len pic 9(2) comp. 03 ws-pic-len pic 9(2) comp. 03 ws-ptr pic 9(4) comp. 03 ws-tbl-ptr pic 9(4) comp. 03 ws-line-ptr pic 9(4) comp. 03 ws-char-ptr pic 9(4) comp. 03 ws-entry-ptr pic 9(4) comp. 03 ws-word-ptr pic 9(4) comp. 03 ws-key-ptr pic 9(4) comp. 03 ws-key-fld-ptr pic 9(4) comp. 03 ws-key-seq pic 9(4) comp. 03 ws-fld-ptr pic 9(4) comp. 03 ws-pic-ptr pic 9(4) comp. 03 ws-occ-ptr pic 9(4) comp. 03 ws-occ-start pic 9(4) comp. 03 ws-group-ptr pic 9(4) comp. 03 ws-disp-ptr pic 9(4) comp. 03 ws-col-ptr pic 9(4) comp. 03 ws-skel-ptr pic 9(4) comp. 03 ws-replace-ptr pic 9(4) comp. 03 ws-replace-str-ptr pic 9(4) comp. 03 ws-key-flds-line-cnt pic 9(4) comp. 03 ws-ctrl-flds-line-cnt pic 9(4) comp. 03 ws-last-fld pic 9(4) comp. 03 ws-rec-prefix-len pic 9(4) comp. 03 ws-key-cnt pic 9(2). 03 ws-disp-key-ptr pic 9(2). 03 ws-repeat-cnt pic 9(8) comp. 01 ws-sel-tbl. 03 ws-sel-word pic x(40) occurs 100 times. 01 ws-fld-tbl. 03 ws-fld-entry occurs 500 times. 05 ws-fld-level pic 9(2). 05 ws-fld-name pic x(30). 05 ws-fld-pic pic x(20). 05 ws-fld-occurs pic 9(8). 05 ws-fld-size pic 9(8). 05 ws-fld-redef pic x(30). 05 ws-fld-keys. 07 ws-fld-key-seq pic 9(2) occurs 20 times. 88 key-field value 1 through 99. 01 ws-key-tbl. 03 ws-key-entry occurs 20 times. 05 ws-key-name pic x(30). 05 ws-key-elmt pic 9(4) comp. 01 ws-key-fld-tbl. 03 ws-key-fld-entry occurs 20 times. 05 ws-key-fld-name pic x(30). 01 ws-words. 03 ws-word pic x(40) occurs 40 times. 01 ws-fd-words. 03 ws-fd-word pic x(40) occurs 40 times. 01 ws-replace-tbl. 03 ws-replace pic x(80) occurs 10 times. 01 ws-rec-prefix pic x(30). 01 ws-delim pic x(2). 01 ws-disp-line pic x(80). 01 ws-disp-fld-occurs pic z(3)9. 01 ws-disp-occ-ptr pic 9(4). 01 ws-ws-key-fld-name pic x(30). 01 ws-ws-key-fld-name-len pic 9(4) comp. 01 ws-scr-desc pic x(30). 01 ws-field-name pic x(30). 01 ws-act-file-name pic x(30). 01 ws-act-rec-name pic x(30). 01 ws-temp-file-name pic x(30). 01 ws-temp-rec-name pic x(30). 01 ws-temp-file-name-val pic x(50). 01 ws-ws-rec-name pic x(30). 01 ws-phys-file-name pic x(30). 01 ws-term-file-name pic x(30). 01 ws-file-status-name pic x(30). 01 ws-last-fld-name pic x(30). 01 ws-group-level-tbl. 03 ws-group-level pic 9(2) occurs 10 times. 01 ws-group-depth pic 9(2) comp. 01 ws-this-level pic 9(2). 01 ws-comparison pic x(6). 01 ws-spaces value spaces. 03 ws-39sp. 05 ws-11sp. 07 ws-6sp pic x(6). 07 filler pic x(5). 05 filler pic x(28). 03 filler pic x(41). * Virtual files for sections of program * Fields for virtual file 01 ws-rec-len-x. 03 ws-rec-len pic 9(4) comp. 01 ws-key-flds-vfile-id cblt-vfile-handle. 01 ws-key-flds-vfile-status cblt-vfile-status. 01 ws-ctrl-flds-vfile-id cblt-vfile-handle. 01 ws-ctrl-flds-vfile-status cblt-vfile-status. 01 ws-key-colour-vfile-id cblt-vfile-handle. 01 ws-key-colour-vfile-status cblt-vfile-status. 01 ws-key-accepts-vfile-id cblt-vfile-handle. 01 ws-key-accepts-vfile-status cblt-vfile-status. 01 ws-externalkey-vfile-id cblt-vfile-handle. 01 ws-externalkey-vfile-status cblt-vfile-status. 01 ws-key-read-a-vfiles. *> move fld to key-fld 03 ws-key-read-a-vfile-id occurs 20 times cblt-vfile-handle. 03 ws-key-read-a-vfile-status occurs 20 times cblt-vfile-status. 01 ws-key-read-b-vfiles. *> if key-fld = fld 03 ws-key-read-b-vfile-id occurs 20 times cblt-vfile-handle. 03 ws-key-read-b-vfile-status occurs 20 times cblt-vfile-status. 01 ws-screen-vfile-id cblt-vfile-handle. 01 ws-screen-vfile-status cblt-vfile-status. 01 ws-fld-nums-vfile-id cblt-vfile-handle. 01 ws-fld-nums-vfile-status cblt-vfile-status. 01 ws-fld-num-gen-vfile-id cblt-vfile-handle. 01 ws-fld-num-gen-vfile-status cblt-vfile-status. 01 ws-test-vals-vfile-id cblt-vfile-handle. 01 ws-test-vals-vfile-status cblt-vfile-status. 01 ws-accepts-vfile-id cblt-vfile-handle. 01 ws-accepts-vfile-status cblt-vfile-status. 01 ws-vfile-offsets. 03 ws-screen-vfile-offset cblt-x4-comp5. 03 ws-key-flds-vfile-offset cblt-x4-comp5. 03 ws-ctrl-flds-vfile-offset cblt-x4-comp5. 03 ws-key-colour-vfile-offset cblt-x4-comp5. 03 ws-key-accepts-vfile-offset cblt-x4-comp5. 03 ws-externalkey-vfile-offset cblt-x4-comp5. 03 ws-key-read-a-vfile-offset occurs 20 times cblt-x4-comp5. 03 ws-key-read-b-vfile-offset occurs 20 times cblt-x4-comp5. 03 ws-fld-nums-vfile-offset cblt-x4-comp5. 03 ws-fld-num-gen-vfile-offset cblt-x4-comp5. 03 ws-test-vals-vfile-offset cblt-x4-comp5. 03 ws-accepts-vfile-offset cblt-x4-comp5. 01 ws-vfile-lengths. 03 ws-screen-vfile-length cblt-x4-comp5. 03 ws-key-flds-vfile-length cblt-x4-comp5. 03 ws-ctrl-flds-vfile-length cblt-x4-comp5. 03 ws-key-colour-vfile-length cblt-x4-comp5. 03 ws-key-accepts-vfile-length cblt-x4-comp5. 03 ws-externalkey-vfile-length cblt-x4-comp5. 03 ws-key-read-a-vfile-length occurs 20 times cblt-x4-comp5. 03 ws-key-read-b-vfile-length occurs 20 times cblt-x4-comp5. 03 ws-fld-nums-vfile-length cblt-x4-comp5. 03 ws-fld-num-gen-vfile-length cblt-x4-comp5. 03 ws-test-vals-vfile-length cblt-x4-comp5. 03 ws-accepts-vfile-length cblt-x4-comp5. 01 ws-vfile-buff-len cblt-x4-comp5. 01 ws-vfile-len cblt-x4-comp5. 01 ws-vfile-rec pic x(200). 01 ws-vfile-status-disp pic 9(6). 01 ws-call-status pic x(2) comp-5. * End of virtual file fields * Screen handling and ADIS stuff 01 ws-field pic 9(2) comp. 01 ws-last-field pic 9(2) comp. 01 ws-param-fields. 03 ws-file-name-fld pic 9(2) comp. 03 ws-sel-file-name-fld pic 9(2) comp. 03 ws-fd-file-name-fld pic 9(2) comp. 03 ws-prog-type-fld pic 9(2) comp. 01 ws-key-status. 03 ws-key-type pic x. 88 Accept-terminated value "0". 88 User-func value "1". 88 ADIS-key value "2". 88 Data-key value "3". 03 ws-key-code-1 pic 9(2) comp-x. 88 Escape-key value zero. *> With key type 1 88 F-key values 1 through 12. 88 F1 value 1. *> With key type 1 88 F2 value 2. *> With key type 1 88 F3 value 3. *> With key type 1 88 F4 value 4. *> With key type 1 88 F5 value 5. *> With key type 1 88 F6 value 6. *> With key type 1 88 F7 value 7. *> With key type 1 88 F8 value 8. *> With key type 1 88 F9 value 9. *> With key type 1 88 F10 value 10. *> With key type 1 88 F11 value 11. *> With key type 1 88 F12 value 12. *> With key type 1 * For some reason, Company2 has non-standard mappings 66 and 67 for * paging keys which should theoretically be Alt-B and Alt-C 88 Page-Up value 53. *> With key type 1 nonstd 88 Page-Up-nonstd value 66. *> With key type 1 ** 88 Page-Down value 54. *> With key type 1 nonstd 88 Page-Down-nonstd value 67. *> With key type 1 ** 88 Ctrl-Page-Up value 55. *> With key type 1 88 Ctrl-Page-Down value 56. *> With key type 1 88 Enter-key value 48. *> With key type 0 88 Enter-key-ADIS value zero 2. *> With key type 2 88 cursor-left value 3. *> With key type 2 88 cursor-right value 4. *> With key type 2 88 cursor-up value 5. *> With key type 2 88 cursor-down value 6. *> With key type 2 * For some reason, Company2 production system (not development) has * non-standard mappings 69 and 72 for Home/End keys which should * theoretically be Alt-E and Alt-H, and 71 for Delete key which * should be Alt-G. 88 Home-key value 7. *> With key type 2 nonstd 88 Home-key-nonstd value 69. *> With key type 1 ** 88 Tab-key value 8 11. *> With key type 2 88 Backtab-key value 9 12. *> With key type 2 88 End-key value 10. *> With key type 2 nonstd 88 End-key-nonstd value 72. *> With key type 1 ** 88 Insert-key value 16. *> With key type 2 88 Delete-key value 17. *> With key type 2 nonstd 88 Delete-key-nonstd value 71. *> With key type 1 ** 88 Backspace-key value 14. *> With key type 2 88 Ctrl-E value 22. *> With key type 2 88 Ctrl-F value 13. *> With key type 2 88 Ctrl-key value 49. *> With key type 0 03 ws-key-code-2 pic x comp-x. * With key type 0, key-code-1 49 88 Ctrl-B value 2. 88 Ctrl-G value 7. 01 get-single-char-func pic 9(2) comp-x value 26. 01 ws-adis-panel-function pic 9(2) comp-x. 01 ws-adis-panel-dummy-param pic x. 01 ws-set-bit-pairs pic 9(2) comp-x value 1. 01 ws-key-control. 03 ws-key-setting pic 9(2) comp-x. 03 ws-key-control-type pic x value "1". 03 ws-first-key. 05 ws-first-key-num pic 9(2) comp-x. 03 ws-num-of-keys pic 9(2) comp-x. * Skeleton for fview file 01 ws-view-skeleton-tbl. 03 filler value '#### program id ' & ' ' & '* View file program ' & ' ' & ' special-names. ' & ' ' & ' crt status is ws-key-status ' & ' console is crt. ' & ' ' & ' file-control. ' & ' ' & '#### copy select ' & ' ' & ' file section. ' & ' ' & '#### copy fd ' & ' ' & '$set sourceformat(variable) ' & ' ' & ' working-storage section. ' & '#### file name ' & ' ' & ' 01 ws-page-num pic 9. ' & ' ' & ' 01 ws-last-page pic 9 ' & ' value is 1. ' & ' ' & ' 01 ws-view-file-name pic x(40). ' & ' ' & ' 01 ws-key-fields. ' & '#### key fields ' & ' ' & ' 01 ws-ctrls. ' & '#### ctrl fields ' & ' ' & '#### key sets ' & ' ' & '* List of linked file viewers ' & ' ' & ' 01 ws-viewer-tbl. ' & ' 03 filler pic x(8) value ' & ' "xxxx". ' & ' 03 filler pic x(35) value ' & ' "xxxx file". ' & ' ' & ' 01 filler redefines ws-viewer-tbl. ' & ' 03 ws-viewer occurs 20 times. ' & ' 05 ws-viewer-suffix pic x(8). ' & ' 05 ws-viewer-desc pic x(35). ' & ' ' & '* List of linked file viewers not on stack ' & ' ' & ' 01 ws-next-file-tbl. ' & ' 03 ws-next-file occurs 20 times. ' & ' 05 ws-next-file-suffix pic x(8). ' & ' 05 ws-next-file-desc pic x(35). ' & ' ' & ' 01 ws-prog-called pic x. ' & ' 88 prog-called value is "Y" ' & ' false is "N". ' & ' ' & ' 01 ws-key-status. ' & ' 03 ws-key-type pic x. ' & ' 88 Accept-terminated value "0". ' & ' 88 User-func value "1". ' & ' 88 ADIS-key value "2". ' & ' 03 ws-key-code-1 pic 9(2) comp-x. ' & ' 88 Escape-key value zero. ' & ' 88 F-key values 1 thru 12. ' & ' 88 F1 value 1. ' & ' 88 F2 value 2. ' & ' 88 F3 value 3. ' & ' 88 F4 value 4. ' & ' 88 F5 value 5. ' & ' 88 F6 value 6. ' & ' 88 F7 value 7. ' & ' 88 F8 value 8. ' & ' 88 F9 value 9. ' & ' 88 F10 value 10. ' & ' 88 F11 value 11. ' & ' 88 F12 value 12. ' & ' 88 Page-Up value 53. ' & ' 88 Page-Down value 54. ' & ' 88 Ctrl-Page-Up value 55. ' & ' 88 Ctrl-Page-Down value 56. ' & ' 88 Enter-key value 48. ' & ' 88 Enter-key-ADIS value zero 2. ' & ' 88 cursor-left value 3. ' & ' 88 cursor-right value 4. ' & ' 88 cursor-up value 5. ' & ' 88 cursor-down value 6. ' & ' 88 Home-key value 7. ' & ' 88 Tab-key value 8 11. ' & ' 88 Backtab-key value 9 12. ' & ' 88 End-key value 10. ' & ' 88 Insert-key value 16. ' & ' 88 Delete-key value 17. ' & ' 88 Backspace-key value 14. ' & '* For some reason, Company2 has assorted non-standard mappings ' & '* These are: ' & '* 66 and 67 for paging keys (should be Alt-B and Alt-C) ' & '* 69 and 72 for Home/End keys (should be Alt-E and Alt-H) ' & '* 71 for Delete (should be Alt-G) ' & '* Non-standard keys are User-func keys, not ADIS ' & ' 88 Page-Up-nonstd value 66. ' & ' 88 Page-Down-nonstd value 67. ' & ' 88 Home-key-nonstd value 69. ' & ' 88 End-key-nonstd value 72. ' & ' 88 Delete-key-nonstd value 71. ' & ' 03 ws-key-code-2 pic 9(2) comp-x. ' & ' ' & ' 01 get-single-char-func pic 9(2) comp-x ' & ' value 26. ' & ' ' & ' 01 ws-key-id pic 9(2) comp-x ' & ' value 1. ' & ' 88 key-01 value 1. ' & ' 88 key-02 value 2. ' & ' 88 key-03 value 3. ' & ' 88 key-04 value 4. ' & ' 88 key-05 value 5. ' & ' 88 key-06 value 6. ' & ' 88 key-07 value 7. ' & ' 88 key-08 value 8. ' & ' 88 key-09 value 9. ' & ' 88 key-10 value 10. ' & ' 88 key-11 value 11. ' & ' 88 key-12 value 12. '. 03 filler value ' ' & ' 01 ws-linecol. ' & ' 03 ws-line pic 9(2). ' & ' 03 ws-col pic 9(2). ' & ' ' & ' 01 ws-fields. ' & ' 03 ws-field-max pic 9. ' & ' 03 ws-field-name pic x(30) ' & ' occurs 10 times. ' & ' ' & ' 01 ws-field pic 9(4) comp. ' & ' ' & ' 01 ws-err-msg pic x(80). ' & ' ' & ' 01 ws-centred-msg pic x(80). ' & ' ' & ' 01 ws-ptr pic 9(2) comp. ' & ' ' & ' 01 ws-to pic 9(2) comp. ' & ' ' & ' 01 ws-viewer-ptr pic x(2) comp-5. ' & ' 01 ws-next-file-max pic x(2) comp-5. ' & ' 01 ws-next-file-ptr pic x(2) comp-5. ' & ' 01 ws-next-file-line pic x(2) comp-5. '. 03 filler value ' ' & ' 01 externalkey pic x(80) external. ' & ' 01 externalkeyid pic 9(2) external. ' & ' 01 externalfilename pic x(80) external. ' & ' 01 externalprogstack external. ' & ' 03 externalstackptr pic 9(4) comp. ' & ' 03 externalstackprog pic x(30) ' & ' occurs 20 times. ' & ' ' & ' 01 ws-prog-name pic x(30). ' & ' 01 ws-file-name pic x(30). ' & ' 01 ws-dec-para-name pic x(40) ' & ' value spaces. ' & ' 01 ws-para-name-stack. ' & ' 03 ws-para-ptr pic x(2) comp-5. ' & ' 03 ws-para-name pic x(40) ' & ' occurs 20 times. ' & ' ' & '#### file status ' & ' 88 valid-io value "00" "02". ' & ' 88 end-of-file value "10". ' & ' 88 dupl-key value "22". ' & ' 88 no-rec value "23". ' & ' 88 no-file value "35". ' & ' 88 file-locked value "9A". ' & ' 88 rec-locked value "9D". ' & ' 03 ws-file-status-1 pic x. ' & ' 03 ws-file-status-2 pic x comp-x. ' & ' ' & ' 01 ws-disp-file-status-2 pic 9(3). ' & ' 01 ws-disp-file-status pic x(5). ' & ' ' & ' 01 ws-adis-panel-function pic 99 comp-x. ' & ' 01 ws-adis-panel-dummy-param pic x. ' & ' ' & ' 01 ws-set-bit-pairs pic 9(2) comp-x ' & ' value 1. ' & ' ' & ' 01 ws-user-key-control. ' & ' 03 ws-user-key-setting pic 9(2) comp-x. ' & ' 03 filler pic x value "1". ' & ' 03 ws-first-user-key pic 9(2) comp-x. ' & ' 03 ws-num-of-user-keys pic 9(2) comp-x. ' & ' ' & ' 01 ws-adis-key-control. ' & ' 03 ws-adis-key-setting pic 9(2) comp-x. ' & ' 03 filler pic x value "2". ' & ' 03 ws-first-adis-key pic 9(2) comp-x. ' & ' 03 ws-num-of-adis-keys pic 9(2) comp-x. ' & ' ' & '* For declaratives ' & ' ' & ' 01 ws-file-operation pic x(20). ' & ' 88 open-in-file value "Open Input". ' & ' 88 open-out-file value "Open Output". ' & ' 88 open-io-file value "Open I-O". ' & ' 88 open-extend-file value "Open Extend". ' & ' 88 close-file value "Close". ' & ' 88 read-file value "Read". ' & ' 88 read-next-file value "Read Next". ' & ' 88 read-prev-file value "Read Previous". ' & ' 88 write-file value "Write". ' & ' 88 rewrite-file value "Rewrite". ' & ' 88 start-file value "Start". ' & ' 88 delete-file value "Delete Record". ' & ' 88 file-delete-file value "Delete File". ' & ' ' & ' 78 black value zero. ' & ' 78 black-x value "0". ' & ' 78 blue value 1. ' & ' 78 blue-x value "1". ' & ' 78 green value 2. ' & ' 78 green-x value "2". ' & ' 78 cyan value 3. ' & ' 78 cyan-x value "3". ' & ' 78 red value 4. ' & ' 78 red-x value "4". ' & ' 78 magenta value 5. ' & ' 78 magenta-x value "5". ' & ' 78 yellow value 6. ' & ' 78 yellow-x value "6". ' & ' 78 white value 7. ' & ' 78 white-x value "7". ' & ' ' & ' 01 ws-spaces pic x(80) ' & ' value spaces. ' & ' ' & ' 01 sccsid pic x(50) value ' & ' "%A%". ' & ' ' & ' ' & ' screen section. ' & ' ' & ' 01 ss-header ' & ' background-colour black ' & ' foreground-colour green. ' & ' 03 blank screen. ' & ' 03 line 1. ' & '#### screen definition ' & '* 03 line 2. ' & '* Footer lines - error message and instructions on F-keys ' & ' ' & ' 01 ss-footer. ' & ' 03 line 23. ' & ' 03 col 1 from ws-centred-msg. ' & ' ' & '* Line with instructions on F-keys etc ' & ' ' & ' 03 line 24. ' & ' 03 col 10 value ' & '#### f-keys ' & ' ' & ' ' & ' 01 ss-viewers background-colour black ' & ' foreground-colour yellow. ' & ' 03 blank screen. ' & ' 03 line 4. ' & ' 03 col 10 value "File to view?". ' & ' ' & ' 01 ss-dynamic-file-name background-colour black ' & ' foreground-colour yellow. ' & ' 03 blank screen. ' & ' 03 line 5. ' & ' 03 col 10 value "Actual file name:". ' & ' 03 col + 2 using ws-view-file-name. '. 03 filler value ' ' & ' 01 ss-file-error background-colour black ' & ' foreground-colour yellow. ' & ' 03 blank screen. ' & ' 03 line 2. ' & ' 03 col 10 value "Program:". ' & ' 03 col 20 from ws-prog-name. ' & ' 03 line + 2. ' & ' 03 col 10 value "File:". ' & ' 03 col 20 from ws-file-name. ' & ' 03 line + 2. ' & ' 03 col 10 value "Error:". ' & ' 03 col 20 from ws-disp-file-status. ' & ' 03 line + 2. ' & ' 03 col 10 value "Procedure stack:". ' & ' 03 ss-stack-entry occurs 10 times. ' & ' 05 line + 1. ' & ' 05 col 20 from ws-para-name. '. 03 filler value ' ' & ' ' & ' procedure division. ' & ' ' & ' declaratives. ' & ' ' & '#### declaratives ' & ' if ws-file-status-1 = "9" ' & ' move ws-file-status-2 to ws-disp-file-status-2 ' & ' string "9/" ' & ' ws-disp-file-status-2 ' & ' delimited by size ' & ' into ws-disp-file-status ' & ' else ' & ' move ws-file-status to ws-disp-file-status ' & ' end-if ' & ' ' & ' display ss-file-error ' & ' ' & ' call x"AF" using get-single-char-func ' & ' ws-key-status ' & ' ' & ' move spaces to externalstackprog ' & ' (externalstackptr) ' & ' subtract 1 from externalstackptr ' & ' ' & ' goback ' & ' . ' & ' ' & ' end declaratives. ' & ' ' & ' ' & ' a-control section. ' & ' ' & '#### control ' & ' ' & ' if externalstackprog(1) = spaces ' & ' move 1 to externalstackptr ' & ' else ' & ' add 1 to externalstackptr ' & ' end-if ' & ' ' & ' move ws-prog-name to externalstackprog ' & ' (externalstackptr) ' & ' ' & ' perform b1-start ' & ' ' & ' perform b5-main ' & ' until User-func ' & ' and Escape-key ' & ' ' & ' perform b9-end ' & ' ' & ' move spaces to externalstackprog ' & ' (externalstackptr) ' & ' subtract 1 from externalstackptr ' & ' ' & ' goback ' & ' . ' & ' ' & ' b1-start section. ' & ' ' & ' move "b1" to ws-dec-para-name ' & ' ' & '* Calculate maximum number of file viewer table entries ' & ' ' & ' compute ' & ' ws-next-file-max = length ws-next-file-tbl ' & ' / length ws-next-file ' & ' ' & ' move zero to ws-next-file-ptr ' & ' move spaces to ws-next-file-tbl ' & ' ' & ' perform ' & ' varying ws-viewer-ptr from 1 by 1 ' & ' until ws-viewer-ptr > ws-next-file-max ' & ' or ws-viewer(ws-viewer-ptr) = spaces ' & ' perform ' & ' varying ws-ptr from 1 by 1 ' & ' until ws-ptr > externalstackptr ' & ' or externalstackprog(ws-ptr)(6:) ' & ' = ws-viewer-suffix(ws-viewer-ptr) ' & ' end-perform ' & ' if ws-ptr > externalstackptr ' & ' add 1 to ws-next-file-ptr ' & ' move ws-viewer(ws-viewer-ptr) ' & ' to ws-next-file ' & ' (ws-next-file-ptr) ' & ' end-if ' & ' end-perform ' & ' ' & '* Set cursor movement keys (ADIS) so they will terminate ' & '* ACCEPT ' & ' ' & ' move 1 to ws-adis-key-setting ' & ' move 3 to ws-first-adis-key ' & ' move 10 to ws-num-of-adis-keys ' & ' ' & ' call x"AF" using ws-set-bit-pairs ' & ' ws-adis-key-control ' & ' ' & '* Set Escape and F-keys to enabled ' & ' ' & ' move 1 to ws-user-key-setting ' & ' move zero to ws-first-user-key ' & ' move 13 to ws-num-of-user-keys ' & ' ' & ' call x"AF" using ws-set-bit-pairs ' & ' ws-user-key-control ' & ' ' & '* Start out with key 1 and on page 1 ' & ' ' & ' set key-01 to true ' & ' move 1 to ws-page-num ' & ' ' & '#### start ' & ' ' & ' perform c20-conversions ' & ' ' & ' perform c30-get-key ' & ' . '. 03 filler value ' ' & ' b5-main section. ' & ' ' & ' move "b5" to ws-dec-para-name ' & ' ' & ' evaluate true ' & ' when Accept-terminated ' & ' perform c1-read-by-key ' & ' when User-func ' & ' evaluate true ' & ' when Escape-key ' & ' continue ' & ' when F-key *> Use specific F-keys if necessary' & ' move ws-key-code-1 to ws-key-id ' & ' perform c1-read-by-key ' & ' when Home-key-nonstd ' & ' perform c13-read-first ' & ' when End-key-nonstd ' & ' perform c14-read-last ' & ' when Page-Up ' & ' when Page-Up-nonstd ' & ' if ws-page-num > 1 ' & ' subtract 1 from ws-page-num ' & ' end-if ' & ' when Page-Down ' & ' when Page-Down-nonstd ' & ' if ws-page-num < ws-last-page ' & ' add 1 to ws-page-num ' & ' end-if ' & ' when other ' & ' move "Unrecognised F-key" ' & ' to ws-err-msg ' & ' end-evaluate ' & ' when ADIS-key ' & ' evaluate true ' & ' when cursor-left ' & ' if prog-called ' & '#### close file 12 sp ' & ' move spaces to externalstackprog ' & ' (externalstackptr) ' & ' subtract 1 from externalstackptr ' & ' goback ' & ' else ' & ' move "Unrecognised action" ' & ' to ws-err-msg ' & ' end-if ' & ' when cursor-right ' & ' perform c40-call-next-viewer ' & ' when cursor-up ' & ' perform c11-read-prev ' & ' when cursor-down ' & ' perform c12-read-next ' & ' when Home-key ' & ' perform c13-read-first ' & ' when End-key ' & ' perform c14-read-last ' & ' when other ' & ' move "Unrecognised action" ' & ' to ws-err-msg ' & ' end-evaluate ' & ' when other ' & ' move "Unrecognised action" ' & ' to ws-err-msg ' & ' end-evaluate ' & ' ' & ' if ws-err-msg not = spaces ' & ' perform ' & ' varying ws-ptr from length ws-err-msg by -1 ' & ' until ws-err-msg(ws-ptr:1) not = space ' & ' continue ' & ' end-perform ' & ' compute ' & ' ws-to = (80 - ws-ptr) / 2 ' & ' move ws-err-msg(1:ws-ptr) ' & ' to ws-centred-msg ' & ' (ws-to:ws-ptr) ' & ' end-if ' & ' ' & ' perform c20-conversions ' & ' ' & ' perform c30-get-key ' & ' ' & ' move spaces to ws-err-msg ' & ' ws-centred-msg ' & ' . ' & ' ' & ' b9-end section. ' & ' ' & ' move "b9" to ws-dec-para-name ' & ' ' & ' set close-file to true ' & '#### close file no sp ' & ' . ' & ' ' & ' c1-read-by-key section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c1" to ws-dec-para-name ' & ' ' & ' evaluate true ' & '#### when clause read-by-key ' & ' end-evaluate ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & ' c11-read-prev section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c11" to ws-dec-para-name ' & ' ' & ' set read-prev-file to true ' & '#### read file prev no sp ' & ' at end ' & ' move "Beginning of file found" ' & ' to ws-err-msg ' & '#### read file next 4 sp ' & ' end-read ' & ' end-read ' & ' ' & ' perform x3-pop-para-name ' & ' . '. 03 filler value ' ' & ' c12-read-next section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c12" to ws-dec-para-name ' & ' ' & ' set read-next-file to true ' & '#### read file next no sp ' & ' at end ' & ' move "End of file found" ' & ' to ws-err-msg ' & ' set read-prev-file to true ' & '#### read file prev 4 sp ' & ' end-read ' & ' end-read ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & ' c13-read-first section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c13" to ws-dec-para-name ' & ' ' & '#### low values ' & ' evaluate true ' & '#### when clause read-first ' & ' end-evaluate ' & ' ' & ' set read-next-file to true ' & '#### read file next no sp ' & ' at end ' & ' move "End of file found" ' & ' to ws-err-msg ' & '#### init rec 4 sp ' & ' end-read ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & ' c14-read-last section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c14" to ws-dec-para-name ' & ' ' & '#### high values ' & ' ' & ' evaluate true ' & '#### when clause read-last ' & ' end-evaluate ' & ' ' & ' set read-next-file to true ' & '#### read file next no sp ' & ' at end ' & ' move "End of file found" ' & ' to ws-err-msg ' & '#### init rec 4 sp ' & ' end-read ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & ' c20-conversions section. ' & ' ' & '* Convert any fields that need changing from the value in ' & '* the record to working storage fields ' & ' ' & ' perform x1-push-para-name ' & ' move "c20" to ws-dec-para-name ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & ' c30-get-key section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c30" to ws-dec-para-name ' & ' ' & ' move spaces to ws-ctrls ' & ' ' & ' evaluate true ' & '#### when clause get-key key-sets ' & ' end-evaluate ' & ' ' & '* Set up highlights on key fields ' & ' ' & ' perform ' & ' varying ws-field from 1 by 1 ' & ' until ws-field > ws-field-max ' & ' evaluate ws-field-name(ws-field) ' & '#### when clause get-key highlights ' & ' end-evaluate ' & ' end-perform ' & ' ' & ' display ss-header ' & ' ' & ' evaluate ws-page-num ' & ' when 1 ' & '#### display page 1 ' & ' display ss-footer ' & ' perform d20-get-key-fields ' & ' with test after ' & ' until (Accept-terminated or User-func) ' & ' or (ADIS-key ' & ' and (Escape-key ' & ' or cursor-left ' & ' or cursor-right ' & ' or cursor-up ' & ' or cursor-down ' & ' or Home-key ' & ' or End-key)) ' & '* when 2 ' & '#### display page 2 ' & '* display ss-footer ' & '* call x"AF" using get-single-char-func ' & '* ws-key-status ' & ' end-evaluate ' & ' ' & ' perform x3-pop-para-name ' & ' . '. 03 filler value ' ' & ' c40-call-next-viewer section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c40" to ws-dec-para-name ' & ' ' & ' display ss-viewers ' & ' move 1 to ws-next-file-ptr ' & ' ' & ' perform s1-display-viewer-line ' & ' varying ws-next-file-line from 2 by 1 ' & ' until ws-next-file-line > ws-next-file-max ' & ' ' & ' move 1 to ws-next-file-line ' & ' perform s1-display-viewer-line ' & ' ' & ' perform d30-get-viewer ' & ' with test after ' & ' until (User-func ' & ' and Escape-key) ' & ' or (Accept-terminated ' & ' and Enter-key) ' & ' or (ADIS-key ' & ' and Enter-key-ADIS) ' & ' ' & ' if User-func ' & ' set Accept-terminated to true ' & ' perform x3-pop-para-name ' & ' exit section ' & ' end-if ' & ' ' & '**** edit - create viewer entries as required ' & ' ' & '* evaluate ws-next-file-suffix(ws-next-file-ptr) ' & '* when "xx" ' & '* move xxx-field2 to externalkey ' & '* move 1 to externalkeyid ' & '* call "fviewxx" ' & '* end-evaluate ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & '#### read by keys ' & ' d20-get-key-fields section. ' & ' ' & '* Use cursor & page keys to move between records ' & ' ' & ' perform x1-push-para-name ' & ' move "d20" to ws-dec-para-name ' & ' ' & ' move 1 to ws-field ' & ' ' & ' perform ' & ' with test after ' & ' until Accept-terminated ' & ' or User-func ' & ' or (ADIS-key ' & ' and (Escape-key ' & ' or cursor-left ' & ' or cursor-right ' & ' or cursor-up ' & ' or cursor-down ' & ' or Home-key ' & ' or End-key)) ' & ' evaluate ws-field-name(ws-field) ' & '#### when clause accept fields ' & ' end-evaluate ' & * Delete the following lines if not being used with odd key mappings ' if User-func ' & ' evaluate true ' & ' when Home-key-nonstd ' & ' set Home-key to true ' & ' set ADIS-key to true ' & ' when End-key-nonstd ' & ' set End-key to true ' & ' set ADIS-key to true ' & ' end-evaluate ' & ' end-if ' & * Stop deleting now ' if ADIS-key ' & ' evaluate true ' & ' when Tab-key ' & ' if ws-field < ws-field-max ' & ' add 1 to ws-field ' & ' else ' & ' move 1 to ws-field ' & ' end-if ' & ' when Backtab-key ' & ' if ws-field > 1 ' & ' subtract 1 from ws-field ' & ' else ' & ' move ws-field-max ' & ' to ws-field ' & ' end-if ' & ' end-evaluate ' & ' end-if ' & ' end-perform ' & ' ' & ' perform x3-pop-para-name ' & ' . '. 03 filler value ' ' & ' d30-get-viewer section. ' & ' ' & ' call x"AF" using get-single-char-func ' & ' ws-key-status ' & ' ' & ' evaluate true also true ' & ' when User-func also Escape-key ' & ' when Accept-terminated also Enter-key ' & ' when ADIS-key also Enter-key-ADIS ' & ' perform x3-pop-para-name ' & ' exit section ' & ' when ADIS-key also cursor-up ' & ' if ws-next-file-ptr > 1 ' & ' move ws-next-file-ptr ' & ' to ws-next-file-line ' & ' subtract 1 from ws-next-file-ptr ' & ' perform s1-display-viewer-line ' & ' move ws-next-file-ptr ' & ' to ws-next-file-line ' & ' perform s1-display-viewer-line ' & ' end-if ' & ' when ADIS-key also cursor-down ' & ' if ws-next-file-ptr < ws-next-file-max ' & ' move ws-next-file-ptr ' & ' to ws-next-file-line ' & ' add 1 to ws-next-file-ptr ' & ' perform s1-display-viewer-line ' & ' move ws-next-file-ptr ' & ' to ws-next-file-line ' & ' perform s1-display-viewer-line ' & ' end-if ' & ' end-evaluate ' & ' . ' & ' ' & ' s1-display-viewer-line section. ' & ' ' & ' move 10 to ws-col ' & ' ' & ' add 5 ' & ' ws-next-file-line giving ws-line ' & ' ' & ' if ws-next-file-line = ws-next-file-ptr ' & ' display ws-next-file-suffix(ws-next-file-line) ' & ' at ws-linecol ' & ' with foreground-colour white ' & ' add 15 to ws-col ' & ' display ws-next-file-desc(ws-next-file-line) ' & ' at ws-linecol ' & ' with foreground-colour white ' & ' else ' & ' display ws-next-file-suffix(ws-next-file-line) ' & ' at ws-linecol ' & ' with foreground-colour yellow ' & ' add 15 to ws-col ' & ' display ws-next-file-desc(ws-next-file-line) ' & ' at ws-linecol ' & ' with foreground-colour yellow ' & ' end-if ' & ' . ' & ' ' & ' x1-push-para-name section. ' & ' ' & '* Add paragraph name to called stack ' & '* Check that stack is not going to overflow ' & ' ' & ' if ws-para-ptr < 1 or > 9 ' & ' move 1 to ws-para-ptr ' & ' else ' & ' add 1 to ws-para-ptr ' & ' end-if ' & ' ' & ' move ws-dec-para-name to ws-para-name(ws-para-ptr) ' & ' . ' & ' ' & ' x3-pop-para-name section. ' & ' ' & '* Remove paragraph name from called stack and put it in ' & '* ws-dec-para-name as current paragraph ' & '* Check that stack will not underflow ' & ' ' & ' if ws-para-ptr > zero and < 11 ' & ' move ws-para-name(ws-para-ptr) ' & ' to ws-dec-para-name ' & ' subtract 1 from ws-para-ptr ' & ' end-if ' & ' . '. 03 filler value '#### end '. 01 filler redefines ws-view-skeleton-tbl. 03 ws-view-skel-line pic x(63) occurs 900. * Skeleton for search program 01 ws-srch-skeleton-tbl. 03 filler value '#### program id ' & ' ' & '* Search file program ' & ' ' & ' special-names. ' & ' ' & ' crt status is ws-key-status ' & ' console is crt. ' & ' ' & ' file-control. ' & ' ' & '#### copy selects ' & ' ' & ' file section. ' & ' ' & '#### copy fds ' & ' ' & ' working-storage section. ' & ' ' & '#### copy ws ' & ' ' & '$set sourceformat(variable) ' & ' ' & ' 01 ws-page-num pic 9. ' & ' ' & ' 01 ws-last-page pic 9 ' & ' value is 1. ' & ' ' & ' 01 ws-view-file-name pic x(40). ' & ' ' & ' 01 ws-rec-cnt pic 9(4) comp. ' & ' ' & ' 01 ws-foreground pic 9. ' & ' ' & ' 01 ws-values-found-ind pic x. ' & ' 88 values-found value "Y" ' & ' false "N". ' & ' ' & ' 01 ws-key-status. ' & ' 03 ws-key-type pic x. ' & ' 88 Accept-terminated value "0". ' & ' 88 User-func value "1". ' & ' 88 ADIS-key value "2". ' & ' 03 ws-key-code-1 pic 9(2) comp-x. ' & ' 88 Escape-key value zero. ' & ' 88 F-key values 1 thru 12. ' & ' 88 F1 value 1. ' & ' 88 F2 value 2. ' & ' 88 F3 value 3. ' & ' 88 F4 value 4. ' & ' 88 F5 value 5. ' & ' 88 F6 value 6. ' & ' 88 F7 value 7. ' & ' 88 F8 value 8. ' & ' 88 F9 value 9. ' & ' 88 F10 value 10. ' & ' 88 F11 value 11. ' & ' 88 F12 value 12. ' & ' 88 Page-Up value 53. ' & ' 88 Page-Down value 54. ' & ' 88 Ctrl-Page-Up value 55. ' & ' 88 Ctrl-Page-Down value 56. ' & ' 88 Enter-key value 48. ' & ' 88 Enter-key-ADIS value zero 2. ' & ' 88 cursor-left value 3. ' & ' 88 cursor-right value 4. ' & ' 88 cursor-up value 5. ' & ' 88 cursor-down value 6. ' & ' 88 Home-key value 7. ' & ' 88 Tab-key value 8 11. ' & ' 88 Backtab-key value 9 12. ' & ' 88 End-key value 10. ' & ' 88 Insert-key value 16. ' & ' 88 Delete-key value 17. ' & ' 88 Backspace-key value 14. ' & '* For some reason, Company2 has assorted non-standard mappings ' & '* These are: ' & '* 66 and 67 for paging keys (should be Alt-B and Alt-C) ' & '* 69 and 72 for Home/End keys (should be Alt-E and Alt-H) ' & '* 71 for Delete (should be Alt-G) ' & '* Non-standard keys are User-func keys, not ADIS ' & ' 88 Page-Up-nonstd value 66. ' & ' 88 Page-Down-nonstd value 67. ' & ' 88 Home-key-nonstd value 69. ' & ' 88 End-key-nonstd value 72. ' & ' 88 Delete-key-nonstd value 71. ' & ' ' & ' 03 ws-key-code-2 pic 9(2) comp-x. ' & ' ' & ' 01 get-single-char-func pic 9(2) comp-x ' & ' value 26. ' & ' ' & ' 01 ws-key-id pic 9(2) comp-x ' & ' value 1. ' & ' 88 key-1 value 1. ' & ' 88 key-2 value 2. ' & ' 88 key-3 value 3. ' & ' 88 key-4 value 4. ' & ' 88 key-5 value 5. ' & ' 88 key-6 value 6. ' & ' 88 key-7 value 7. ' & ' 88 key-8 value 8. ' & ' 88 key-9 value 9. ' & ' 88 key-10 value 10. ' & ' 88 key-11 value 11. ' & ' 88 key-12 value 12. ' & ' ' & ' 01 ws-linecol. ' & ' 03 ws-line pic 9(2). ' & ' 03 ws-col pic 9(2). ' & ' ' & ' 01 ws-field pic 9(4) comp. ' & ' ' & ' 01 ws-err-msg pic x(80). ' & ' ' & ' 01 ws-centred-msg pic x(80). ' & ' ' & ' 01 ws-ptr pic 9(2) comp. ' & ' ' & ' 01 ws-to pic 9(2) comp. '. 03 filler value ' ' & ' 01 externalkey pic x(80) external. ' & ' 01 externalkeyid pic 9(2) external. ' & ' 01 externalfilename pic x(80) external. ' & ' ' & ' 01 ws-prog-name pic x(30). ' & ' 01 ws-file-name pic x(30). ' & ' 01 ws-dec-para-name pic x(40) ' & ' value spaces. ' & ' 01 ws-para-name-stack. ' & ' 03 ws-para-ptr pic x(2) comp-5. ' & ' 03 ws-para-name pic x(40) ' & ' occurs 20 times. ' & ' 01 ws-field-numbers. ' & '#### field numbers ' & ' 03 ws-last-fld pic 9(4) comp. ' & ' ' & '#### file status ' & ' 88 valid-io value "00" "02". ' & ' 88 end-of-file value "10". ' & ' 88 dupl-key value "22". ' & ' 88 no-rec value "23". ' & ' 88 no-file value "35". ' & ' 88 file-locked value "9A". ' & ' 88 rec-locked value "9D". ' & ' 03 ws-file-status-1 pic x. ' & ' 03 ws-file-status-2 pic x comp-x. ' & ' ' & ' 01 ws-disp-file-status-2 pic 9(3). ' & ' 01 ws-disp-file-status pic x(5). ' & ' ' & ' 01 ws-adis-panel-function pic 99 comp-x. ' & ' 01 ws-adis-panel-dummy-param pic x. ' & ' ' & ' 01 ws-set-bit-pairs pic 9(2) comp-x ' & ' value 1. ' & ' ' & ' 01 ws-user-key-control. ' & ' 03 ws-user-key-setting pic 9(2) comp-x. ' & ' 03 filler pic x value "1". ' & ' 03 ws-first-user-key pic 9(2) comp-x. ' & ' 03 ws-num-of-user-keys pic 9(2) comp-x. ' & ' ' & ' 01 ws-adis-key-control. ' & ' 03 ws-adis-key-setting pic 9(2) comp-x. ' & ' 03 filler pic x value "2". ' & ' 03 ws-first-adis-key pic 9(2) comp-x. ' & ' 03 ws-num-of-adis-keys pic 9(2) comp-x. ' & ' ' & '* For declaratives ' & ' ' & ' 01 ws-file-operation pic x(20). ' & ' 88 open-in-file value "Open Input". ' & ' 88 open-out-file value "Open Output". ' & ' 88 open-io-file value "Open I-O". ' & ' 88 open-extend-file value "Open Extend". ' & ' 88 close-file value "Close". ' & ' 88 read-file value "Read". ' & ' 88 read-next-file value "Read Next". ' & ' 88 read-prev-file value "Read Previous". ' & ' 88 write-file value "Write". ' & ' 88 rewrite-file value "Rewrite". ' & ' 88 start-file value "Start". ' & ' 88 delete-file value "Delete Record". ' & ' 88 file-delete-file value "Delete File". ' & ' ' & ' 78 black value zero. ' & ' 78 black-x value "0". ' & ' 78 blue value 1. ' & ' 78 blue-x value "1". ' & ' 78 green value 2. ' & ' 78 green-x value "2". ' & ' 78 cyan value 3. ' & ' 78 cyan-x value "3". ' & ' 78 red value 4. ' & ' 78 red-x value "4". ' & ' 78 magenta value 5. ' & ' 78 magenta-x value "5". ' & ' 78 yellow value 6. ' & ' 78 yellow-x value "6". ' & ' 78 white value 7. ' & ' 78 white-x value "7". ' & ' ' & ' 01 ws-spaces pic x(80) ' & ' value spaces. ' & ' ' & ' 01 sccsid pic x(50) value ' & ' "%A%". ' & ' ' & ' ' & ' screen section. ' & ' ' & ' 01 ss-header background-colour black ' & ' foreground-colour green. ' & ' 03 blank screen. ' & ' 03 line 1. ' & '#### screen definition ' & ' ' & '* Footer lines - error message and instructions on F-keys ' & ' ' & ' 01 ss-footer. ' & ' 03 line 23. ' & ' 03 col 1 from ws-centred-msg. ' & ' ' & ' 01 ss-dynamic-file-name background-colour black ' & ' foreground-colour yellow. ' & ' 03 blank screen. ' & ' 03 line 5. ' & ' 03 col 10 value "Actual file name:". ' & ' 03 col + 2 using ws-view-file-name. ' & ' ' & ' 01 ss-file-error background-colour black ' & ' foreground-colour yellow. ' & ' 03 blank screen. ' & ' 03 line 2. ' & ' 03 col 10 value "Program:". ' & ' 03 col 22 from ws-prog-name. ' & ' 03 line + 2. ' & ' 03 col 10 value "File:". ' & ' 03 col 22 from ws-file-name. ' & ' 03 line + 2. ' & ' 03 col 10 value "Error:". ' & ' 03 col 22 from ws-disp-file-status. ' & ' 03 line + 2. ' & ' 03 col 10 value "Procedure stack:". ' & ' 03 ss-stack-entry occurs 10 times. ' & ' 05 line + 1. ' & ' 05 col 20 from ws-para-name. '. 03 filler value ' ' & ' ' & ' procedure division. ' & ' ' & ' declaratives. ' & '#### declaratives ' & ' ' & ' if ws-file-status-1 = "9" ' & ' move ws-file-status-2 to ws-disp-file-status-2 ' & ' string "9/" ' & ' ws-disp-file-status-2 ' & ' delimited by size ' & ' into ws-disp-file-status ' & ' else ' & ' move ws-file-status to ws-disp-file-status ' & ' end-if ' & ' ' & ' display ss-file-error ' & ' ' & ' call x"AF" using get-single-char-func ' & ' ws-key-status ' & ' ' & ' goback ' & ' . ' & ' ' & ' end declaratives. ' & ' ' & ' ' & ' a-control section. ' & '#### control ' & ' ' & ' perform b1-start ' & ' ' & ' perform b5-main ' & ' until User-func ' & ' and Escape-key ' & ' ' & ' perform b9-end ' & ' ' & ' goback ' & ' . ' & ' ' & ' b1-start section. ' & ' ' & ' move "b1" to ws-dec-para-name ' & ' ' & '* Set cursor movement keys (ADIS) so they will terminate ' & '* ACCEPT ' & ' ' & ' move 1 to ws-adis-key-setting ' & ' move 3 to ws-first-adis-key ' & ' move 10 to ws-num-of-adis-keys ' & ' ' & ' call x"AF" using ws-set-bit-pairs ' & ' ws-adis-key-control ' & ' ' & '* Set Escape and F-keys to enabled ' & ' ' & ' move 1 to ws-user-key-setting ' & ' move zero to ws-first-user-key ' & ' move 13 to ws-num-of-user-keys ' & ' ' & ' call x"AF" using ws-set-bit-pairs ' & ' ws-user-key-control ' & ' ' & '* Start out on page 1 ' & ' ' & ' move 1 to ws-page-num ' & ' ' & '#### start ' & ' ' & ' perform c30-get-values ' & ' . '. 03 filler value ' ' & ' b5-main section. ' & ' ' & ' move "b5" to ws-dec-para-name ' & ' ' & ' move zero to ws-rec-cnt ' & ' ' & ' set open-out-file to true ' & '#### main ' & * start file ' invalid key ' & ' set end-of-file to true ' & ' end-start ' & ' ' & ' perform ' & ' until end-of-file ' & ' set read-next-file to true ' & '#### read file next 4 sp ' & * read file-name next ' at end ' & ' continue ' & ' not at end ' & ' perform c40-test-values ' & ' if values-found ' & ' add 1 to ws-rec-cnt ' & ' set write-file to true ' & '#### write temp-file 12 sp ' & ' end-write ' & ' end-if ' & ' end-read ' & ' end-perform ' & ' ' & ' set close-file to true ' & '#### close temp-file 4 sp ' & ' ' & ' if ws-rec-cnt zero ' & ' move "No records found" to ws-err-msg ' & ' else ' & '#### call fview ' & ' end-if ' & ' ' & ' set file-delete-file to true ' & '#### delete file temp-file ' & ' ' & ' if ws-err-msg not = spaces ' & ' perform ' & ' varying ws-ptr from length ws-err-msg by -1 ' & ' until ws-err-msg(ws-ptr:1) not = space ' & ' continue ' & ' end-perform ' & ' compute ' & ' ws-to = (80 - ws-ptr) / 2 ' & ' move ws-err-msg(1:ws-ptr) ' & ' to ws-centred-msg ' & ' (ws-to:ws-ptr) ' & ' end-if ' & ' ' & ' perform c30-get-values ' & ' ' & ' move spaces to ws-err-msg ' & ' ws-centred-msg ' & ' . '. 03 filler value ' ' & ' b9-end section. ' & ' ' & ' move "b9" to ws-dec-para-name ' & ' ' & ' set close-file to true ' & '#### close act file no sp ' & ' . ' & ' ' & ' c30-get-values section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c30" to ws-dec-para-name ' & ' ' & ' move green to ws-foreground ' & ' display ss-header ' & ' ' & ' evaluate ws-page-num ' & ' when 1 ' & '#### display page 1 ' & ' when 2 ' & '#### display page 2 ' & ' end-evaluate ' & ' ' & ' perform d20-get-fields ' & ' with test after ' & ' until (Accept-terminated or User-func) ' & ' or (ADIS-key and Escape-key) ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & ' c40-test-values section. ' & ' ' & ' perform x1-push-para-name ' & ' move "c40" to ws-dec-para-name ' & ' ' & ' set values-found to true ' & ' ' & '#### test values ' & ' . ' & ' ' & ' d20-get-fields section. ' & ' ' & '* Use cursor & page keys to move between fields ' & ' ' & ' perform x1-push-para-name ' & ' move "d20" to ws-dec-para-name ' & ' ' & ' move 1 to ws-field ' & ' ' & ' perform ' & ' with test after ' & ' until Accept-terminated ' & ' or User-func ' & ' or (ADIS-key and Escape-key) ' & ' evaluate ws-field ' & '#### accepts ' & ' end-evaluate ' & * Delete the following lines if not being used with odd key mappings ' if User-func ' & ' evaluate true ' & ' when Home-key-nonstd ' & ' set Home-key to true ' & ' set ADIS-key to true ' & ' when End-key-nonstd ' & ' set End-key to true ' & ' set ADIS-key to true ' & ' end-evaluate ' & ' end-if ' & * Stop deleting now ' if ADIS-key ' & ' evaluate true ' & ' when Tab-key ' & ' when cursor-right ' & ' when cursor-down ' & ' if ws-field < ws-last-fld ' & ' add 1 to ws-field ' & ' else ' & ' move 1 to ws-field ' & ' end-if ' & ' when Backtab-key ' & ' when cursor-left ' & ' when cursor-up ' & ' if ws-field > 1 ' & ' subtract 1 from ws-field ' & ' else ' & ' move ws-last-fld ' & ' to ws-field ' & ' end-if ' & ' when Home-key ' & ' move 1 to ws-field ' & ' when End-key ' & ' move ws-last-fld ' & ' to ws-field ' & ' end-evaluate ' & ' end-if ' & ' end-perform ' & ' ' & ' perform x3-pop-para-name ' & ' . ' & ' ' & ' x1-push-para-name section. ' & ' ' & '* Add paragraph name to called stack ' & '* Check that stack is not going to overflow ' & ' ' & ' if ws-para-ptr < 1 or > 9 ' & ' move 1 to ws-para-ptr ' & ' else ' & ' add 1 to ws-para-ptr ' & ' end-if ' & ' ' & ' move ws-dec-para-name to ws-para-name(ws-para-ptr) ' & ' . ' & ' ' & ' x3-pop-para-name section. ' & ' ' & '* Remove paragraph name from called stack and put it in ' & '* ws-dec-para-name as current paragraph ' & '* Check that stack will not underflow ' & ' ' & ' if ws-para-ptr > zero and < 11 ' & ' move ws-para-name(ws-para-ptr) ' & ' to ws-dec-para-name ' & ' subtract 1 from ws-para-ptr ' & ' end-if ' & ' . ' & '#### end '. 01 filler redefines ws-srch-skeleton-tbl. 03 ws-srch-skel-line pic x(63) occurs 600 times. 78 c-nl value x'0a'. *> Change for Windows 78 c-reclen-len value length ws-rec-len-x. 78 c-max-keys value length ws-key-tbl / length ws-key-entry. 78 black value zero. 78 blue value 1. 78 green value 2. 78 cyan value 3. 78 red value 4. 78 magenta value 5. 78 yellow value 6. 78 white value 7. screen section. 01 ss-params background-colour black foreground-colour green. 03 blank screen. 03 line 5 col 26 "Program generator parameters". 03 line + 2. 03 col 10 "File name:". 03 ss-file-name col 30 foreground-colour yellow using ws-prog-file-name. 03 line + 2. 03 col 10 "Select copy member". 03 ss-sel-file-name col 30 foreground-colour yellow using sel-file-name. 03 line + 2. 03 col 10 "FD copy member". 03 ss-fd-file-name col 30 foreground-colour yellow using fd-file-name. 03 line + 2. 03 col 10 "Program type". 03 ss-prog-type col 30 foreground-colour yellow using ws-prog-type. 03 col 35 "View/Search". procedure division. declaratives. file-failure section. use after standard error procedure on sel-file fd-file. if valid-io exit section end-if display "File access error" at 1025 with blank screen display "File: " at 1225 ws-file-name display "Operation: " at 1425 ws-file-operation if ws-file-status-1 = "9" move ws-file-status-2 to ws-disp-file-status-2 display "File status: 9/" at 1625 ws-disp-file-status-2 else display "File status: " at 1625 ws-file-status end-if accept ws-dummy goback . end declaratives. a-control section. move "generateprog" to ws-prog-name perform b1-start perform b3-main perform b5-end goback . b1-start section. move "b1" to ws-dec-para-name initialize ws-sel-tbl ws-fld-tbl ws-key-tbl ws-replace-tbl accept ws-command-line from command-line unstring ws-command-line delimited by all space into ws-prog-file-name sel-file-name fd-file-name ws-prog-type if ws-prog-file-name = spaces or sel-file-name = spaces or fd-file-name = spaces or ws-prog-type = spaces display "Not all parameters supplied" goback end-if if (User-func and Escape-key) goback end-if if not view-prog and not srch-prog display "Program type must be View or Search" goback end-if display "COBCPY" upon environment-name accept ws-cobcopy from environment-value display "COBDATA" upon environment-name display ws-cobcopy upon environment-value move sel-file-name to ws-file-name set open-in-file to true open input sel-file move fd-file-name to ws-file-name set open-in-file to true open input fd-file perform varying ws-prog-file-name-len from length ws-prog-file-name by -1 until ws-prog-file-name(ws-prog-file-name-len:1) not = space end-perform move spaces to ws-rec-prefix if view-prog perform s41-open-view-vfiles else perform s43-open-srch-vfiles end-if . b3-main section. move "b3" to ws-dec-para-name perform c1-parse-sel perform c3-parse-fd if view-prog perform c5-generate-view else perform c7-generate-srch end-if . b5-end section. move "b5" to ws-dec-para-name set close-file to true move "Both" to ws-file-name close sel-file fd-file if view-prog perform s51-close-view-vfiles else perform s53-close-srch-vfiles end-if . c1-parse-sel section. perform x1-push-para-name move "c1" to ws-dec-para-name move zero to ws-word-ptr set literal-file to true perform with test after until end-of-file read sel-file at end exit perform end-read * Comment or spaces line? if sel-char(1) = "*" or sel-char(7) = "*" or sel-rec = spaces exit perform cycle end-if move spaces to sel-rec(1:6) perform d1-parse-sel-line end-perform add 1 to ws-word-ptr move "." to ws-sel-word(ws-word-ptr) perform varying ws-word-ptr from 1 by 1 until ws-sel-word(ws-word-ptr) = "." evaluate ws-sel-word(ws-word-ptr) when "assign" move spaces to ws-phys-file-name move 1 to ws-phys-file-name-len compute ws-ptr = ws-word-ptr + 1 if ws-sel-word(ws-ptr) = "to" add 1 to ws-ptr end-if perform varying ws-ptr from ws-ptr by 1 until ws-sel-word(ws-ptr) not = "external" and not = "dynamic" and not = "line" and not = "advancing" and not = "multiple" and not = "reel" and not = "unit" and not = "file" and not = "disk" and not = "keyboard" and not = "display" and not = "printer" and not = "printer-1" string ws-sel-word(ws-ptr) delimited by space " " delimited by size into ws-phys-file-name pointer ws-phys-file-name-len evaluate ws-sel-word(ws-ptr) when "dynamic" set dynamic-file to true when "external" set external-file to true end-evaluate end-perform string ws-sel-word(ws-ptr) delimited by space into ws-phys-file-name pointer ws-phys-file-name-len move ws-sel-word(ws-ptr) to ws-term-file-name when "status" if ws-sel-word(ws-word-ptr + 1) = "is" move ws-sel-word(ws-word-ptr + 2) to ws-file-status-name else move ws-sel-word(ws-word-ptr + 1) to ws-file-status-name end-if end-evaluate end-perform if ws-term-file-name = spaces move zero to ws-term-file-name-len else perform varying ws-term-file-name-len from length ws-term-file-name by -1 until ws-term-file-name(ws-term-file-name-len:1) not = space end-perform end-if perform x3-pop-para-name . c3-parse-fd section. perform x1-push-para-name move "c3" to ws-dec-para-name move zero to ws-entry-ptr perform d3-parse-fd-lines move ws-entry-ptr to ws-last-fld perform d5-parse-fd-entry perform d7-parse-keys perform x3-pop-para-name . c5-generate-view section. perform x1-push-para-name move "c5" to ws-dec-para-name move 3 to ws-line-ptr ws-col-ptr move zero to ws-group-depth perform d9-process-view-fields varying ws-fld-ptr from 1 by 1 until ws-fld-ptr > ws-last-fld move ws-vfile-offsets to ws-vfile-lengths move spaces to ws-disp-line perform varying ws-skel-ptr from 1 by 1 until ws-view-skel-line(ws-skel-ptr) = "#### end" if ws-view-skel-line(ws-skel-ptr)(1:4) = "####" evaluate ws-view-skel-line(ws-skel-ptr)(6:) when "program id" display ws-6sp ' program-id. fview' ws-prog-file-name(1:ws-prog-file-name-len) '.' when "copy select" perform d11-view-copy-select when "copy fd" perform d13-view-copy-fd when "file name" if literal-file and ws-term-file-name(1:1) not = '"' and not = "'" display ws-6sp '**** Value needed for filename' c-nl ws-6sp ' 01 ' ws-term-file-name(1:ws-term-file-name-len) c-nl ws-39sp 'pic x(60).' c-nl end-if when "key fields" move zero to ws-key-flds-vfile-offset perform until ws-key-flds-vfile-offset not < ws-key-flds-vfile-length perform s21-read-key-flds-vfile display ws-11sp ws-vfile-rec(1:ws-rec-len) end-perform when "ctrl fields" move zero to ws-ctrl-flds-vfile-offset perform until ws-ctrl-flds-vfile-offset not < ws-ctrl-flds-vfile-length perform s23-read-ctrl-flds-vfile if ws-rec-len < 24 move 'pic x(50).' to ws-vfile-rec(25:) display ws-11sp '03 ' ws-vfile-rec(1:34) else display ws-11sp '03 ' ws-vfile-rec(1:ws-rec-len) c-nl ws-39sp 'pic x(50).' end-if end-perform when "key sets" perform d17-view-key-sets when "file status" perform d19-view-srch-file-status when "screen definition" perform d21-view-screen-defn when "f-keys" perform d23-view-f-keys when "declaratives" perform d25-view-declaratives when "control" perform d27-view-control-section when "start" perform d29-view-start-section when "close file 12 sp" when "close file no sp" evaluate ws-view-skel-line(ws-skel-ptr)(17:2) when "no" move zero to ws-space-len when "12" move 12 to ws-space-len end-evaluate display ws-11sp ws-spaces(1:ws-space-len) 'close ' ws-act-file-name(1:ws-act-file-name-len) when "when clause read-by-key" perform varying ws-key-ptr from 1 by 1 until ws-key-name(ws-key-ptr) = spaces move ws-key-ptr to ws-disp-key-ptr display ws-11sp 'when key-' ws-disp-key-ptr c-nl ws-11sp ' perform d' ws-disp-key-ptr '-read-by-key' ws-disp-key-ptr end-perform when "read file prev no sp" when "read file prev 4 sp" evaluate ws-view-skel-line(ws-skel-ptr)(21:2) when "no" move zero to ws-space-len when "4 " move 4 to ws-space-len end-evaluate display ws-11sp ws-spaces(1:ws-space-len) 'read ' ws-act-file-name(1:ws-act-file-name-len) ' previous ignore lock' when "read file next no sp" when "read file next 4 sp" evaluate ws-view-skel-line(ws-skel-ptr)(21:2) when "no" move zero to ws-space-len when "4 " move 4 to ws-space-len end-evaluate display ws-11sp ws-spaces(1:ws-space-len) 'read ' ws-act-file-name(1:ws-act-file-name-len) ' next ignore lock' when "low values" display ws-11sp 'move low-values ' 'to ' ws-act-rec-name(1:ws-act-rec-name-len) when "when clause read-first" perform d31-view-file-starts when "init rec 4 sp" display ws-11sp ' initialize ' ws-act-rec-name(1:ws-act-rec-name-len) when "high values" display ws-11sp 'move high-values ' 'to ' ws-act-rec-name(1:ws-act-rec-name-len) when "when clause read-last" perform d33-view-when-start-not-gt when "when clause get-key key-sets" perform d35-view-when-set-up-key-flds when "when clause get-key highlights" move zero to ws-key-colour-vfile-offset perform until ws-key-colour-vfile-offset not < ws-key-colour-vfile-length perform s29-read-key-colour-vfile display ws-11sp ' ' ws-vfile-rec(1:ws-rec-len) end-perform when "display page 1" display ws-11sp ' display ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-1' when "display page 2" display ws-6sp '* display ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-2' when "read by keys" perform d37-view-read-by-keys varying ws-key-ptr from 1 by 1 until ws-key-name(ws-key-ptr) = spaces when "when clause accept fields" move zero to ws-key-accepts-vfile-offset perform until ws-key-accepts-vfile-offset not < ws-key-accepts-vfile-length perform s31-read-key-accepts-vfile display ws-11sp ' ' ws-vfile-rec(1:ws-rec-len) end-perform end-evaluate else if ws-view-skel-line(ws-skel-ptr) = spaces display ' ' else perform varying ws-ptr from length ws-view-skel-line by -1 until ws-view-skel-line(ws-skel-ptr)(ws-ptr:1) not = space end-perform display ws-6sp ws-view-skel-line(ws-skel-ptr)(1:ws-ptr) end-if end-if end-perform perform x3-pop-para-name . c7-generate-srch section. perform x1-push-para-name move "c7" to ws-dec-para-name * Move all group occurs to the item level perform varying ws-fld-ptr from 1 by 1 until ws-fld-ptr > ws-last-fld if ws-fld-pic(ws-fld-ptr) = spaces and ws-fld-occurs(ws-fld-ptr) > 1 compute ws-ptr = ws-fld-ptr + 1 perform varying ws-ptr from ws-ptr by 1 until ws-ptr > ws-last-fld or ws-fld-level(ws-ptr) not > ws-fld-level(ws-fld-ptr) move ws-fld-occurs(ws-fld-ptr) to ws-fld-occurs(ws-ptr) end-perform end-if end-perform perform d15-process-srch-fields varying ws-fld-ptr from 1 by 1 until ws-fld-ptr > ws-last-fld move spaces to ws-vfile-rec move 1 to ws-rec-len string 'move ' delimited by size ws-last-fld-name delimited by space into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s63-write-fld-num-gen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'to ws-last-fld' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s63-write-fld-num-gen-vfile perform varying ws-ptr from 1 by 1 until ws-ptr > length ws-act-file-name or ws-act-file-name(ws-ptr:1) = "-" end-perform if ws-ptr > length ws-act-file-name move 1 to ws-ptr else add 1 to ws-ptr end-if move "temp-" to ws-temp-file-name move ws-act-file-name(ws-ptr:) to ws-temp-file-name(6:) perform varying ws-temp-file-name-len from length ws-temp-file-name by -1 until ws-temp-file-name(ws-temp-file-name-len:1) not = space end-perform move '"$TMP/TEMPFILE$$"' to ws-temp-file-name-val perform varying ws-temp-file-name-val-len from length ws-temp-file-name-val by -1 until ws-temp-file-name-val-len > length ws-temp-file-name-val or ws-temp-file-name-val(ws-temp-file-name-val-len:1) not = space end-perform perform varying ws-ptr from 1 by 1 until ws-ptr > length ws-act-rec-name or ws-act-rec-name(ws-ptr:1) = "-" end-perform if ws-ptr > length ws-act-rec-name move 1 to ws-ptr else add 1 to ws-ptr end-if move "temp-" to ws-temp-rec-name move ws-act-rec-name(ws-ptr:) to ws-temp-rec-name(6:) perform varying ws-temp-rec-name-len from length ws-temp-rec-name by -1 until ws-temp-rec-name(ws-temp-rec-name-len:1) not = space end-perform move "ws-" to ws-ws-rec-name move ws-act-rec-name(ws-ptr:) to ws-ws-rec-name(4:) perform varying ws-ws-rec-name-len from length ws-ws-rec-name by -1 until ws-ws-rec-name(ws-ws-rec-name-len:1) not = space end-perform move ws-vfile-offsets to ws-vfile-lengths perform varying ws-skel-ptr from 1 by 1 until ws-srch-skel-line(ws-skel-ptr) = "#### end" if ws-srch-skel-line(ws-skel-ptr)(1:4) = "####" evaluate ws-srch-skel-line(ws-skel-ptr)(6:) when "program id" display ws-6sp ' program-id. fsrch' ws-prog-file-name(1:ws-prog-file-name-len) '.' when "copy selects" perform d41-srch-copy-selects when "copy fds" perform d43-srch-copy-fds when "copy ws" perform d45-srch-copy-ws when "field numbers" move zero to ws-fld-nums-vfile-offset perform until ws-fld-nums-vfile-offset not < ws-fld-nums-vfile-length perform s71-read-fld-nums-vfile display ws-11sp ws-vfile-rec(1:ws-rec-len) end-perform when "file status" perform d19-view-srch-file-status when "screen definition" perform d47-srch-screen-definition when "declaratives" perform d49-srch-declaratives when "control" perform d51-srch-control when "start" perform d53-srch-start-section when "main" perform d55-srch-main when "read file next 4 sp" move 4 to ws-space-len perform d57-srch-read when "write temp-file 12 sp" move zero to ws-space-len perform d59-srch-write-temp-file when "close temp-file 4 sp" move 4 to ws-space-len display ws-11sp ws-spaces(1:ws-space-len) 'close ' ws-temp-file-name (1:ws-temp-file-name-len) when "call fview" perform d61-srch-call-fview when "delete file temp-file" perform d63-srch-delete-temp-file when "close act file no sp" move zero to ws-space-len perform d65-srch-close-act-file when "display page 1" display ws-11sp ' display ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-1' when "display page 2" display ws-6sp '* display ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-2' when "test values" move zero to ws-test-vals-vfile-offset perform until ws-test-vals-vfile-offset not < ws-test-vals-vfile-length perform s75-read-test-vals-vfile display ws-11sp ws-vfile-rec(1:ws-rec-len) end-perform when "accepts" move zero to ws-accepts-vfile-offset perform until ws-accepts-vfile-offset not < ws-accepts-vfile-length perform s77-read-accepts-vfile display ws-11sp ' ' ws-vfile-rec(1:ws-rec-len) end-perform end-evaluate else if ws-srch-skel-line(ws-skel-ptr) = spaces display ' ' else perform varying ws-ptr from length ws-srch-skel-line by -1 until ws-srch-skel-line(ws-skel-ptr)(ws-ptr:1) not = space end-perform display ws-6sp ws-srch-skel-line(ws-skel-ptr)(1:ws-ptr) end-if end-if end-perform perform x3-pop-para-name . d1-parse-sel-line section. perform x1-push-para-name move "d1" to ws-dec-para-name * Remove in-line comments perform varying ws-line-ptr from 1 by 1 until ws-line-ptr > length sel-rec or sel-rec(ws-line-ptr:2) = "*>" end-perform if ws-line-ptr not > length sel-rec move spaces to sel-rec(ws-line-ptr:) end-if move 1 to ws-line-ptr perform until ws-line-ptr > length sel-rec or sel-rec(ws-line-ptr:) = spaces perform varying ws-line-ptr from ws-line-ptr by 1 until sel-rec(ws-line-ptr:1) not = space end-perform add 1 to ws-word-ptr unstring sel-rec delimited by all spaces or "." into ws-sel-word(ws-word-ptr) delimiter in ws-delim pointer ws-line-ptr if ws-sel-word(ws-word-ptr)(1:1) not = '"' and not = "'" move function lower-case(ws-sel-word(ws-word-ptr)) to ws-sel-word(ws-word-ptr) end-if end-perform perform x3-pop-para-name . d3-parse-fd-lines section. perform x1-push-para-name move "d3" to ws-dec-para-name perform with test after until end-of-file read fd-file at end exit perform end-read * Comment or spaces line? if fd-char(1) = "*" or fd-char(7) = "*" or fd-rec(8:) = spaces exit perform cycle end-if move spaces to fd-rec(1:6) move spaces to ws-delim move zero to ws-word-ptr perform e1-get-sentence until ws-delim = "." if ws-word(1) = "fd" move ws-words to ws-fd-words else add 1 to ws-entry-ptr perform e1-parse-data-defn end-if move zero to ws-word-ptr end-perform perform x3-pop-para-name . d5-parse-fd-entry section. perform x1-push-para-name move "d5" to ws-dec-para-name move zero to ws-replace-ptr move ws-fd-word(2) to ws-act-file-name perform varying ws-act-file-name-len from length ws-act-file-name by -1 until ws-act-file-name(ws-act-file-name-len:1) not = space end-perform perform varying ws-word-ptr from 3 by 1 until ws-fd-word(ws-word-ptr) = "." evaluate ws-fd-word(ws-word-ptr) when "external" add 1 to ws-replace-ptr if ws-fd-word(ws-word-ptr - 1) = "is" move "==is external== by ====" to ws-replace(ws-replace-ptr) else move "==external== by ====" to ws-replace(ws-replace-ptr) end-if when "value" add 1 to ws-replace-ptr move '==' to ws-replace(ws-replace-ptr) move 3 to ws-replace-str-ptr perform varying ws-ptr from ws-word-ptr by 1 until ws-fd-word(ws-ptr) not = "value" and not = "of" and not = "id" and not = "file-id" and not = "is" string ws-fd-word(ws-ptr) delimited by space ' ' delimited by size into ws-replace(ws-replace-ptr) pointer ws-replace-str-ptr end-perform string ws-fd-word(ws-ptr) delimited by space '== by ====' delimited by size into ws-replace(ws-replace-ptr) pointer ws-replace-str-ptr move ws-ptr to ws-word-ptr end-evaluate end-perform perform x3-pop-para-name . d7-parse-keys section. perform x1-push-para-name move "d7" to ws-dec-para-name move zero to ws-key-ptr perform varying ws-word-ptr from 5 by 1 until ws-sel-word(ws-word-ptr) = "." evaluate ws-sel-word(ws-word-ptr) when "record" when "alternate" perform e5-parse-key end-evaluate end-perform perform x3-pop-para-name . d9-process-view-fields section. perform x1-push-para-name move "d9" to ws-dec-para-name * For some unknown reason, the file prefix at Company X is in * the 03 and lower levels, not at the 01 level, so I'm using the * first non-01 level that isn't a filler to provide the prefix if ws-fld-level(ws-fld-ptr) > 01 and ws-fld-name(ws-fld-ptr) not = "filler" and ws-rec-prefix = spaces move 1 to ws-rec-prefix-len unstring ws-fld-name(ws-fld-ptr) delimited by "-" into ws-rec-prefix pointer ws-rec-prefix-len subtract 1 from ws-rec-prefix-len move "-" to ws-rec-prefix(ws-rec-prefix-len:1) end-if * If we're in an occurring group, have we come to the end of it? if ws-group-depth > zero and ws-fld-level(ws-fld-ptr) not > ws-group-level(ws-group-depth) subtract 1 from ws-group-depth end-if * If it's a non-occurring group field, forget it if ws-fld-pic(ws-fld-ptr) = spaces and ws-fld-occurs(ws-fld-ptr) = zero perform x3-pop-para-name exit section end-if * Key fields need to have various associated fields generated, * plus some procedure division for handling value comparison * and accepts if ws-fld-keys(ws-fld-ptr) not = zeroes perform e7-view-key-field end-if * Definition of screen field * Descriptive name perform varying ws-ptr from 1 by 1 until ws-fld-name(ws-fld-ptr)(ws-ptr:1) = "-" or space end-perform * Lose the prefix, then replace all hyphens with spaces and * put a ":" afterwards if ws-fld-name(ws-fld-ptr)(ws-ptr:1) = "-" add 1 to ws-ptr else move 1 to ws-ptr end-if * If it's an occurring group or field, put in an occurs line and * shove subsidiary items down a level if it's a group, or just * the field itself if it's a field. * ws-group-depth is the number of layers of occurs * ws-group-level is an array of levels at which occurs happened, * so we can detect when we've come to the end of them. compute ws-this-level = 03 + (ws-group-depth * 2) compute ws-space-len = ws-group-depth * 4 if ws-fld-occurs(ws-fld-ptr) not zero add 1 to ws-group-depth move ws-fld-level(ws-fld-ptr) to ws-group-level(ws-group-depth) move spaces to ws-vfile-rec move 1 to ws-rec-len string ws-spaces(1:ws-space-len) ws-this-level ' ss-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s13-write-screen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len move ws-fld-occurs(ws-fld-ptr) to ws-disp-fld-occurs string 'occurs ' ws-disp-fld-occurs '.' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s13-write-screen-vfile if ws-fld-pic(ws-fld-ptr) = spaces *> this is a group exit section end-if add 2 to ws-this-level add 4 to ws-space-len end-if * Have a stab at the field description move ws-fld-name(ws-fld-ptr)(ws-ptr:) to ws-scr-desc inspect ws-scr-desc replacing all "-" by space move function upper-case(ws-scr-desc(1:1)) to ws-scr-desc(1:1) * For key fields, we want control clauses to allow different * colours to be used when they're the fields for the selected * key - simplest by applying to a group and having the field * description and value lines in that group if ws-fld-keys(ws-fld-ptr) not = zero move spaces to ws-vfile-rec move 1 to ws-rec-len string ws-spaces(1:ws-space-len) ws-this-level ' ss-' delimited by size ws-ws-key-fld-name(4:) delimited by space into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s13-write-screen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'control ' ws-ws-key-fld-name(1:ws-ws-key-fld-name-len) '-ctrl.' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s13-write-screen-vfile add 2 to ws-this-level add 4 to ws-space-len end-if * Field description line move spaces to ws-vfile-rec move 1 to ws-rec-len string ws-spaces(1:ws-space-len) ws-this-level ' col + 2' delimited by size into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s13-write-screen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'value "' ws-scr-desc delimited by size into ws-vfile-rec pointer ws-rec-len perform varying ws-rec-len from ws-rec-len by -1 until ws-vfile-rec(ws-rec-len:1) not = space end-perform add 1 to ws-rec-len move ':".' to ws-vfile-rec(ws-rec-len:) add 2 to ws-rec-len perform s13-write-screen-vfile * Field value line move spaces to ws-vfile-rec move 1 to ws-rec-len string ws-spaces(1:ws-space-len) ws-this-level ' col + 2' delimited by size into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s13-write-screen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len if ws-fld-keys(ws-fld-ptr) not = zero string 'using ' delimited by size into ws-vfile-rec pointer ws-rec-len else string 'from ' delimited by size into ws-vfile-rec pointer ws-rec-len end-if string ws-fld-name(ws-fld-ptr) delimited by space '.' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s13-write-screen-vfile perform x3-pop-para-name . d11-view-copy-select section. perform x1-push-para-name move "d11" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' copy "' delimited by size sel-file-name delimited by space '"' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'replacing ==' ws-phys-file-name(1:ws-phys-file-name-len) '==' c-nl ws-11sp ' by ==dynamic ws-view-file-name==.' perform x3-pop-para-name . d13-view-copy-fd section. perform x1-push-para-name move "d13" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' copy "' delimited by size fd-file-name delimited by space '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-replace-ptr not zero display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'replacing' perform varying ws-tbl-ptr from 1 by 1 until ws-tbl-ptr > ws-replace-ptr perform varying ws-ptr from length ws-replace by -1 until ws-replace(ws-tbl-ptr)(ws-ptr:1) not = space end-perform display ws-11sp ' ' ws-replace(ws-tbl-ptr)(1:ws-ptr) end-perform display ws-11sp '.' else display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) '.' c-nl end-if perform x3-pop-para-name . d15-process-srch-fields section. perform x1-push-para-name move "d15" to ws-dec-para-name * For some unknown reason, the file prefix at Company X is in * the 03 and lower levels, not at the 01 level, so I'm using the * first non-01 level that isn't a filler to provide the prefix if ws-fld-level(ws-fld-ptr) > 01 and ws-fld-name(ws-fld-ptr) not = "filler" and ws-rec-prefix = spaces move 1 to ws-rec-prefix-len unstring ws-fld-name(ws-fld-ptr) delimited by "-" into ws-rec-prefix pointer ws-rec-prefix-len subtract 1 from ws-rec-prefix-len move "-" to ws-rec-prefix(ws-rec-prefix-len:1) end-if * If it's a group field, forget it if ws-fld-pic(ws-fld-ptr) = spaces perform x3-pop-para-name exit section end-if if ws-fld-occurs(ws-fld-ptr) not zero evaluate ws-fld-occurs(ws-fld-ptr) when 1 thru 9 move 4 to ws-occ-start when 10 thru 99 move 3 to ws-occ-start when 100 thru 999 move 2 to ws-occ-start when other move 1 to ws-occ-start end-evaluate perform e9-occurring-srch-fld varying ws-occ-ptr from 1 by 1 until ws-occ-ptr > ws-fld-occurs(ws-fld-ptr) else perform e11-single-srch-fld end-if perform x3-pop-para-name . d17-view-key-sets section. perform x1-push-para-name move "d17" to ws-dec-para-name perform varying ws-key-ptr from 1 by 1 until ws-key-ptr > c-max-keys or ws-key-name(ws-key-ptr) = spaces move ws-key-ptr to ws-disp-key-ptr display c-nl ws-6sp ' 01 ws-key' ws-disp-key-ptr '-fields.' move zero to ws-key-cnt perform varying ws-fld-ptr from 1 by 1 until ws-fld-ptr > ws-last-fld if key-field(ws-fld-ptr ws-key-ptr) add 1 to ws-key-cnt move ws-fld-key-seq(ws-fld-ptr ws-key-ptr) to ws-key-fld-ptr move ws-fld-name(ws-fld-ptr) to ws-key-fld-name(ws-key-fld-ptr) end-if end-perform display ws-11sp '03 filler pic 9' c-nl ws-39sp 'value ' ws-key-cnt '.' perform varying ws-key-fld-ptr from 1 by 1 until ws-key-fld-ptr > ws-key-cnt move spaces to ws-disp-line move 1 to ws-disp-ptr string 'value is "' delimited by size ws-key-fld-name(ws-key-fld-ptr) delimited by space '".' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp '03 filler pic x(30)' c-nl ws-39sp ws-disp-line(1:ws-disp-ptr - 1) end-perform end-perform perform x3-pop-para-name . d19-view-srch-file-status section. perform x1-push-para-name move "d19" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' 01 ' delimited by size ws-file-status-name delimited by space into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 32 display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 34 to ws-disp-ptr string 'pic x(2).' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) move ' 01 ws-file-status' to ws-disp-line move 34 to ws-disp-ptr string 'redefines ' delimited by size ws-file-status-name delimited by space '.' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) perform x3-pop-para-name . d21-view-screen-defn section. perform x1-push-para-name move "d21" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' 03 col 35 value "' function upper-case(ws-prog-file-name(1:1)) ws-prog-file-name(2:ws-prog-file-name-len - 1) ' file".' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp '03 col 65 value "Page".' c-nl ws-11sp '03 col + 2 from ws-page-num.' c-nl ws-11sp '03 col + 2 value "of".' c-nl ws-11sp '03 col + 2 from ws-last-page.' c-nl move spaces to ws-disp-line move 1 to ws-disp-ptr string ' 01 ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-1.' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-6sp ' 03 line 2.' move zero to ws-screen-vfile-offset perform until ws-screen-vfile-offset not < ws-screen-vfile-length perform s33-read-screen-vfile display ws-11sp ws-vfile-rec(1:ws-rec-len) end-perform display c-nl ws-6sp '*01 ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-2.' perform x3-pop-para-name . d23-view-f-keys section. perform x1-push-para-name move "d23" to ws-dec-para-name perform varying ws-key-ptr from 1 by 1 until ws-key-ptr > c-max-keys or ws-key-name(ws-key-ptr) = spaces end-perform subtract 1 from ws-key-ptr evaluate ws-key-ptr when zero thru 1 display ws-11sp ' " ".' when 2 thru 9 move ws-key-ptr to ws-disp-key-ptr display ws-11sp ' "F1-F' ws-disp-key-ptr(2:1) ' - keys".' when other move ws-key-ptr to ws-disp-key-ptr display ws-11sp ' "F1-F' ws-disp-key-ptr ' - keys".' end-evaluate perform x3-pop-para-name . d25-view-declaratives section. perform x1-push-para-name move "d25" to ws-dec-para-name display ws-6sp ' ' ws-prog-file-name(1:ws-prog-file-name-len) '-error-procedure section.' c-nl ws-6sp ' use after standard error procedure on ' ws-act-file-name(1:ws-act-file-name-len) '.' c-nl perform x3-pop-para-name . d27-view-control-section section. perform x1-push-para-name move "d27" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string 'move "fview' ws-prog-file-name(1:ws-prog-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-prog-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line move 1 to ws-disp-ptr string 'move "' ws-act-file-name(1:ws-act-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) perform x3-pop-para-name . d29-view-start-section section. perform x1-push-para-name move "d29" to ws-dec-para-name display ws-11sp 'if externalfilename = spaces or low-values' c-nl ws-11sp ' accept ws-view-file-name' c-nl ws-39sp 'from command-line' c-nl ws-11sp ' if ws-view-file-name = spaces' evaluate true when dynamic-file display ws-11sp ' call "getdynfilename"' c-nl ws-39sp 'using "' ws-term-file-name '"' c-nl ws-39sp ' ws-view-file-name' c-nl ws-11sp ' on exception' c-nl ws-11sp ' continue' c-nl ws-11sp ' end-call' c-nl ws-11sp ' if ws-view-file-name = spaces' c-nl ws-11sp ' display ss-dynamic-file-name' c-nl ws-11sp ' accept ss-dynamic-file-name' c-nl ws-11sp ' if User-func and Escape-key' c-nl ws-11sp ' move spaces' c-nl ws-39sp 'to externalstackprog' c-nl ws-39sp ' (externalstackptr)' c-nl ws-11sp ' subtract 1' c-nl ws-39sp 'from externalstackptr' c-nl ws-11sp ' goback' c-nl ws-11sp ' end-if' c-nl ws-11sp ' end-if' c-nl when external-file display ws-11sp ' display "' ws-term-file-name(1:ws-term-file-name-len) '"' c-nl ws-39sp 'upon environment-name' c-nl ws-11sp ' accept ws-view-file-name' c-nl ws-39sp 'from environment-value' when literal-file display ws-11sp ' move ' ws-term-file-name(1:ws-term-file-name-len) c-nl ws-39sp 'to ws-view-file-name' end-evaluate display ws-11sp ' end-if' c-nl ws-11sp 'else' c-nl ws-11sp ' move externalfilename to ws-view-file-name' c-nl ws-11sp 'end-if' c-nl display ws-11sp 'if ws-view-file-name = spaces' c-nl ws-11sp ' move spaces' c-nl ws-39sp 'to externalstackprog' c-nl ws-39sp ' (externalstackptr)' c-nl ws-11sp ' subtract 1' c-nl ws-39sp 'from externalstackptr' c-nl ws-11sp ' goback' c-nl ws-11sp 'end-if' c-nl move spaces to ws-disp-line move 1 to ws-disp-ptr display ws-11sp 'set open-in-file to true' c-nl ws-11sp 'open input ' ws-act-file-name(1:ws-act-file-name-len) c-nl c-nl ws-11sp 'initialize ' ws-act-rec-name(1:ws-act-rec-name-len) c-nl c-nl ws-6sp '* If an external key has been supplied, program ' 'has been invoked' c-nl ws-6sp '* from another viewer program' c-nl c-nl ws-11sp 'if externalkey = spaces or low-values' c-nl ws-11sp ' set prog-called to false' c-nl ws-11sp ' read ' ws-act-file-name(1:ws-act-file-name-len) ' next ignore lock' c-nl ws-11sp ' at end' c-nl ws-11sp ' display "Empty file" at 2401' c-nl ws-11sp ' set close-file to true' c-nl ws-11sp ' close ' ws-act-file-name(1:ws-act-file-name-len) c-nl ws-11sp ' goback' c-nl ws-11sp ' end-read' c-nl ws-11sp 'else' c-nl ws-11sp ' set prog-called to true' c-nl ws-11sp ' move externalkeyid to ws-key-id' c-nl ws-11sp ' evaluate ws-key-id' move zero to ws-externalkey-vfile-offset perform until ws-externalkey-vfile-offset not < ws-externalkey-vfile-length perform s79-read-externalkey-vfile display ws-11sp ' ' ws-vfile-rec(1:ws-rec-len) end-perform display ws-11sp ' end-evaluate' c-nl ws-11sp ' perform c1-read-by-key' c-nl ws-11sp 'end-if' perform x3-pop-para-name . d31-view-file-starts section. perform x1-push-para-name move "d31" to ws-dec-para-name perform varying ws-key-ptr from 1 by 1 until ws-key-name(ws-key-ptr) = spaces move spaces to ws-disp-line move 1 to ws-disp-ptr move ws-key-ptr to ws-disp-key-ptr string 'when key-' ws-disp-key-ptr delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line move 1 to ws-disp-ptr move ws-key-ptr to ws-disp-key-ptr string ' start ' ws-act-file-name(1:ws-act-file-name-len) ' key not < ' delimited by size ws-key-name(ws-key-ptr) delimited by space into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ' invalid key' c-nl ws-11sp ' continue' c-nl ws-11sp ' end-start' end-perform perform x3-pop-para-name . d33-view-when-start-not-gt section. perform x1-push-para-name move "d33" to ws-dec-para-name perform varying ws-key-ptr from 1 by 1 until ws-key-name(ws-key-ptr) = spaces move spaces to ws-disp-line move 1 to ws-disp-ptr move ws-key-ptr to ws-disp-key-ptr string 'when key-' ws-disp-key-ptr delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ' set start-file to true' move spaces to ws-disp-line move 1 to ws-disp-ptr move ws-key-ptr to ws-disp-key-ptr string ' start ' ws-act-file-name(1:ws-act-file-name-len) ' key not > ' delimited by size ws-key-name(ws-key-ptr) delimited by space into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ' invalid key' c-nl ws-11sp ' continue' c-nl ws-11sp ' end-start' end-perform perform x3-pop-para-name . d35-view-when-set-up-key-flds section. perform x1-push-para-name move "d35" to ws-dec-para-name perform varying ws-key-ptr from 1 by 1 until ws-key-name(ws-key-ptr) = spaces move spaces to ws-disp-line move 1 to ws-disp-ptr move ws-key-ptr to ws-disp-key-ptr string 'when key-' ws-disp-key-ptr delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line move 1 to ws-disp-ptr move ws-key-ptr to ws-disp-key-ptr string ' move ws-key' ws-disp-key-ptr '-fields' delimited by size into ws-disp-line pointer ws-disp-ptr move 29 to ws-disp-ptr string 'to ws-fields' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) end-perform perform x3-pop-para-name . d37-view-read-by-keys section. perform x1-push-para-name move "d37" to ws-dec-para-name move ws-key-ptr to ws-disp-key-ptr move spaces to ws-disp-line move 1 to ws-disp-ptr string ' d' ws-disp-key-ptr '-read-by-key' ws-disp-key-ptr ' section.' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl c-nl ws-11sp 'perform x1-push-para-name' move spaces to ws-disp-line move 1 to ws-disp-ptr string 'move "d' ws-disp-key-ptr '"' delimited by size into ws-disp-line pointer ws-disp-ptr move 29 to ws-disp-ptr string 'to ws-dec-para-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl move zero to ws-key-read-a-vfile-offset (ws-key-ptr) perform until ws-key-read-a-vfile-offset(ws-key-ptr) not < ws-key-read-a-vfile-length(ws-key-ptr) perform s25-read-key-read-a-vfile display ws-11sp ws-vfile-rec(1:ws-rec-len) end-perform move spaces to ws-disp-line move 1 to ws-disp-ptr string 'start ' ws-act-file-name(1:ws-act-file-name-len) ' key not < ' delimited by size ws-key-name(ws-key-ptr) delimited by space into ws-disp-line pointer ws-disp-ptr display c-nl ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'invalid key' move spaces to ws-disp-line move 1 to ws-disp-ptr string ' start ' ws-act-file-name(1:ws-act-file-name-len) ' key < ' delimited by size ws-key-name(ws-key-ptr) delimited by space into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ' invalid key' c-nl ws-11sp ' move "Empty file?" to ws-err-msg' move spaces to ws-disp-line move 1 to ws-disp-ptr string ' initialize ' ws-act-rec-name(1:ws-act-rec-name-len) delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ' perform x3-pop-para-name' c-nl ws-11sp ' exit section' c-nl ws-11sp ' end-start' c-nl ws-11sp 'end-start' c-nl c-nl ws-11sp 'set read-next-file to true' move spaces to ws-disp-line move 1 to ws-disp-ptr string 'read ' ws-act-file-name(1:ws-act-file-name-len) ' next ignore lock' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'at end' c-nl ws-11sp ' move "End of file found"' c-nl ws-11sp ' to ws-err-msg' c-nl ws-11sp ' set read-prev-file to true' move spaces to ws-disp-line move 1 to ws-disp-ptr string ' read ' ws-act-file-name(1:ws-act-file-name-len) ' previous ignore lock' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ' end-read' c-nl ws-11sp 'not at end' move zero to ws-key-read-b-vfile-offset (ws-key-ptr) perform until ws-key-read-b-vfile-offset(ws-key-ptr) not < ws-key-read-b-vfile-length(ws-key-ptr) perform s27-read-key-read-b-vfile display ws-11sp ' ' ws-vfile-rec(1:ws-rec-len) end-perform display ws-11sp ' move "Record not found"' c-nl ws-11sp ' to ws-err-msg' c-nl ws-11sp ' end-if' c-nl ws-11sp 'end-read' c-nl c-nl ws-11sp 'perform x3-pop-para-name' c-nl ws-11sp '.' c-nl perform x3-pop-para-name . d41-srch-copy-selects section. perform x1-push-para-name move "d41" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' copy "' delimited by size sel-file-name delimited by space '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-file-status-name = spaces move zero to ws-file-status-name-len else perform varying ws-file-status-name-len from length ws-file-status-name by -1 until ws-file-status-name(ws-file-status-name-len:1) not = space end-perform end-if display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'replacing ==' ws-phys-file-name(1:ws-phys-file-name-len) '==' c-nl ws-11sp ' by ==dynamic ws-view-file-name==.' c-nl c-nl ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'replacing ==' ws-act-file-name(1:ws-act-file-name-len) '== by ==' ws-temp-file-name(1:ws-temp-file-name-len) '==' c-nl ws-11sp ' ==' ws-phys-file-name(1:ws-phys-file-name-len) '== by ==' ws-temp-file-name-val(1:ws-temp-file-name-val-len) '==' c-nl ws-11sp ' ==' ws-act-rec-name(1:ws-act-rec-name-len) '== by ==' ws-temp-rec-name(1:ws-temp-rec-name-len) '==' c-nl ws-11sp ' ==' ws-file-status-name(1:ws-file-status-name-len) '== by ==ws-file-status==' c-nl ws-11sp ' leading ==' ws-rec-prefix(1:ws-rec-prefix-len) '== by ==temp-==.' perform x3-pop-para-name . d43-srch-copy-fds section. perform x1-push-para-name move "d43" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' copy "' delimited by size fd-file-name delimited by space '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-replace-ptr not zero display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'replacing' perform varying ws-ptr from 1 by 1 until ws-ptr > ws-replace-ptr display ws-11sp ' ' ws-replace(ws-ptr) end-perform display ws-11sp '.' c-nl else display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) '.' c-nl end-if display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'replacing ==' ws-act-file-name(1:ws-act-file-name-len) '== by ==' ws-temp-file-name(1:ws-temp-file-name-len) '==' c-nl ws-11sp ' ==' ws-act-rec-name(1:ws-act-rec-name-len) '== by ==' ws-temp-rec-name(1:ws-temp-rec-name-len) '==' c-nl ws-11sp ' leading ==' ws-rec-prefix(1:ws-rec-prefix-len) '== by ==temp-==' if ws-replace-ptr not zero perform varying ws-ptr from 1 by 1 until ws-ptr > ws-replace-ptr display ws-11sp ' ' ws-replace(ws-ptr) end-perform end-if display ws-11sp '.' perform x3-pop-para-name . d45-srch-copy-ws section. perform x1-push-para-name move "d45" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' copy "' delimited by size fd-file-name delimited by space '"' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'replacing ==fd == by ==*>fd ==' c-nl ws-11sp ' ==' ws-act-rec-name(1:ws-act-rec-name-len) '== by ==' ws-ws-rec-name(1:ws-ws-rec-name-len) '==' c-nl ws-11sp ' leading ==' ws-rec-prefix(1:ws-rec-prefix-len) '== by ==ws-rec-==.' perform x3-pop-para-name . d47-srch-screen-definition section. perform x1-push-para-name move "d47" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' 03 col 35 value "' function upper-case(ws-prog-file-name(1:1)) ws-prog-file-name(2:ws-prog-file-name-len - 1) ' file".' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp '03 col 65 value "Page".' c-nl ws-11sp '03 col + 2 from ws-page-num.' c-nl ws-11sp '03 col + 2 value "of".' c-nl ws-11sp '03 col + 2 from ws-last-page.' move spaces to ws-disp-line move 1 to ws-disp-ptr string ' 01 ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-1.' delimited by size into ws-disp-line pointer ws-disp-ptr display c-nl ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-6sp ' 03 line 2.' move zero to ws-screen-vfile-offset perform until ws-screen-vfile-offset not < ws-screen-vfile-length perform s33-read-screen-vfile display ws-11sp ws-vfile-rec(1:ws-rec-len) end-perform move spaces to ws-disp-line move 1 to ws-disp-ptr string '*01 ss-' ws-prog-file-name(1:ws-prog-file-name-len) '-page-2.' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) c-nl perform x3-pop-para-name . d49-srch-declaratives section. perform x1-push-para-name move "d49" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ' ' ws-prog-file-name(1:ws-prog-file-name-len) '-error-procedure section.' c-nl delimited by size into ws-disp-line pointer ws-disp-ptr display ws-6sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line move 1 to ws-disp-ptr display ws-6sp ' use after standard error procedure on ' ws-act-file-name(1:ws-act-file-name-len) c-nl ws-6sp ' ' ws-temp-file-name(1:ws-temp-file-name-len) '.' c-nl perform x3-pop-para-name . d51-srch-control section. perform x1-push-para-name move "d51" to ws-dec-para-name move spaces to ws-disp-line string 'move "fsrch' ws-prog-file-name(1:ws-prog-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-prog-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line move 1 to ws-disp-ptr string 'move "' ws-act-file-name(1:ws-act-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) perform x3-pop-para-name . d53-srch-start-section section. perform x1-push-para-name move "d53" to ws-dec-para-name display ws-11sp 'if externalfilename = spaces or low-values' c-nl ws-11sp ' accept ws-view-file-name' c-nl ws-39sp 'from command-line' c-nl ws-11sp ' if ws-view-file-name = spaces' evaluate true when dynamic-file display ws-11sp ' call "getdynfilename"' c-nl ws-39sp 'using "' ws-term-file-name '"' c-nl ws-39sp ' ws-view-file-name' c-nl ws-11sp ' on exception' c-nl ws-11sp ' continue' c-nl ws-11sp ' end-call' c-nl ws-11sp ' if ws-view-file-name = spaces' c-nl ws-11sp ' display ss-dynamic-file-name' c-nl ws-11sp ' accept ss-dynamic-file-name' c-nl ws-11sp ' if User-func and Escape-key' c-nl ws-11sp ' goback' c-nl ws-11sp ' end-if' c-nl ws-11sp ' end-if' c-nl when external-file display ws-11sp ' display "' ws-term-file-name(1:ws-term-file-name-len) '"' c-nl ws-39sp 'upon environment-name' c-nl ws-11sp ' accept ws-view-file-name' c-nl ws-39sp 'from environment-value' when literal-file display ws-11sp ' move ' ws-term-file-name(1:ws-term-file-name-len) c-nl ws-39sp 'to ws-view-file-name' end-evaluate display ws-11sp ' end-if' c-nl ws-11sp 'else' c-nl ws-11sp ' move externalfilename to ws-view-file-name' c-nl ws-11sp 'end-if' c-nl display ws-11sp 'if ws-view-file-name = spaces' c-nl ws-11sp ' goback' c-nl ws-11sp 'end-if' c-nl display ws-11sp 'set open-in-file to true' c-nl ws-11sp 'open input ' ws-act-file-name(1:ws-act-file-name-len) c-nl c-nl ws-11sp 'initialize ' ws-act-rec-name(1:ws-act-rec-name-len) c-nl c-nl move zero to ws-fld-num-gen-vfile-offset perform until ws-fld-num-gen-vfile-offset not < ws-fld-num-gen-vfile-length perform s73-read-fld-num-gen-vfile display ws-11sp ws-vfile-rec(1:ws-rec-len) end-perform perform x3-pop-para-name . d55-srch-main section. perform x1-push-para-name move "e1" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string 'move "' ws-temp-file-name(1:ws-temp-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp 'open output ' ws-temp-file-name(1:ws-temp-file-name-len) move 'move low-values' to ws-disp-line move 29 to ws-disp-ptr string 'to ' ws-act-rec-name(1:ws-act-rec-name-len) delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl c-nl ws-11sp 'set start-file to true' move spaces to ws-disp-line move 1 to ws-disp-ptr string 'move "' ws-act-file-name(1:ws-act-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl move spaces to ws-disp-line move 1 to ws-disp-ptr string 'start ' ws-act-file-name(1:ws-act-file-name-len) ' key not < ' delimited by size ws-key-name(1) delimited by space into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) perform x3-pop-para-name . d57-srch-read section. perform x1-push-para-name move "d57" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ws-spaces(1:ws-space-len) 'move "' ws-act-file-name(1:ws-act-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ws-spaces(1:ws-space-len) 'read ' ws-act-file-name(1:ws-act-file-name-len) ' next ignore lock' perform x3-pop-para-name . d59-srch-write-temp-file section. perform x1-push-para-name move "d59" to ws-dec-para-name move spaces to ws-disp-line move 13 to ws-disp-ptr string ws-spaces(1:ws-space-len) 'move "' ws-temp-file-name(1:ws-temp-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line move 13 to ws-disp-ptr string ws-spaces(1:ws-space-len) 'write ' ws-temp-rec-name(1:ws-temp-rec-name-len) delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'from ' ws-act-rec-name(1:ws-act-rec-name-len) delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl perform x3-pop-para-name . d61-srch-call-fview section. perform x1-push-para-name move "d61" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr if ws-temp-file-name-val(1:1) = '"' string ' move ' ws-temp-file-name-val(1:ws-temp-file-name-val-len) delimited by size into ws-disp-line pointer ws-disp-ptr else string ' move "' ws-temp-file-name-val(1:ws-temp-file-name-val-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr end-if if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to externalfilename' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl ws-11sp ' call "fview' ws-prog-file-name(1:ws-prog-file-name-len) '"' perform x3-pop-para-name . d63-srch-delete-temp-file section. perform x1-push-para-name move "d63" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string 'move "' ws-temp-file-name(1:ws-temp-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl c-nl ws-11sp 'delete file ' ws-temp-file-name(1:ws-temp-file-name-len) c-nl perform x3-pop-para-name . d65-srch-close-act-file section. perform x1-push-para-name move "d65" to ws-dec-para-name move spaces to ws-disp-line move 1 to ws-disp-ptr string ws-spaces(1:ws-space-len) 'move "' ws-act-file-name(1:ws-act-file-name-len) '"' delimited by size into ws-disp-line pointer ws-disp-ptr if ws-disp-ptr > 28 display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) move spaces to ws-disp-line end-if move 29 to ws-disp-ptr string 'to ws-file-name' delimited by size into ws-disp-line pointer ws-disp-ptr display ws-11sp ws-disp-line(1:ws-disp-ptr - 1) c-nl c-nl ws-11sp ws-spaces(1:ws-space-len) 'close ' ws-act-file-name(1:ws-act-file-name-len) perform x3-pop-para-name . e1-get-sentence section. * Remove in-line comments perform varying ws-line-ptr from 1 by 1 until ws-line-ptr > length fd-rec or fd-rec(ws-line-ptr:2) = "*>" end-perform if ws-line-ptr not > length fd-rec move spaces to fd-rec(ws-line-ptr:) end-if * Assume that columns 1-7 and 73 on aren't used move spaces to fd-rec(1:7) fd-rec(73:) move 1 to ws-line-ptr * Need to split line up, terminated with full stop, then extract * level number (word 1), name (word 2), and picture (word after * PIC or PICTURE). Note that PIC can include "." so use ". " as * the delimiter. perform until ws-line-ptr > length fd-rec or fd-rec(ws-line-ptr:) = spaces perform varying ws-line-ptr from ws-line-ptr by 1 until fd-rec(ws-line-ptr:1) not = space end-perform add 1 to ws-word-ptr unstring fd-rec delimited by all spaces or ". " into ws-word(ws-word-ptr) delimiter in ws-delim pointer ws-line-ptr move function lower-case(ws-word(ws-word-ptr)) to ws-word(ws-word-ptr) end-perform if ws-delim = ". " add 1 to ws-word-ptr move "." to ws-word(ws-word-ptr) else perform with test after until end-of-file or (fd-char(1) not = "*" and fd-char(7) not = "*" and fd-rec(8:) not = spaces) read fd-file at end continue end-read end-perform if end-of-file add 1 to ws-word-ptr move "." to ws-word(ws-word-ptr) ws-delim end-if end-if perform x3-pop-para-name . e1-parse-data-defn section. perform x1-push-para-name move "e1" to ws-dec-para-name move ws-delim to ws-word(ws-word-ptr + 1) move function numval(ws-word(1)) to ws-fld-level(ws-entry-ptr) if ws-word(2) = "pic" or "picture" or "occurs" or "redefines" move "filler" to ws-fld-name(ws-entry-ptr) move 2 to ws-word-ptr else move ws-word(2) to ws-fld-name(ws-entry-ptr) move 3 to ws-word-ptr end-if if ws-word(1) = "01" * At the moment we're only catering for one record type move ws-word(2) to ws-act-rec-name if ws-act-rec-name = spaces move zero to ws-act-rec-name-len else perform varying ws-act-rec-name-len from length ws-act-rec-name by -1 until ws-act-rec-name(ws-act-rec-name-len:1) not = space end-perform end-if end-if perform varying ws-word-ptr from 2 by 1 until ws-word(ws-word-ptr) = "." evaluate ws-word(ws-word-ptr) when "pic" when "picture" move ws-word(ws-word-ptr + 1) to ws-fld-pic(ws-entry-ptr) perform f3-get-fld-size when "occurs" if ws-word(ws-word-ptr + 2) = "to" move function numval(ws-word(ws-word-ptr + 3)) to ws-fld-occurs(ws-entry-ptr) else move function numval(ws-word(ws-word-ptr + 1)) to ws-fld-occurs(ws-entry-ptr) end-if when "redefines" move ws-word(ws-word-ptr + 1) to ws-fld-redef(ws-entry-ptr) end-evaluate end-perform perform x3-pop-para-name . e5-parse-key section. perform x1-push-para-name move "e5" to ws-dec-para-name add 1 ws-word-ptr giving ws-ptr perform varying ws-ptr from ws-ptr by 1 until ws-sel-word(ws-ptr) not = "record" and not = "key" and not = "is" end-perform if ws-sel-word(ws-ptr) = "." exit section end-if add 1 to ws-key-ptr move zero to ws-key-seq move ws-sel-word(ws-ptr) to ws-key-name(ws-key-ptr) move ws-key-ptr to ws-disp-key-ptr move spaces to ws-vfile-rec move 1 to ws-rec-len string 'when ' ws-disp-key-ptr delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s69-write-externalkey-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' unstring externalkey' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s69-write-externalkey-vfile move ' into' to ws-vfile-rec move 30 to ws-rec-len if ws-sel-word(ws-ptr + 1) not = "=" and not = "source" perform varying ws-fld-ptr from 1 by 1 until ws-fld-ptr > ws-last-fld or ws-fld-name(ws-fld-ptr) = ws-key-name(ws-key-ptr) end-perform if ws-fld-ptr not > ws-last-fld if ws-fld-pic(ws-fld-ptr) not = spaces add 1 to ws-key-seq move ws-key-seq to ws-fld-key-seq(ws-fld-ptr ws-key-ptr) string ws-fld-name(ws-fld-ptr) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s69-write-externalkey-vfile move spaces to ws-vfile-rec move 30 to ws-rec-len else add 1 ws-fld-ptr giving ws-group-ptr perform varying ws-group-ptr from ws-group-ptr by 1 until ws-fld-level(ws-group-ptr) not > ws-fld-level(ws-fld-ptr) if ws-fld-pic(ws-group-ptr) not = spaces add 1 to ws-key-seq move ws-key-seq to ws-fld-key-seq(ws-group-ptr ws-key-ptr) string ws-fld-name(ws-group-ptr) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s69-write-externalkey-vfile move spaces to ws-vfile-rec move 30 to ws-rec-len end-if end-perform end-if end-if move ws-ptr to ws-word-ptr perform x3-pop-para-name exit section end-if add 2 to ws-ptr if ws-sel-word(ws-ptr) = "is" add 1 to ws-ptr end-if move 1 to ws-fld-ptr move zero to ws-key-seq perform varying ws-ptr from ws-ptr by 1 until ws-fld-ptr > ws-last-fld perform varying ws-fld-ptr from 1 by 1 until ws-fld-ptr > ws-last-fld or ws-fld-name(ws-fld-ptr) = ws-sel-word(ws-ptr) end-perform if ws-fld-ptr > ws-last-fld exit perform end-if if ws-fld-pic(ws-fld-ptr) not = spaces add 1 to ws-key-seq move ws-key-seq to ws-fld-key-seq(ws-fld-ptr ws-key-ptr) string ws-fld-name(ws-fld-ptr) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s69-write-externalkey-vfile move spaces to ws-vfile-rec move 30 to ws-rec-len else add 1 ws-fld-ptr giving ws-group-ptr perform varying ws-group-ptr from ws-group-ptr by 1 until ws-fld-level(ws-group-ptr) not > ws-fld-level(ws-fld-ptr) if ws-fld-pic(ws-group-ptr) not = spaces add 1 to ws-key-seq move ws-key-seq to ws-fld-key-seq(ws-group-ptr ws-key-ptr) string ws-fld-name(ws-group-ptr) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s69-write-externalkey-vfile move spaces to ws-vfile-rec move 30 to ws-rec-len end-if end-perform end-if end-perform compute ws-word-ptr = ws-ptr - 1 perform x3-pop-para-name . e7-view-key-field section. perform x1-push-para-name move "e7" to ws-dec-para-name * Write out the various vfiles associated with key fields move ws-fld-name(ws-fld-ptr) to ws-field-name perform varying ws-char-ptr from 1 by 1 until ws-field-name(ws-char-ptr:1) = space or "-" end-perform if ws-field-name(ws-char-ptr:1) = space move 1 to ws-char-ptr else add 1 to ws-char-ptr end-if * The working-storage field corresponding to the key field, * so we can check if a record is found move spaces to ws-ws-key-fld-name move 1 to ws-ws-key-fld-name-len * string 'ws-keyx-' delimited by size string 'ws-' delimited by size ws-field-name(ws-char-ptr:) delimited by space into ws-ws-key-fld-name pointer ws-ws-key-fld-name-len subtract 1 from ws-ws-key-fld-name-len move spaces to ws-vfile-rec move 1 to ws-rec-len string '03 ' ws-ws-key-fld-name(1:ws-ws-key-fld-name-len) delimited by size into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 perform s1-write-key-flds-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'pic ' delimited by size ws-fld-pic(ws-fld-ptr) delimited by space '.' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s1-write-key-flds-vfile * The control field that we put "foreground-colour" into move ws-ws-key-fld-name to ws-vfile-rec move '-ctrl' to ws-vfile-rec (ws-ws-key-fld-name-len + 1:) compute ws-rec-len = ws-ws-key-fld-name-len + 5 perform s3-write-ctrl-flds-vfile * The vfiles for the read statements have to correspond to the * keys they're used in, so wander along the ws-fld-keys array perform varying ws-key-ptr from 1 by 1 until ws-key-ptr > c-max-keys if key-field(ws-fld-ptr ws-key-ptr) perform f1-write-key-read-vfiles end-if end-perform * Colouring key fields using control clause move spaces to ws-vfile-rec move 1 to ws-rec-len string 'when "' delimited by size ws-fld-name(ws-fld-ptr) delimited by space '"' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s9-write-key-colour-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' string "foreground-colour "' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s9-write-key-colour-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' yellow-x delimited by size' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s9-write-key-colour-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' into ' delimited by size ws-ws-key-fld-name(1:ws-ws-key-fld-name-len) '-ctrl' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s9-write-key-colour-vfile * Accepts of key fields move spaces to ws-vfile-rec move 1 to ws-rec-len string 'when "' delimited by size ws-fld-name(ws-fld-ptr) delimited by space '"' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s11-write-key-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' accept ss-' delimited by size ws-ws-key-fld-name(4:) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s11-write-key-accepts-vfile * If it's an alpha field, put it in upper-case if ws-fld-pic(ws-fld-ptr)(1:1) = "x" or "a" move spaces to ws-vfile-rec move 1 to ws-rec-len string ' move function upper-case(' delimited by size ws-fld-name(ws-fld-ptr) delimited by space ')' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s11-write-key-accepts-vfile move spaces to ws-vfile-rec move 21 to ws-rec-len string 'to ' delimited by size ws-fld-name(ws-fld-ptr) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s11-write-key-accepts-vfile end-if perform x3-pop-para-name . e9-occurring-srch-fld section. perform x1-push-para-name move "e9" to ws-dec-para-name move ws-occ-ptr to ws-disp-occ-ptr * Field numbers move spaces to ws-vfile-rec move 1 to ws-rec-len string '03 ws-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ws-disp-occ-ptr(ws-occ-start:) '-fld' delimited by size into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s61-write-fld-nums-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'pic 9(4) comp.' delimited by size into ws-vfile-rec pointer ws-rec-len perform s61-write-fld-nums-vfile * Generate field numbers move spaces to ws-vfile-rec move 1 to ws-rec-len if ws-last-fld-name = spaces string 'move 1' delimited by size into ws-vfile-rec pointer ws-rec-len else string 'add 1 ' delimited by size ws-last-fld-name delimited by space into ws-vfile-rec pointer ws-rec-len end-if if ws-rec-len > 28 subtract 1 from ws-rec-len perform s63-write-fld-num-gen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len if ws-last-fld-name = spaces string 'to ' delimited by size into ws-vfile-rec pointer ws-rec-len else string 'giving ' delimited by size into ws-vfile-rec pointer ws-rec-len end-if move spaces to ws-last-fld-name string 'ws-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ws-disp-occ-ptr(ws-occ-start:) '-fld' delimited by size into ws-last-fld-name string ws-last-fld-name delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s63-write-fld-num-gen-vfile * Test field values * NB. If alpha record contents won't necessarily be upper-case, * need to generate * 'if function upper-case(ws-fld-name) = ws-ws-fld-name' move spaces to ws-vfile-rec move 1 to ws-rec-len if ws-fld-pic(ws-fld-ptr)(1:1) = "x" or "a" *>Alpha move "spaces" to ws-comparison else move "zero" to ws-comparison end-if string 'if ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '(' ws-disp-occ-ptr(ws-occ-start:) ') not = ' delimited by size ws-comparison delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string 'and ' delimited by size ws-fld-name(ws-fld-ptr) delimited by space '(' ws-disp-occ-ptr(ws-occ-start:) ') not = ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '(' ws-disp-occ-ptr(ws-occ-start:) ')' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' set values-found to false' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' exit section' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string 'end-if' c-nl delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile * Accept field values move spaces to ws-vfile-rec move 1 to ws-rec-len string 'when ws-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ws-disp-occ-ptr(ws-occ-start:) '-fld' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' move yellow to ws-foreground' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' display ss-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ws-disp-occ-ptr(ws-occ-start:) delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' accept ss-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ws-disp-occ-ptr(ws-occ-start:) delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile if ws-fld-pic(ws-fld-ptr)(1:1) = "x" or "a" move spaces to ws-vfile-rec move 1 to ws-rec-len string ' move function upper-case(ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '(' ws-disp-occ-ptr(ws-occ-start:) '))' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' to ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '(' ws-disp-occ-ptr(ws-occ-start:) ')' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile end-if move spaces to ws-vfile-rec move 1 to ws-rec-len string ' move green to ws-foreground' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' display ss-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ws-disp-occ-ptr(ws-occ-start:) delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile * Definition of screen field * Descriptive name perform varying ws-ptr from 1 by 1 until ws-fld-name(ws-fld-ptr)(ws-ptr:1) = "-" or space end-perform * Lose the prefix, then replace all hyphens with spaces and * put a ":" afterwards if ws-fld-name(ws-fld-ptr)(ws-ptr:1) = "-" add 1 to ws-ptr else move 1 to ws-ptr end-if move ws-fld-name(ws-fld-ptr)(ws-ptr:) to ws-scr-desc inspect ws-scr-desc replacing all "-" by space move function upper-case(ws-scr-desc(1:1)) to ws-scr-desc(1:1) * Any field can be an input field. Use colour to highight the * current field and its title. * Field value line move '03 ss-' to ws-vfile-rec move 8 to ws-rec-len string ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ws-disp-occ-ptr(ws-occ-start:) delimited by size into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s13-write-screen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'foreground-colour ws-foreground.' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s13-write-screen-vfile * Field description line move ' 05 col + 2' to ws-vfile-rec move 29 to ws-rec-len string 'value "' ws-scr-desc delimited by size into ws-vfile-rec pointer ws-rec-len perform varying ws-rec-len from ws-rec-len by -1 until ws-vfile-rec(ws-rec-len:1) not = space end-perform add 2 to ws-rec-len move ws-disp-occ-ptr(ws-occ-start:) to ws-vfile-rec(ws-rec-len:) compute ws-rec-len = (ws-rec-len + 5) - ws-occ-start move ':".' to ws-vfile-rec(ws-rec-len:) add 2 to ws-rec-len perform s13-write-screen-vfile move ' 05 col + 2' to ws-vfile-rec move 29 to ws-rec-len string 'using ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '(' ws-disp-occ-ptr(ws-occ-start:) ').' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s13-write-screen-vfile perform x3-pop-para-name . e11-single-srch-fld section. perform x1-push-para-name move "e11" to ws-dec-para-name * Field numbers move spaces to ws-vfile-rec move 1 to ws-rec-len string '03 ws-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '-fld' delimited by size into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s61-write-fld-nums-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'pic 9(4) comp.' delimited by size into ws-vfile-rec pointer ws-rec-len perform s61-write-fld-nums-vfile * Generate field numbers move spaces to ws-vfile-rec move 1 to ws-rec-len if ws-last-fld-name = spaces string 'move 1' delimited by size into ws-vfile-rec pointer ws-rec-len else string 'add 1 ' delimited by size ws-last-fld-name delimited by space into ws-vfile-rec pointer ws-rec-len end-if if ws-rec-len > 28 subtract 1 from ws-rec-len perform s63-write-fld-num-gen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len if ws-last-fld-name = spaces string 'to ' delimited by size into ws-vfile-rec pointer ws-rec-len else string 'giving ' delimited by size into ws-vfile-rec pointer ws-rec-len end-if string 'ws-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '-fld' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s63-write-fld-num-gen-vfile move spaces to ws-last-fld-name string 'ws-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '-fld' delimited by size into ws-last-fld-name * Test field values * NB. If alpha record contents won't necessarily be upper-case, * need to generate * 'if function upper-case(ws-fld-name) = ws-ws-fld-name' move spaces to ws-vfile-rec move 1 to ws-rec-len if ws-fld-pic(ws-fld-ptr)(1:1) = "x" or "a" *>Alpha move "spaces" to ws-comparison else move "zero" to ws-comparison end-if string 'if ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ' not = ' delimited by size ws-comparison delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string 'and ' delimited by size ws-fld-name(ws-fld-ptr) delimited by space ' not = ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' set values-found to false' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' exit section' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string 'end-if' c-nl delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s65-write-test-vals-vfile * Accept field values move spaces to ws-vfile-rec move 1 to ws-rec-len string 'when ws-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '-fld' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' move yellow to ws-foreground' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' display ss-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' accept ss-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile if ws-fld-pic(ws-fld-ptr)(1:1) = "x" or "a" move spaces to ws-vfile-rec move 1 to ws-rec-len string ' move function upper-case(ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space ')' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' to ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile end-if move spaces to ws-vfile-rec move 1 to ws-rec-len string ' move green to ws-foreground' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile move spaces to ws-vfile-rec move 1 to ws-rec-len string ' display ss-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s67-write-accepts-vfile * Definition of screen field * Descriptive name perform varying ws-ptr from 1 by 1 until ws-fld-name(ws-fld-ptr)(ws-ptr:1) = "-" or space end-perform * Lose the prefix, then replace all hyphens with spaces and * put a ":" afterwards if ws-fld-name(ws-fld-ptr)(ws-ptr:1) = "-" add 1 to ws-ptr else move 1 to ws-ptr end-if move ws-fld-name(ws-fld-ptr)(ws-ptr:) to ws-scr-desc inspect ws-scr-desc replacing all "-" by space move function upper-case(ws-scr-desc(1:1)) to ws-scr-desc(1:1) * Any field can be an input field. Use colour to highight the * current field and its title. * Field value line move '03 ss-' to ws-vfile-rec move 8 to ws-rec-len string ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 subtract 1 from ws-rec-len perform s13-write-screen-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'foreground-colour ws-foreground.' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s13-write-screen-vfile * Field description line move ' 05 col + 2' to ws-vfile-rec move 29 to ws-rec-len string 'value "' ws-scr-desc delimited by size into ws-vfile-rec pointer ws-rec-len perform varying ws-rec-len from ws-rec-len by -1 until ws-vfile-rec(ws-rec-len:1) not = space end-perform add 1 to ws-rec-len move ':".' to ws-vfile-rec(ws-rec-len:) add 2 to ws-rec-len perform s13-write-screen-vfile move ' 05 col + 2' to ws-vfile-rec move 29 to ws-rec-len string 'using ws-rec-' delimited by size ws-fld-name(ws-fld-ptr)(ws-rec-prefix-len + 1:) delimited by space '.' delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s13-write-screen-vfile perform x3-pop-para-name . f1-write-key-read-vfiles section. perform x1-push-para-name move "f1" to ws-dec-para-name add 1 to ws-key-elmt(ws-key-ptr) * key-read-a - move file-fld to ws-key-fld move spaces to ws-vfile-rec move 1 to ws-rec-len string 'move ' delimited by size ws-fld-name(ws-fld-ptr) delimited by space into ws-vfile-rec pointer ws-rec-len if ws-rec-len > 28 perform s5-write-key-read-a-vfile move spaces to ws-vfile-rec end-if move 29 to ws-rec-len string 'to ' ws-ws-key-fld-name(1:ws-ws-key-fld-name-len) delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s5-write-key-read-a-vfile * key-read-b - if file-fld = ws-key-fld move spaces to ws-vfile-rec move 1 to ws-rec-len if ws-key-elmt(ws-key-ptr) = 1 * first entry in the series of conditions string "if " into ws-vfile-rec pointer ws-rec-len else string "or " into ws-vfile-rec pointer ws-rec-len end-if string ws-fld-name(ws-fld-ptr) delimited by space " not = " ws-ws-key-fld-name(1:ws-ws-key-fld-name-len) delimited by size into ws-vfile-rec pointer ws-rec-len subtract 1 from ws-rec-len perform s7-write-key-read-b-vfile perform x3-pop-para-name . f3-get-fld-size section. perform x1-push-para-name move "f3" to ws-dec-para-name move zero to ws-fld-size(ws-entry-ptr) move 1 to ws-pic-ptr perform until ws-fld-pic(ws-entry-ptr)(ws-pic-ptr:1) = space evaluate ws-fld-pic(ws-entry-ptr)(ws-pic-ptr:1) when "." if ws-fld-pic(ws-entry-ptr)(ws-pic-ptr + 1:1) not = space add 1 to ws-fld-size(ws-entry-ptr) end-if when "v" add 1 to ws-fld-size(ws-entry-ptr) move "." to ws-fld-pic(ws-entry-ptr) (ws-pic-ptr:1) when "(" add 1 to ws-pic-ptr perform varying ws-pic-len from 1 by 1 until ws-fld-pic(ws-entry-ptr)(ws-pic-ptr + ws-pic-len:1) = ")" end-perform subtract 1 from ws-pic-len move function numval(ws-fld-pic(ws-entry-ptr) (ws-pic-ptr:ws-pic-len)) to ws-repeat-cnt add ws-repeat-cnt to ws-fld-size(ws-entry-ptr) compute ws-pic-ptr = ws-pic-ptr + ws-pic-len + 1 when other add 1 to ws-fld-size(ws-entry-ptr) end-evaluate add 1 to ws-pic-ptr end-perform perform x3-pop-para-name . s1-write-key-flds-vfile section. perform x1-push-para-name move "s1" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-flds-vfile-id ws-key-flds-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-key-flds-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-flds-vfile-id ws-key-flds-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-key-flds-vfile-offset perform x3-pop-para-name . s3-write-ctrl-flds-vfile section. perform x1-push-para-name move "s3" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-ctrl-flds-vfile-id ws-ctrl-flds-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-ctrl-flds-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-ctrl-flds-vfile-id ws-ctrl-flds-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-ctrl-flds-vfile-offset perform x3-pop-para-name . s5-write-key-read-a-vfile section. perform x1-push-para-name move "s5" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-read-a-vfile-id (ws-key-ptr) ws-key-read-a-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-key-read-a-vfile-offset (ws-key-ptr) move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-read-a-vfile-id (ws-key-ptr) ws-key-read-a-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-key-read-a-vfile-offset (ws-key-ptr) perform x3-pop-para-name . s7-write-key-read-b-vfile section. perform x1-push-para-name move "s7" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-read-b-vfile-id (ws-key-ptr) ws-key-read-b-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-key-read-b-vfile-offset (ws-key-ptr) move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-read-b-vfile-id (ws-key-ptr) ws-key-read-b-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-key-read-b-vfile-offset (ws-key-ptr) perform x3-pop-para-name . s9-write-key-colour-vfile section. perform x1-push-para-name move "s9" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-colour-vfile-id ws-key-colour-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-key-colour-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-colour-vfile-id ws-key-colour-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-key-colour-vfile-offset perform x3-pop-para-name . s11-write-key-accepts-vfile section. perform x1-push-para-name move "s11" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-accepts-vfile-id ws-key-accepts-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-key-accepts-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-key-accepts-vfile-id ws-key-accepts-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-key-accepts-vfile-offset perform x3-pop-para-name . s13-write-screen-vfile section. perform x1-push-para-name move "s13" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-screen-vfile-id ws-screen-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-screen-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-screen-vfile-id ws-screen-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-screen-vfile-offset perform x3-pop-para-name . s21-read-key-flds-vfile section. perform x1-push-para-name move "s21" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-key-flds-vfile-id ws-key-flds-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-key-flds-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-key-flds-vfile-id ws-key-flds-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-key-flds-vfile-offset perform x3-pop-para-name . s23-read-ctrl-flds-vfile section. perform x1-push-para-name move "s23" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-ctrl-flds-vfile-id ws-ctrl-flds-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-ctrl-flds-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-ctrl-flds-vfile-id ws-ctrl-flds-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-ctrl-flds-vfile-offset perform x3-pop-para-name . s25-read-key-read-a-vfile section. perform x1-push-para-name move "s25" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-key-read-a-vfile-id (ws-key-ptr) ws-key-read-a-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-key-read-a-vfile-offset (ws-key-ptr) move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-key-read-a-vfile-id (ws-key-ptr) ws-key-read-a-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-key-read-a-vfile-offset (ws-key-ptr) perform x3-pop-para-name . s27-read-key-read-b-vfile section. perform x1-push-para-name move "s27" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-key-read-b-vfile-id (ws-key-ptr) ws-key-read-b-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-key-read-b-vfile-offset (ws-key-ptr) move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-key-read-b-vfile-id (ws-key-ptr) ws-key-read-b-vfile-offset (ws-key-ptr) ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-key-read-b-vfile-offset (ws-key-ptr) perform x3-pop-para-name . s29-read-key-colour-vfile section. perform x1-push-para-name move "s29" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-key-colour-vfile-id ws-key-colour-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-key-colour-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-key-colour-vfile-id ws-key-colour-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-key-colour-vfile-offset perform x3-pop-para-name . s31-read-key-accepts-vfile section. perform x1-push-para-name move "s31" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-key-accepts-vfile-id ws-key-accepts-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-key-accepts-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-key-accepts-vfile-id ws-key-accepts-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-key-accepts-vfile-offset perform x3-pop-para-name . s33-read-screen-vfile section. perform x1-push-para-name move "s33" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-screen-vfile-id ws-screen-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-screen-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-screen-vfile-id ws-screen-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-screen-vfile-offset perform x3-pop-para-name . s41-open-view-vfiles section. perform x1-push-para-name move "s41" to ws-dec-para-name * We need some virtual files to put bits of program into * Definitions of working-storage fields for key fields initialize ws-vfile-offsets call "CBL_OPEN_VFILE" using by reference ws-key-flds-vfile-id ws-key-flds-vfile-status returning ws-call-status * Defintions of control fields for key fields call "CBL_OPEN_VFILE" using by reference ws-ctrl-flds-vfile-id ws-ctrl-flds-vfile-status returning ws-call-status * key-read-a - move file-fld to ws-key-fld * key-read-b - if file-fld = ws-key-fld perform varying ws-key-ptr from 1 by 1 until ws-key-ptr > 20 call "CBL_OPEN_VFILE" using by reference ws-key-read-a-vfile-id (ws-key-ptr) ws-key-read-a-vfile-status (ws-key-ptr) returning ws-call-status call "CBL_OPEN_VFILE" using by reference ws-key-read-b-vfile-id (ws-key-ptr) ws-key-read-b-vfile-status (ws-key-ptr) returning ws-call-status end-perform * Colours of key fields call "CBL_OPEN_VFILE" using by reference ws-key-colour-vfile-id ws-key-colour-vfile-status returning ws-call-status * Accepts of key fields call "CBL_OPEN_VFILE" using by reference ws-key-accepts-vfile-id ws-key-accepts-vfile-status returning ws-call-status * Unstringing externalkey into key fields call "CBL_OPEN_VFILE" using by reference ws-externalkey-vfile-id ws-externalkey-vfile-status returning ws-call-status * Definition of screen call "CBL_OPEN_VFILE" using by reference ws-screen-vfile-id ws-screen-vfile-status returning ws-call-status perform x3-pop-para-name . s43-open-srch-vfiles section. perform x1-push-para-name move "s43" to ws-dec-para-name * We need some virtual files to put bits of program into * Definitions of working-storage fields for field numbers initialize ws-vfile-offsets call "CBL_OPEN_VFILE" using by reference ws-fld-nums-vfile-id ws-fld-nums-vfile-status returning ws-call-status * Definitions of field number generation call "CBL_OPEN_VFILE" using by reference ws-fld-num-gen-vfile-id ws-fld-num-gen-vfile-status returning ws-call-status * Defintions of value tests call "CBL_OPEN_VFILE" using by reference ws-test-vals-vfile-id ws-test-vals-vfile-status returning ws-call-status * Accepts of fields call "CBL_OPEN_VFILE" using by reference ws-accepts-vfile-id ws-accepts-vfile-status returning ws-call-status * Definition of screen call "CBL_OPEN_VFILE" using by reference ws-screen-vfile-id ws-screen-vfile-status returning ws-call-status perform x3-pop-para-name . s51-close-view-vfiles section. perform x1-push-para-name move "s51" to ws-dec-para-name call "CBL_CLOSE_VFILE" using by value ws-key-flds-vfile-id returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-ctrl-flds-vfile-id returning ws-call-status perform varying ws-key-ptr from 1 by 1 until ws-key-ptr > 20 call "CBL_CLOSE_VFILE" using by value ws-key-read-a-vfile-id (ws-key-ptr) returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-key-read-b-vfile-id (ws-key-ptr) returning ws-call-status end-perform call "CBL_CLOSE_VFILE" using by value ws-key-colour-vfile-id returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-key-accepts-vfile-id returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-screen-vfile-id returning ws-call-status perform x3-pop-para-name . s53-close-srch-vfiles section. perform x1-push-para-name move "s53" to ws-dec-para-name call "CBL_CLOSE_VFILE" using by value ws-fld-nums-vfile-id returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-fld-num-gen-vfile-id returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-test-vals-vfile-id returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-accepts-vfile-id returning ws-call-status call "CBL_CLOSE_VFILE" using by value ws-screen-vfile-id returning ws-call-status perform x3-pop-para-name . s61-write-fld-nums-vfile section. perform x1-push-para-name move "s61" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-fld-nums-vfile-id ws-fld-nums-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-fld-nums-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-fld-nums-vfile-id ws-fld-nums-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-fld-nums-vfile-offset perform x3-pop-para-name . s63-write-fld-num-gen-vfile section. perform x1-push-para-name move "s63" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-fld-num-gen-vfile-id ws-fld-num-gen-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-fld-num-gen-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-fld-num-gen-vfile-id ws-fld-num-gen-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-fld-num-gen-vfile-offset perform x3-pop-para-name . s65-write-test-vals-vfile section. perform x1-push-para-name move "s65" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-test-vals-vfile-id ws-test-vals-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-test-vals-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-test-vals-vfile-id ws-test-vals-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-test-vals-vfile-offset perform x3-pop-para-name . s67-write-accepts-vfile section. perform x1-push-para-name move "s67" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-accepts-vfile-id ws-accepts-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-accepts-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-accepts-vfile-id ws-accepts-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-accepts-vfile-offset perform x3-pop-para-name . s69-write-externalkey-vfile section. perform x1-push-para-name move "s69" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-externalkey-vfile-id ws-externalkey-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add c-reclen-len to ws-externalkey-vfile-offset move ws-rec-len to ws-vfile-buff-len call "CBL_WRITE_VFILE" using by value ws-externalkey-vfile-id ws-externalkey-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-rec-len to ws-externalkey-vfile-offset perform x3-pop-para-name . s71-read-fld-nums-vfile section. perform x1-push-para-name move "s71" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-fld-nums-vfile-id ws-fld-nums-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-fld-nums-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-fld-nums-vfile-id ws-fld-nums-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-fld-nums-vfile-offset perform x3-pop-para-name . s73-read-fld-num-gen-vfile section. perform x1-push-para-name move "s73" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-fld-num-gen-vfile-id ws-fld-num-gen-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-fld-num-gen-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-fld-num-gen-vfile-id ws-fld-num-gen-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-fld-num-gen-vfile-offset perform x3-pop-para-name . s75-read-test-vals-vfile section. perform x1-push-para-name move "s75" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-test-vals-vfile-id ws-test-vals-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-test-vals-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-test-vals-vfile-id ws-test-vals-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-test-vals-vfile-offset perform x3-pop-para-name . s77-read-accepts-vfile section. perform x1-push-para-name move "s77" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-accepts-vfile-id ws-accepts-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-accepts-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-accepts-vfile-id ws-accepts-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-accepts-vfile-offset perform x3-pop-para-name . s79-read-externalkey-vfile section. perform x1-push-para-name move "s79" to ws-dec-para-name move c-reclen-len to ws-vfile-buff-len call "CBL_READ_VFILE" using by value ws-externalkey-vfile-id ws-externalkey-vfile-offset ws-vfile-buff-len by reference ws-rec-len-x add ws-vfile-buff-len to ws-externalkey-vfile-offset move ws-rec-len to ws-vfile-buff-len move spaces to ws-vfile-rec call "CBL_READ_VFILE" using by value ws-externalkey-vfile-id ws-externalkey-vfile-offset ws-vfile-buff-len by reference ws-vfile-rec add ws-vfile-buff-len to ws-externalkey-vfile-offset perform x3-pop-para-name . x1-push-para-name section. * Add paragraph name to called stack * Check that stack's not going to overflow if ws-para-ptr < 1 or > 19 move 1 to ws-para-ptr else add 1 to ws-para-ptr end-if move ws-dec-para-name to ws-para-name(ws-para-ptr) . x3-pop-para-name section. * Remove paragraph name from called stack and put it in * ws-dec-para-name as current paragraph * Check that stack won't underflow if ws-para-ptr > zero and < 21 move ws-para-name(ws-para-ptr) to ws-dec-para-name subtract 1 from ws-para-ptr end-if .