000100$CONTROL POST85,USLINIT,BOUNDS,LOCKING,LINES=58 000200 IDENTIFICATION DIVISION. 000300 PROGRAM-ID. CSB220. 000400 000500 000600****** This program was developed using Whisper Programmer Studio. 000700* 000800****** See http://www.whispertech.com/ 000900 001000***************************************************************** 001100* 001200* Distills a specialized format of Tape Backup Listing 001300* 001400* So dynamic searches can be made for time and date of backup 001500* 001600* by file name of file.group.account 001700* 001800* Coordinated with the file / volumes of the backup 001900* 002000***************************************************************** 002100 002200* This program must be compiled using the COBOL 85 002300* with the COBOLIIX UDC. 002400* 002500* POST85 constructs may also be used in this program. 002600* 002700* Note that this source contains two embedded programs. 002800* 002900* Compile and link using: COB85XLK CSB220CC,CSB220 003000* 003100 003200***************************************************************** 003300* 003400* Parmeters: 003500* 003600* PARM= Function INFO= 003700* 0 List backed up file(s) filename(@).group.account 003800* filename(@).@.@ 003900* filename 004000* [assumes current group and account when they are blank] 004100* 004200* Items listed: 004300* 004400* File Group Account Stored Volume Session Last Modified 004500* [Date/Time] 004600* 004700* 1 List backed up file(s) filename(@).group.account 004800* filename(@).@.@ 004900* filename 005000* [assumes current group and account when they are blank] 005100* 005200* Same as PARM=0 except different items listed: 005300* 005400* File.Group.Account Code Recsze Type EOF Session Backup Date 005500* 005600* 2 Generate restore for INFO="file.group.account" 005700* a file 005800* 005900* Note: The file cannot have any wild card (@) 006000* A list of backups are listed with numbers 006100* the numbers are used to select the backup. 006200* 006300* 3 Show backup files for INFO="6 char Tape Serial number" 006400* a particular tape. 006500* 006600* 4 List all backups 006700* Gives #Session / Date / Time / Tape VSN of main volume 006800* 006900* 61 Update CSB from RFILE. 007000* 007100* 62 Write out new CSB from RFILE. 007200* 007300* 63 Update CSB from the "INFO=" file for virtual tape (disc) 007400* file. 007500* 007600* 66 Validate backups still active INFO="VALIDATE" 007700* and mark records for deletion. 007800* 007900* 66 Clean off records marked for INFO="CLEANUP" 008000* deletion. 008100* 008200* 666 Purges off any old CSB KSAM INFO="INITIALIZE" 008300* file and creates a new CSB and CTB 008400* 008500* 666 Purges / Creates CTB KSAM file INFO="CTB INIT" 008600* 008700* 008800* Note: If you entered :RUN CSB220;PARM=666;INFO="INITIALIZE" 008900* Your CSB and CTB is toast whether you meant it or not! 009000* 009100* The CSB is opened I-O for PARM=61 PARM=62 PARM=63 and PARM=666 009200* All other opens for the CSB are Input. 009300* 009400* The CTB is opened I-O for PARM=63 and PARM=666 009500* All other opens for the CTB are Input. 009600* 009700* All opens to the TAPES database are shared read only. 009800* 009900* Anyone who wants the CSB to reside in a place other than 010000* CSB.BACKUPS.ACCOUNTS need only change the SELECT CSB statement. 010100* 010200* Be certain when initializing the CSB that you run under the 010300* Group and Account in which you are creating it. 010400* 010500* The CSB Native Mode KSAM file is assumed to be able to be read 010600* from the user accounts which are to use it. 010700* 010800* Loading data using either PARM=1 or [initial load] PARM=2, 010900* expects an RFILE as input which is generated using the following 011000* parameters in RoadRunner / Backpack i/X: 011100* 011200* The recommended file command: 011300* 011400* !FILE RFILE;REC=,,F,ASCII;DEV=DISC;DISC=100000;SAVE 011500* 011600* The recommended commands in RoadRunner / Backpack i/X: 011700* 011800* REPORT (FULLNAME,VOLNAME,MEDIA,FILECODE,RECSIZE,RECTYPE,EOF, 011900* DATES,CRETIME,MODTIME,ACCTIME,PATHNAME 012000* TO *RFILE) 012100* 012200* Note: only this format will work. 012300* Other formats may be used if the program is sufficiently 012400* modified to recognize them, such as a listing from 012500* the MPE i/X command STORE, but major modifications would 012600* need to be made if someone using this program does not 012700* have TAPES+ from ROC Software. 012800* 012900* The exception to needing TAPES+ is using BACKPACK i/X 013000* to save virtual tape backups on disc. 013100* 013200* A systemwide UDC or script file, "TR" must exist as follows: 013300* 013400* 013500* PARM OPTION=" " 013600* RUN TAPESREQ.TAPES.CCC;INFO="!OPTION " 013700* 013800* and are used for example: 013900* 014000* !TR "FILE TAPEIN=TAPEFILE.GROUP.ACCOUNT;GEN=4421" 014100* 014200* A systemwide UDC or script file, "RR", must exist as follows: 014300* 014400* RUN BP.PUB.TYM 014500* 014600* to run BACKPACK i/X. 014700* 014800* Sample to create an RFILE from a backup tape: 014900* 015000* !JOB VERIFY,OPERATOR.SYS 015100* !COMMENT VERIFY a backup made with Backpack i/X 015200* !CONTINUE 015300* !TR "FILE TAPEIN=SAVE BACKUP.GROUP.ACCOUNT;GEN=127" 015400* !CONTINUE 015500* !PURGE RFILE 015600* !CONTINUE 015700* !FILE RFILE;REC=,,F,ASCII;DEV=DISC;DISC=100000;SAVE 015800* !COMMENT Roadrunner now starting 015900* !CONTINUE 016000* !RUN BP.PUB.TYM 016100* LISTDIR FROM *TAPEIN 016200* REPORT (FULLNAME,VOLNAME,MEDIA,FILECODE,RECSIZE,RECTYPE,EOF, 016300* DATES,CRETIME,MODTIME,ACCTIME,PATHNAME 016400* TO *RFILE) 016500* /GO 016600* /EXIT 016700* !COMMENT Roadrunner now completed 016800* !CONTINUE 016900* !TR "SAVE BACKUP.GROUP.ACCOUNT" 017000* !EOJ 017100* 017200* Similar statements need to be embedded in the backup to 017300* capture the RFILE information. 017400* 017500* Control-Y will interrupt listings for PARM=0,5,7 017600* 017700* After all, if you enter file name as @.@.@, you'll be awhile. 017800* 017900* Note that PARM=1 or PARM=2, the COBOL Sort is used to order 018000* the records in filename order, followed by group, account, 018100* and the date, time, and session number. 018200* 018300* Using this method, it is easy to see the same file across 018400* all groups and / or accounts. 018500* 018600* For example: CSB220 "TEST.@.@" 018700* 018800* This is fairly fast, because the records are in this order. 018900* 019000* The CSB is set to 14 million records, because that is the 019100* largest file possible for these size records with multiple 019200* keys. 019300* 019400* PARM=4 generates an output file "RESTOREJ". 019500* This file contains all the statements needed to restore 019600* a particular file. 019700* 019800* The RESTOREJ file is created in case editing is needed to 019900* tailor the file for particular needs, such as removing the 020000* "KEEP" option. 020100* 020200* For restoration of files from a virtual backup tape on disc, 020300* RESTOREJ IS a temporary file, which will be made permanent 020400* if EDITOR is used to change it; furthermore, the RESTOREJ 020500* file is greatly simplified from the tape form of RESTOREJ. 020600* 020700* 020800* In case anyone is interested, CSB, Stands for 020900* "Corrects System Backup". 021000* 021100* Note that both the internal sort and the trap to capture 021200* Control-Y are contained in this program. 021300* 021400* Every attempt has been made to honor the intellectual property 021500* of ROC Software. 021600* 021700* The TAPES database is referenced, but all superfluous 021800* references to other data sets other than that which is 021900* needed for this exercise have been excluded. 022000* 022100* No warantee of any kind is stated or implied with this 022200* product. 022300* 022400* This is freely given to the HP e3000 Community to help those 022500* who may gather benefit from using it. 022600* 022700* The definitions within this program are narrowly made to 022800* accomplish the goal of restoring and tracking files from 022900* TAPES+ and ROADRUNNER / Backpack iX using MPE iX. 023000* 023100* This product is not intended for any other use and was 023200* not designed to track hierarchical files. 023300* 023400* Native mode KSAM is used for simplicity and 023500* because of the low frequency of updating and other access. 023600* 023700* The CTB is used for virtual tape backups. 023800* The CTB contains the date and time of the virtual tape 023900* backup; the MODIFY characteristics of the object 024000* virtual tape backup on disc must be equal to the 024100* information in the CTB or the file will be considered 024200* invalid for the purposes of tracking backed up files; 024300* all file information related to the backup will be 024400* deleted on the next PARM=66;INFO="VALIDATE" 024500* followed by the PARM=66;INFO="CLEANUP". 024600* 024700* Two new files, XXVTLIST and XXVTPARM are created to 024800* facilitate processing PARM=63 for VTB virtual backups. 024900* They are temporary and should be purged at the end of 025000* the virtual tape backup on disc processing. 025100* 025200* XXVTLIST is the listing of the output of BackPack i/X 025300* from processing 025400* 025500* Database information was extracted using COBGEN. 025600* 025700* Certain limitations are assumed and modification of this 025800* program should take into account the fact that 14 million 025900* records is the maximum value allowed (found experimentally) 026000* for the CSB. 026100* 026200* The CTB is assigned 80,000 arbitrarily. 026300* 026400* Note that for the CSB and the CTB, the defaults were taken 026500* for the COBOL creating the files on output for initialization. 026600* This means that there is an assumed ";NOREUSE" for THE 026700* Native Mode KSAM and the space for deleted records is not 026800* reused. 026900* Those administering the CSB and the CTB should perodically 027000* reorganized by copying the files and using FCOPY. 027100* 027200 AUTHOR. D BECKER. 027300 DATE-WRITTEN. TUE, JAN 19, 1999. 027400 DATE-COMPILED. 027500 027600 ENVIRONMENT DIVISION. 027700 CONFIGURATION SECTION. 027800 027900 SOURCE-COMPUTER. HP-3000. 028000 OBJECT-COMPUTER. HP-3000. 028100 028200 SPECIAL-NAMES. 028300 CONDITION-CODE IS CC 028400 SYMBOLIC CHARACTERS NUL is 1, LF is 11, CR is 14. 028500 028600 INPUT-OUTPUT SECTION. 028700 FILE-CONTROL. 028800 028900 SELECT CSB ASSIGN TO "CSB.BACKUPS.ACCOUNTS,DA,,,14000000" 029000 ORGANIZATION IS INDEXED 029100 ACCESS IS DYNAMIC 029200 RECORD KEY IS CSB-KEY 029300 ALTERNATE RECORD KEY IS CSB-ALTKEY WITH DUPLICATES 029400 ALTERNATE RECORD KEY IS CSB-GROUP-ACCOUNT WITH DUPLICATES. 029500 029600 SELECT RFILE ASSIGN TO "RFILE" 029700 ORGANIZATION IS SEQUENTIAL. 029800 029900 SELECT SORT-FILE ASSIGN TO "SORT,DA,A,,800000". 030000 030100 SELECT RESTOREJ ASSIGN TO "RESTOREJ" 030200 ORGANIZATION IS SEQUENTIAL. 030300 030400 SELECT CTB ASSIGN TO "CTB.BACKUPS.ACCOUNTS,DA,,,50000" 030500 ORGANIZATION IS INDEXED 030600 ACCESS IS DYNAMIC 030700 RECORD KEY IS CTB-KEY. 030800 030900 SELECT XFILE ASSIGN TO "XXVTLIST" 031000 ORGANIZATION IS SEQUENTIAL. 031100 031200 SELECT XXVTPARM ASSIGN TO "XXVTPARM" 031300 ORGANIZATION IS SEQUENTIAL. 031400 031500 DATA DIVISION. 031600 FILE SECTION. 031700 031800 FD RFILE. 031900 01 RFILE-REC. 032000 3 RFILEFIRST. 032100 5 FILLER PIC X. 032200 032300 3 RFILESECOND. 032400 032500 4 VALIDFILE. 032600 5 RFILENAME. 032700 7 RFILENAME1 PIC X. 032800 7 RFILENAME2 PIC X. 032900 7 RFILENAME3 PIC X. 033000 7 RFILENAME4 PIC X. 033100 7 RFILENAME5 PIC X. 033200 7 RFILENAME6 PIC X. 033300 7 RFILENAME7 PIC X. 033400 7 RFILENAME8 PIC X. 033500 033600 5 RDOT1 PIC X. 033700 033800 5 RGROUP PIC X(8). 033900 88 NA1 VALUE "N/A". 034000 034100 5 RDOT2 PIC X. 034200 034300 5 RACCOUNT PIC X(8). 034400 88 NA2 VALUE "N/A". 034500 034600 4 ENDVALIDFILE. 034700 5 FILLER PIC X. 034800 5 RVOLNAME PIC X(6). 034900 5 FILLER PIC X. 035000 5 RMEDIA PIC X(6). 035100 5 FILLER PIC X. 035200 5 RFILECODE PIC X(5). 035300 5 FILLER PIC X. 035400 5 RRECSIZE PIC X(6). 035500 5 FILLER PIC X. 035600 5 RRECTYPE PIC X(4). 035700 5 FILLER PIC X. 035800 5 REOF PIC X(9). 035900 5 REOF9 REDEFINES REOF PIC 9(9). 036000 5 FILLER PIC X. 036100 036200 5 RCDATE. 036300 7 RCM PIC 99. 036400 7 RCS1 PIC X. 036500 88 RCS1Y VALUE "/". 036600 7 RCD PIC 99. 036700 7 RCS2 PIC X. 036800 88 RCS2Y VALUE "/". 036900 7 RCY PIC 99. 037000 037100 5 FILLER PIC X. 037200 037300 5 RADATE. 037400 7 RAM PIC 99. 037500 7 RAS1 PIC X. 037600 88 RAS1Y VALUE "/". 037700 7 RAD PIC 99. 037800 7 RAS2 PIC X. 037900 88 RAS2Y VALUE "/". 038000 7 RAY PIC 99. 038100 038200 5 FILLER PIC X. 038300 038400 5 RMDATE. 038500 7 RMM PIC 99. 038600 7 RMS1 PIC X. 038700 88 RMS1Y VALUE "/". 038800 7 RMD PIC 99. 038900 7 RMS2 PIC X. 039000 88 RMS2Y VALUE "/". 039100 7 RMY PIC 99. 039200 039300 5 FILLER PIC X. 039400 039500 5 RCTIME. 039600 7 RCTF1 PIC X. 039700 7 RCTHR PIC 99. 039800 7 RCTC1 PIC X. 039900 88 RCTC VALUE ":". 040000 7 RCTMI PIC 99. 040100 7 RCTC2 PIC X. 040200 040300 5 FILLER PIC X. 040400 040500 5 RATIME. 040600 7 RATF1 PIC X. 040700 7 RATHR PIC 99. 040800 7 RATC1 PIC X. 040900 88 RATC VALUE ":". 041000 7 RATMI PIC 99. 041100 7 RATC2 PIC X. 041200 041300 5 FILLER PIC X. 041400 041500 5 RMTIME. 041600 7 RMTF1 PIC X. 041700 7 RMTHR PIC 99. 041800 7 RMTC1 PIC X. 041900 88 RMTC VALUE ":". 042000 7 RMTMI PIC 99. 042100 7 RMTC2 PIC X. 042200 042300 5 FILLER PIC X. 042400 3 RFILETHIRD. 042500 5 RPATHNAME PIC X(26). 042600 5 FILLER PIC X. 042700 042800 01 RFILE-REC1. 042900 5 FILLER PIC X. 043000 5 TOSKIP1 PIC X(26). 043100 88 TOSKIP VALUES 043200 "RoadRunner for MPE/iX * " 043300 "FILENAME.GROUP .ACCOUNT ". 043400 5 FILLER PIC X(121). 043500 043600 FD CSB 043700 LABEL RECORDS ARE STANDARD. 043800 043900 1 CSB-REC. 044000 5 CSB-KEY. 044100 6 CSB-K1. 044200 7 CSB-FILE-KEY. 044300 9 CSB-FILE PIC X(8). 044400 7 CSB-GROUP-ACCOUNT. 044500 9 CSB-GROUP PIC X(8). 044600 9 CSB-ACCOUNT PIC X(8). 044700 044800 6 CSB-ALTKEY. 044900 7 CSB-DATE PIC 9(8) BINARY. 045000 7 CSB-TIME PIC 9(4) BINARY. 045100 7 CSB-SESSION PIC X(6). 045200 045300 5 CSB-REST. 045400 7 XVOLNAME PIC X(6). 045500 7 XSTATUS PIC X. 045600 7 XFILECODE PIC X(5). 045700 7 XRECSIZE PIC X(6). 045800 7 XRECTYPE PIC X(4). 045900 7 XEOF PIC 9(9) BINARY. 046000 7 XADATE PIC 9(8) BINARY. 046100 7 XMDATE PIC 9(8) BINARY. 046200 7 XCDATE PIC 9(8) BINARY. 046300 7 XCTIME PIC 9(4) BINARY. 046400 7 XATIME PIC 9(4) BINARY. 046500 7 XMTIME PIC 9(4) BINARY. 046600 046700 FD CTB 046800 LABEL RECORDS ARE STANDARD. 046900 047000 1 CTB-REC. 047100 5 CTB-KEY. 047200 7 CTB-DATE PIC 9(8) BINARY. 047300 7 CTB-TIME PIC 9(4) BINARY. 047400 7 CTB-SESSION PIC X(6). 047500 047600 5 CTB-REST. 047700 7 CTB-FILE PIC X(26). 047800 7 CTB-CODE PIC S9(4) BINARY. 047900 7 CTB-MEOF PIC S9(9) BINARY. 048000 048100 7 CTB-RECORDS PIC S9(9) BINARY. 048200 048300 7 CTB-STATUS PIC X. 048400 048500 SD SORT-FILE 048600 DATA RECORD SORT-RECORD. 048700 048800 1 SORT-RECORD. 048900 5 SORT-KEY. 049000 7 SFILENAME PIC X(8). 049100 7 SGROUP PIC X(8). 049200 7 SACCOUNT PIC X(8). 049300 049400 5 SORT-P2. 049500 7 SDATE PIC 9(8) BINARY. 049600 7 STIME PIC 9(4) BINARY. 049700 7 SSESSION PIC X(6). 049800 7 SVOLNAME PIC X(6). 049900 7 SSTATUS PIC X. 050000 7 SFILECODE PIC X(5). 050100 7 SRECSIZE PIC X(6). 050200 7 SRECTYPE PIC X(4). 050300 7 SEOF PIC 9(9) COMP. 050400 7 SCDATE PIC 9(8) COMP. 050500 7 SADATE PIC 9(8) COMP. 050600 7 SMDATE PIC 9(8) COMP. 050700 7 SCTIME PIC 9(4) COMP. 050800 7 SATIME PIC 9(4) COMP. 050900 7 SMTIME PIC 9(4) COMP. 051000 051100 051200 FD RESTOREJ. 051300 01 RESTOREJ-REC PIC X(72). 051400 051500 FD XXVTPARM. 051600 01 XXVTPARMA PIC X(72). 051700 051800 FD XFILE. 051900 01 XFILE-REC. 052000 3 XRFILEFIRST. 052100 5 FILLER PIC X. 052200 052300 3 XFILESECOND. 052400 052500 4 XRVALIDFILE. 052600 5 XRFILENAME. 052700 7 XRFILENAME1 PIC X. 052800 7 XRFILENAME2 PIC X. 052900 7 XRFILENAME3 PIC X. 053000 7 XRFILENAME4 PIC X. 053100 7 XRFILENAME5 PIC X. 053200 7 XRFILENAME6 PIC X. 053300 7 XRFILENAME7 PIC X. 053400 7 XRFILENAME8 PIC X. 053500 053600 5 XRDOT1 PIC X. 053700 053800 5 XRGROUP PIC X(8). 053900 88 XRNA1 VALUE "N/A". 054000 054100 5 XRDOT2 PIC X. 054200 054300 5 XRACCOUNT PIC X(8). 054400 88 XRNA2 VALUE "N/A". 054500 054600 4 XRENDVALIDFILE. 054700 5 FILLER PIC X. 054800 5 XRVOLNAME PIC X(6). 054900 5 FILLER PIC X. 055000 5 XRMEDIA PIC X(6). 055100 5 FILLER PIC X. 055200 5 XRFILECODE PIC X(5). 055300 5 FILLER PIC X. 055400 5 XRRECSIZE PIC X(6). 055500 5 FILLER PIC X. 055600 5 XRRECTYPE PIC X(4). 055700 5 FILLER PIC X. 055800 5 XREOF PIC X(9). 055900 5 XREOF9 REDEFINES XREOF PIC 9(9). 056000 5 FILLER PIC X. 056100 056200 5 XRCDATE. 056300 7 XRCM PIC 99. 056400 7 XRCS1 PIC X. 056500 88 XRCS1Y VALUE "/". 056600 7 XRCD PIC 99. 056700 7 XRCS2 PIC X. 056800 88 XRCS2Y VALUE "/". 056900 7 XRCY PIC 99. 057000 057100 5 FILLER PIC X. 057200 057300 5 XRADATE. 057400 7 XRAM PIC 99. 057500 7 XRAS1 PIC X. 057600 88 XRAS1Y VALUE "/". 057700 7 XRAD PIC 99. 057800 7 XRAS2 PIC X. 057900 88 XRAS2Y VALUE "/". 058000 7 XRAY PIC 99. 058100 058200 5 FILLER PIC X. 058300 058400 5 XRMDATE. 058500 7 XRMM PIC 99. 058600 7 XRMS1 PIC X. 058700 88 XRMS1Y VALUE "/". 058800 7 XRMD PIC 99. 058900 7 XRMS2 PIC X. 059000 88 XRMS2Y VALUE "/". 059100 7 XRMY PIC 99. 059200 059300 5 FILLER PIC X. 059400 059500 5 XRCTIME. 059600 7 XRCTF1 PIC X. 059700 7 XRCTHR PIC 99. 059800 7 XRCTC1 PIC X. 059900 88 XRCTC VALUE ":". 060000 7 XRCTMI PIC 99. 060100 7 XRCTC2 PIC X. 060200 060300 5 FILLER PIC X. 060400 060500 5 XRATIME. 060600 7 XRATF1 PIC X. 060700 7 XRATHR PIC 99. 060800 7 XRATC1 PIC X. 060900 88 XRATC VALUE ":". 061000 7 XRATMI PIC 99. 061100 7 XRATC2 PIC X. 061200 061300 5 FILLER PIC X. 061400 061500 5 XRMTIME. 061600 7 XRMTF1 PIC X. 061700 7 XRMTHR PIC 99. 061800 7 XRMTC1 PIC X. 061900 88 XRMTC VALUE ":". 062000 7 XRMTMI PIC 99. 062100 7 XRMTC2 PIC X. 062200 062300 5 FILLER PIC X. 062400 3 XRFILETHIRD. 062500 5 XRPATHNAME PIC X(26). 062600 5 FILLER PIC X. 062700 062800 01 XRFILE-REC1. 062900 5 FILLER PIC X. 063000 5 XRTOSKIP1 PIC X(26). 063100 88 XRTOSKIP VALUES 063200 "RoadRunner for MPE/iX * " 063300 "FILENAME.GROUP .ACCOUNT ". 063400 5 FILLER PIC X(121). 063500 063600 063700 WORKING-STORAGE SECTION. 063800 063900 77 CTB-DISPLAY PIC ZZZ,ZZZ,ZZ9-. 064000 064100 77 XFILE-STATUS PIC X VALUE " ". 064200 88 XFILE-EOF VALUE "9". 064300 064400 77 PURGED-FILES PIC S9(9) BINARY VALUE 0. 064500 064600 01 CTLYSET EXTERNAL PIC S9(4) COMP. 064700 064800 064900 77 FINDFILE PIC X(28) VALUE " ". 065000 77 RESTOREX-PTR PIC S9(4) COMP VALUE 0. 065100 065200 01 RESTOREX. 065300 5 RESTOREXO OCCURS 40 TIMES PIC X(72) VALUE SPACES. 065400 065500 065600 77 FF-MATCH PIC X(8) VALUE " ". 065700 065800 77 AT-FILE-PTR PIC 9(4) COMP VALUE 0. 065900 066000 1 AT-FILE. 066100 2 FILLER PIC X. 066200 2 AT-FILE2. 066300 3 FILLER PIC X. 066400 3 AT-FILE3. 066500 4 FILLER PIC X. 066600 4 AT-FILE4. 066700 5 FILLER PIC X. 066800 5 AT-FILE5. 066900 6 FILLER PIC X. 067000 6 AT-FILE6. 067100 7 FILLER PIC X. 067200 7 AT-FILE7. 067300 8 FILLER PIC X. 067400 8 AT-FILE8 PIC X. 067500 067600 067700 77 VALID-SW PIC X VALUE " ". 067800 88 NOTVALID VALUE "9". 067900 068000 77 LEVEL-MADE PIC XX VALUE SPACES. 068100 88 LEVELA VALUE "A1". 068200 068300 77 MATCH PIC S9(9) COMP VALUE 0. 068400 88 MATCH-F VALUE 1. 068500 88 MATCH-G VALUE 2. 068600 88 MATCH-A VALUE 3. 068700 88 NO-MATCH VALUE 99. 068800 88 MATCH-SET VALUE 0. 068900 069000 1 MATCH-ACCOUNT. 069100 5 MATCH-ACCOUNTO OCCURS 8 TIMES PIC X. 069200 069300 1 MATCH-GROUP. 069400 5 MATCH-GROUPO OCCURS 8 TIMES PIC X. 069500 069600 1 MATCH-FILE. 069700 5 MATCH-FILEO OCCURS 8 TIMES PIC X. 069800 069900 77 MATCH-SUBF PIC S9(9) COMP VALUE 0. 070000 77 MATCH-SUBG PIC S9(9) COMP VALUE 0. 070100 77 MATCH-SUBA PIC S9(9) COMP VALUE 0. 070200 070300 77 FILES1 PIC S9(4) COMP VALUE 0. 070400 77 FILES4 PIC S9(4) COMP VALUE 0. 070500 77 FILES5 PIC S9(5) COMP VALUE 0. 070600 070700 77 NOT-SELECTOR PIC X VALUE "0". 070800 88 SELECTED VALUE "0". 070900 88 NOTSELECTED VALUE "1". 071000 071100 77 SAVE-PATHNAME PIC X(26) VALUE SPACES. 071200 071300 77 RECORD256 PIC X(254) VALUE SPACES. 071400 77 SAVE256 PIC X(254) VALUE SPACES. 071500 071600 77 ATA-SW PIC X VALUE " ". 071700 88 ATA-BOY VALUE "1". 071800 071900 01 ATA-FILE PIC X(8) VALUE HIGH-VALUES. 072000 072100 77 FM1-SW PIC X VALUE "1". 072200 88 FMH-SW VALUE "1". 072300 072400 77 VALIDATE-PTR PIC S9(4) COMP VALUE 0. 072500 77 VALIDATE-PTR1 PIC S9(4) COMP VALUE 0. 072600 072700 1 VALIDATE-MATRIX. 072800 5 MATRIX-KEY OCCURS 700 TIMES. 072900 7 MATRIX-DATE PIC 9(8) BINARY. 073000 7 MATRIX-TIME PIC 9(4) BINARY. 073100 7 MATRIX-SESSION PIC X(6). 073200 073300 77 SS-PTR1 PIC S9(4) COMP VALUE 0. 073400 77 SS-PTR2 PIC S9(4) COMP VALUE 0. 073500 77 SS-PTR3 PIC S9(4) COMP VALUE 0. 073600 77 SS-PTR4 PIC S9(4) COMP VALUE 0. 073700 77 SS-PTR5 PIC S9(4) COMP VALUE 0. 073800 77 SS-PTR6 PIC S9(4) COMP VALUE 0. 073900 074000 1 SRT-RECORD. 074100 5 SRT-KEY. 074200 7 SRT-KEYC PIC X(48). 074300 074400 77 SRT-IND PIC X VALUE "0". 074500 88 SRT-END VALUE "9". 074600 074700 01 SSS-TABLE. 074800 5 SSS-OCCURS OCCURS 700 TIMES. 074900 6 SSS-KEY. 075000 9 BACKUPS-FILES PIC X(8) VALUE SPACES. 075100 9 BACKUPS-FILE PIC X(26) VALUE SPACES. 075200 9 BACKUPS-GENNUM PIC 99 VALUE 01. 075300 9 BACKUPS-GEN PIC 9(4) VALUE 0001. 075400 9 BACKUPS-GENOF PIC 99 VALUE 01. 075500 9 BACKUPS-VOLUME PIC X(6) VALUE SPACES. 075600 075700 1 FM1. 075800 5 FM1-PTR PIC ZZZZ VALUE " ". 075900 5 FM1-STATUS PIC X VALUE SPACE. 076000 5 FM1-FILE PIC X(8) VALUE SPACES. 076100 5 FM1-DOT1 PIC X VALUE ".". 076200 5 FM1-GROUP PIC X(8) VALUE SPACES. 076300 5 FM1-DOT2 PIC X VALUE ".". 076400 5 FM1-ACCOUNT PIC X(8) VALUE SPACES. 076500 5 FM1-SPACE1 PIC X VALUE " ". 076600 5 FM1-MO PIC 99 VALUE 0. 076700 5 FM1-SLASH1 PIC X VALUE "/". 076800 5 FM1-DD PIC 99 VALUE 0. 076900 5 FM1-SLASH2 PIC X VALUE "/". 077000 5 FM1-CC PIC 99 VALUE 20. 077100 5 FM1-YY PIC 99 VALUE 00. 077200 5 FM1-SPACE2 PIC X VALUE " ". 077300 5 FM1-HH PIC 99 VALUE 0. 077400 5 FM1-MM PIC 99 VALUE 0. 077500 5 FM1-SPACE3 PIC X VALUE " ". 077600 5 FM1-VOLUME PIC X(6) VALUE SPACES. 077700 5 FM1-SPACE4 PIC X VALUE SPACE. 077800 5 FM1-SESSION PIC X(6) VALUE SPACE. 077900 5 FM1-SPACE5 PIC XX VALUE " ". 078000 5 FM1-MMM PIC 99 VALUE 0. 078100 5 FM1-MSLASH3 PIC X VALUE "/". 078200 5 FM1-MDD PIC 99 VALUE 0. 078300 5 FM1-MSLASH4 PIC X VALUE "/". 078400 5 FM1-MCC PIC 99 VALUE 20. 078500 5 FM1-MYY PIC 99 VALUE 00. 078600 5 FM1-MSPACE6 PIC X VALUE " ". 078700 5 FM1-MHH PIC 99 VALUE 0. 078800 5 FM1-MMI PIC 99 VALUE 0. 078900 079000 079100 1 FMH. 079200 5 FMH-STATUS PIC X(5) VALUE " ". 079300 5 FMH-FILE PIC X(9) VALUE "File". 079400 5 FMH-GROUP PIC X(9) VALUE "Group". 079500 5 FMH-ACCOUNT PIC X(9) VALUE "Account". 079600 5 FMH-MM PIC X(16) VALUE "Stored". 079700 5 FMH-VOLUME PIC X(7) VALUE "Volume". 079800 5 FMH-SESSION PIC X(8) VALUE "Session". 079900 5 FMH-MMM PIC X(15) VALUE "Last Modified". 080000 080100 080200 1 FM2. 080300 5 FM2-STATUS PIC X VALUE SPACE. 080400 5 FM2-FILE PIC X(8) VALUE SPACES. 080500 5 FM2-DOT1 PIC X VALUE ".". 080600 5 FM2-GROUP PIC X(8) VALUE SPACES. 080700 5 FM2-DOT2 PIC X VALUE ".". 080800 5 FM2-ACCOUNT PIC X(8) VALUE SPACES. 080900 5 FILLER PIC X VALUE " ". 081000 5 FM2-FILECODE PIC X(5). 081100 5 FILLER PIC X VALUE " ". 081200 5 FM2-RECSIZE PIC X(6). 081300 5 FILLER PIC X VALUE " ". 081400 5 FM2-RECTYPE PIC X(4). 081500 5 FILLER PIC X VALUE " ". 081600 5 FM2-EOF PIC Z(9)9. 081700 5 FILLER PIC X VALUE " ". 081800 5 FM2-SESSION PIC X(6) VALUE SPACE. 081900 5 FILLER PIC X VALUE " ". 082000 5 FM2-MO PIC 99 VALUE 0. 082100 5 FM2-SLASH1 PIC X VALUE "/". 082200 5 FM2-DD PIC 99 VALUE 0. 082300 5 FM2-SLASH2 PIC X VALUE "/". 082400 5 FM2-CC PIC 99 VALUE 20. 082500 5 FM2-YY PIC 99 VALUE 00. 082600 5 FM2-SPACE2 PIC X VALUE " ". 082700 5 FM2-HH PIC 99 VALUE 0. 082800 5 FM2-MM PIC 99 VALUE 0. 082900 083000 1 FMH2. 083100 5 FILLER PIC X VALUE SPACE. 083200 5 FILLER PIC X(8) VALUE " File". 083300 5 FILLER PIC X VALUE ".". 083400 5 FILLER PIC X(8) VALUE " Group". 083500 5 FILLER PIC X VALUE ".". 083600 5 FILLER PIC X(8) VALUE " Account". 083700 5 FILLER PIC X VALUE " ". 083800 5 FILLER PIC X(5) VALUE "Code". 083900 5 FILLER PIC X VALUE " ". 084000 5 FILLER PIC X(6) VALUE "Recsze". 084100 5 FILLER PIC X VALUE " ". 084200 5 FILLER PIC X(4) VALUE "Type". 084300 5 FILLER PIC X VALUE " ". 084400 5 FILLER PIC X(10) VALUE " EOF". 084500 5 FILLER PIC X VALUE " ". 084600 5 FILLER PIC X(7) VALUE "Session". 084700 084800 5 FILLER PIC X(12) VALUE " Backup Date". 084900* 5 FILLER PIC X(13) VALUE " Creation". 085000 085100 77 FM2-SW PIC X VALUE "1". 085200 88 FMH2-SW VALUE "1". 085300 085400 77 LENR PIC ZZZ,ZZZ,ZZ9-. 085500 77 LENN PIC S9(9) VALUE 0. 085600 085700 77 TBF-INTERNAL PIC S9(9) BINARY. 085800 085900 77 TYPE1S PIC S9(9) COMP VALUE 0. 086000 77 TYPE2S PIC S9(9) COMP VALUE 0. 086100 77 MATCHED PIC S9(9) COMP VALUE 0. 086200 086300 77 WRITTEN-RECORDS PIC S9(9) COMP VALUE 0. 086400 77 REWRITTEN-RECORDS PIC S9(9) COMP VALUE 0. 086500 086600 77 FOUND-ID PIC X VALUE "0". 086700 88 FOUND VALUE "0". 086800 88 NOT-FOUND VALUE "9". 086900 087000 77 SORT-IND PIC X VALUE "0". 087100 88 SORT-END VALUE "9". 087200 087300 1 SEARCH-RECORD. 087400 5 SEARCH-FILE. 087500 7 SEARCH-FILE1 PIC X. 087600 7 SEARCH-FILE7 PIC X(7). 087700 5 SEARCH-FILE-OCCURS REDEFINES SEARCH-FILE. 087800 7 SEARCH-FILE8 OCCURS 8 TIMES PIC X. 087900 088000 5 SEARCH-GROUP. 088100 7 SEARCH-GROUP1 PIC X. 088200 7 SEARCH-GROUP7 PIC X(7). 088300 088400 5 SEARCH-ACCOUNT. 088500 7 SEARCH-ACCOUNT1 PIC X. 088600 7 SEARCH-ACCOUNT7 PIC X(7). 088700 088800 1 SAVE-RECORD. 088900 5 SAVE-KEY. 089000 6 SAVE-ID. 089100 7 SAVE-SESS PIC 9(9) . 089200 7 SAVE-JOB PIC X(8). 089300 7 SAVE-USERID PIC X(8). 089400 7 SAVE-ACCOUNT PIC X(8). 089500 7 SAVE-PIN PIC 9(4) . 089600 6 SAVE-ID1. 089700 7 SAVE-TYPE PIC 9. 089800 089900 5 SAVE-REST. 090000 7 SAVE-START-DATE PIC 9(8) . 090100 7 SAVE-START-TIME PIC 9(4) . 090200 7 SAVE-GROUP PIC X(8). 090300 7 SAVE-DATE PIC 9(8) . 090400 7 SAVE-TIME PIC 9(4) . 090500 7 SAVE-LDEV PIC X(8). 090600 7 SAVE-MINUTES PIC 9(9) . 090700 7 SAVE-CPU PIC 9(9) . 090800 090900 01 TIME-PACK. 091000 5 TIME1. 091100 7 TIMEHH PIC 99. 091200 7 TIMEMM PIC 99. 091300 5 TIME2 REDEFINES TIME1 PIC 9(4). 091400 091500 01 DATE-PACK. 091600 3 DATE-PACK1. 091700 5 DATECC PIC 99 VALUE 20. 091800 5 DATEYY PIC 99. 091900 5 DATEMM PIC 99. 092000 5 DATEDD PIC 99. 092100 3 DATEPACKED REDEFINES DATE-PACK1 PIC 9(8). 092200 3 DATEYYYYMMDD REDEFINES DATE-PACK1. 092300 5 DATEYYYY PIC 9999. 092400 5 DATEMMDD PIC 9999. 092500 092600 77 TAPE-VOLUMES PIC S9(4) BINARY VALUE 0. 092700 092800 77 TBF-IND PIC X VALUE " ". 092900 88 TBF-EOF VALUE "9". 093000 88 TBF-INV VALUE "5". 093100 88 TBF-NORMAL VALUE " ". 093200 093300 77 TBH-IND PIC X VALUE " ". 093400 88 TBH-EOF VALUE "9". 093500 88 TBH-INV VALUE "5". 093600 88 TBH-NORMAL VALUE " ". 093700 093800 77 CSB-IND PIC X VALUE " ". 093900 88 CSB-EOF VALUE "9". 094000 88 CSB-INV VALUE "5". 094100 88 CSB-NORMAL VALUE " ". 094200 094300 094400 77 CTB-IND PIC X VALUE " ". 094500 88 CTB-EOF VALUE "9". 094600 88 CTB-INV VALUE "5". 094700 88 CTB-NORMAL VALUE " ". 094800 88 CTB-NOMATCH VALUE "6". 094900 095000 1 TBI. 095100 5 TBI-KEY. 095200 6 TBI-K1. 095300 7 TBI-FILE-KEY. 095400 9 TBI-FILE PIC X(8). 095500 7 TBI-GROUP-ACCOUNT. 095600 9 TBI-GROUP PIC X(8). 095700 9 TBI-ACCOUNT PIC X(8). 095800 095900 6 TBI-ALTKEY. 096000 096100 7 TBI-DATE PIC 9(8) COMP VALUE 0. 096200 7 TBI-TIME PIC 9(4) COMP VALUE 0. 096300 7 TBI-SESSION PIC X(6) VALUE SPACES. 096400 096500 5 TBI-REST. 096600 7 IVOLNAME PIC X(6). 096700 096800 7 IFILECODE PIC X(5). 096900 7 IRECSIZE PIC X(6). 097000 7 IRECTYPE PIC X(4). 097100 7 IEOF PIC X(9). 097200 7 ICDATE PIC 9(8) COMP. 097300 7 ICTIME PIC 9(4) COMP. 097400 7 IADATE PIC 9(8) COMP. 097500 7 IATIME PIC 9(4) COMP. 097600 7 IMDATE PIC 9(8) COMP. 097700 7 IMTIME PIC 9(4) COMP. 097800 097900 098000 01 TAPES. 098100 5 TAPE-VOLUME OCCURS 99 TIMES PIC X(6). 098200 098300 01 BASE. 098400 03 BASE-ID PIC X(2) VALUE SPACES. 098500 03 BASE-NAME PIC X(26) VALUE "TAPES.TAPES.CCC;". 098600 098700 01 PASSWORD PIC X(8) VALUE "REGUSER;". 098800 098900 01 DUMMY PIC X(2) VALUE SPACES. 099000 099100 01 ALL-LIST PIC X(2) VALUE "@;". 099200 099300 01 SAME-LIST PIC X(2) VALUE "*;". 099400 099500 01 STAT. 099600 03 DBS-IMAGE. 099700 05 IMAGE-STATUS PIC S9(4) COMP VALUE 0. 099800 05 ENTRYLEN PIC S9(4) COMP VALUE 0. 099900 05 RECDNUMB PIC S9(9) COMP VALUE 0. 100000 05 CHAINLEN PIC S9(9) COMP VALUE 0. 100100 05 BACKPOINT PIC S9(9) COMP VALUE 0. 100200 05 FORWPOINT PIC S9(9) COMP VALUE 0. 100300 100400 01 DB-MODES. 100500 03 MODE1 PIC S9(4) COMP VALUE 1. 100600 03 MODE2 PIC S9(4) COMP VALUE 2. 100700 03 MODE3 PIC S9(4) COMP VALUE 3. 100800 03 MODE4 PIC S9(4) COMP VALUE 4. 100900 03 MODE5 PIC S9(4) COMP VALUE 5. 101000 03 MODE6 PIC S9(4) COMP VALUE 6. 101100 03 MODE7 PIC S9(4) COMP VALUE 7. 101200 03 MODE8 PIC S9(4) COMP VALUE 8. 101300 101400 77 TAPE-SEARCH PIC X(6) VALUE SPACES. 101500 101600 01 SAVED. 101700 5 SAVE-CREATE-DATE PIC 9(6) VALUE 0. 101800 5 SAVE-CREATE-TIME PIC 9(4) VALUE 0. 101900 5 SAVE-SESSION PIC X(6) VALUE " ". 102000 102100* Tapes+ data set information: 102200 102300 01 DS-DATA-SET-GEN PIC X(13) VALUE "DATA-SET-GEN;". 102400 102500 01 DB-DATA-SET-GEN. 102600 03 TAPE-NUMBER-DS PIC X(6) VALUE SPACES. 102700 102800 03 FILENAME-DS. 102900 4 FILE-NAME-DS PIC X(8) VALUE SPACES. 103000 4 GROUP-NAME-DS PIC X(8) VALUE SPACES. 103100 4 ACCOUNT-NAME-DS PIC X(8) VALUE SPACES. 103200 103300 03 GEN-VER-VOL-DS. 103400 4 GEN-GEN-DS PIC 9(4) VALUE 0001. 103500 4 GEN-GENOF-DS PIC 99 VALUE 01. 103600 4 GEN-GENNUM-DS PIC 99 VALUE 01. 103700 103800 03 CREATOR-DS PIC X(8) VALUE SPACES. 103900 03 SESSION-DS PIC X(6) VALUE SPACES. 104000 104100 03 CREATE-DATE-DS. 104200 5 CREATE-MM PIC 99 VALUE ZEROS. 104300 5 CREATE-DD PIC 99 VALUE ZEROS. 104400 5 CREATE-YY PIC 99 VALUE ZEROS. 104500 104600 03 CREATE-TIME-DS PIC 9(4) VALUE ZEROS. 104700 03 EXPIRATION-DATE-DS PIC 9(6) VALUE ZEROS. 104800 03 COMMENTS-DS PIC X(30) VALUE SPACES. 104900 03 FLAGS-DS PIC X(2) VALUE SPACES. 105000 03 ROTATE-FLAG-DS PIC X(2) VALUE SPACES. 105100 03 USER-SESSION-DS PIC X(6) VALUE SPACES. 105200 03 DSG-FILLER-DS PIC X(20) VALUE SPACES. 105300 105400 01 DI-TAPE-NUMBER PIC X(12) VALUE "TAPE-NUMBER;". 105500 105600 01 DI-FILENAME PIC X(9) VALUE "FILENAME;". 105700 105800 01 LIST. 105900 03 LIST-1 PIC X(120). 106000 03 LIST-2 PIC X(120). 106100 03 LIST-3 PIC X(36). 106200 106300 77 RFILE-SW PIC X VALUE "0". 106400 88 RFILE-EOF VALUE "9". 106500 106600 77 RECORD-COUNT PIC S9(8) COMP VALUE 0. 106700 77 JSIND PIC 9(4) COMP VALUE 1. 106800 77 JSNUM PIC S9(9) COMP VALUE 0. 106900 77 SET-READ PIC X VALUE "0". 107000 107100 01 JSSTATUS. 107200 5 JSSTATUS1 PIC S9(4) COMP VALUE 0. 107300 5 JSSTATUS2 PIC S9(4) COMP VALUE 0. 107400 107500 77 JSUSERID PIC X(8) VALUE SPACES. 107600 77 JSACCOUNT PIC X(8) VALUE SPACES. 107700 77 JSJOBNAME PIC X(8) VALUE SPACES. 107800 107900 77 JSERR1 PIC S9(4) COMP VALUE 0. 108000 77 JSERR2 PIC S9(4) COMP VALUE 0. 108100 77 JSERR3 PIC S9(4) COMP VALUE 0. 108200 108300 01 JSNUMX. 108400 5 JSNUM1 PIC X. 108500 5 JSNUM2 PIC 9(9). 108600 108700 77 NULLCOUNT PIC S9(4) BINARY VALUE 0. 108800 108900 77 JCWNAME PIC X(16) VALUE "CSB220". 109000 77 JCWVALUE PIC S9(4) COMP VALUE 0. 109100 77 JCWSTATUS PIC S9(4) COMP VALUE 0. 109200 77 CMD-ERROR PIC S9(4) COMP VALUE 0. 109300 77 CMD-PARAM PIC S9(4) COMP VALUE 0. 109400 109500 77 PARM-SIZE PIC S9(4) COMP VALUE 80. 109600 77 PARM-VALUE PIC S9(4) COMP VALUE 0. 109700 109800 01 PARM-INFO. 109900 5 PARM-INFO72 PIC X(72) VALUE " ". 110000 5 FILLER PIC X(8) VALUE " ". 110100 110200 77 WHO-MODE PIC S9(4) COMP VALUE 0. 110300 77 WHO-MODE1 PIC S9(4) COMP VALUE 0. 110400 77 WHO-USER PIC X(8) VALUE " ". 110500 77 WHO-ACCOUNT PIC X(8) VALUE " ". 110600 77 WHO-GROUP PIC X(8) VALUE " ". 110700 77 INFO-LENGTH PIC S9(4) COMP VALUE -80. 110800 110900 77 SUB PIC S9(4) COMP VALUE 0. 111000 77 SUB1 PIC S9(4) COMP VALUE 0. 111100 77 SUB2 PIC S9(4) COMP VALUE 0. 111200 77 SUB3 PIC S9(4) COMP VALUE 0. 111300 77 SUB4 PIC S9(4) COMP VALUE 0. 111400 77 SUB5 PIC S9(4) COMP VALUE 0. 111500 111600 77 INFO-IN PIC X VALUE " ". 111700 88 INFO-IN-OK VALUE " ". 111800 111900 77 DSPLY-ITM PIC ----9. 112000 112100 77 LINE-LENGTH PIC S9(4) COMP VALUE 120. 112200 77 NEG-LENGTH PIC S9(4) COMP VALUE -80. 112300 112400 77 DSPLY PIC ---,---,---,--9. 112500 112600 01 CTL-Y-FLAG PIC S9(4) COMP. 112700 01 Y-FLAG PIC X VALUE " ". 112800 112900 1 DISPLAY-LINE. 113000 5 DSPLY-LN OCCURS 1 TO 120 TIMES DEPENDING ON LINE-LENGTH 113100 PIC X. 113200 113300 1 SJW. 113400 3 SJW1. 113500 5 SJW-NUM PIC 9(4). 113600 5 SJW-XO. 113700 7 SJW-X PIC X. 113800 7 SJW-R1 PIC X(79). 113900 3 SJW2 REDEFINES SJW1. 114000 5 SJW-X2 PIC X. 114100 5 SJW-R3 PIC X(83). 114200 114300 77 UPPER PIC X(26) VALUE "ABCDEFGHIJKLMNOPQRSTUVWXYZ". 114400 77 LOWER PIC X(26) VALUE "abcdefghijklmnopqrstuvwxyz". 114500 114600 77 NUMFILES PIC S9(4) COMP VALUE 1. 114700 114800 01 FILELIST. 114900 5 FILE1 PIC X(86) VALUE "IXFRFILE ". 115000 115100 01 FILELENS. 115200 5 FILEL1 PIC S9(4) COMP VALUE 86. 115300 115400 01 SUBCODE. 115500 5 SUBCODE1 PIC S9(4) COMP VALUE 0. 115600 115700 77 NAMEID PIC X(8) VALUE " ". 115800 77 PRI PIC S9(4) COMP VALUE 0. 115900 77 DIRECTSET PIC S9(4) COMP VALUE 0. 116000 116100 01 PRARRAY. 116200 5 FILLER PIC X(88) VALUE "'STD'". 116300 116400 77 MAXJOBS PIC S9(4) COMP VALUE 0. 116500 116600 01 SPOOLLIST. 116700 5 SPOOLL1 PIC S9(4) COMP VALUE 0. 116800 5 SPOOLL2 PIC S9(4) COMP VALUE 0. 116900 117000 77 NUMJOBS PIC S9(4) COMP VALUE 0. 117100 117200 01 RESULTARRAY. 117300 5 RESULTSA OCCURS 8 TIMES PIC S9(4) COMP. 117400 117500 1 ALM-ARRAY. 117600 5 ALM-ERRORS. 117700 7 ALM-ERROR PIC 99 COMP. 117800 7 ALM-ERROR0 PIC 99 COMP. 117900 5 ALM-YEARNUM PIC 999 COMP. 118000 5 ALM-MONTHNUM PIC 99 COMP. 118100 5 ALM-DAYNUM PIC 99 COMP. 118200 5 ALM-WEEKDAYNUM PIC 9 COMP. 118300 118400 1 ALF-ARRAY. 118500 3 ALF-PART1. 118600 5 ALF-CENT PIC 99. 118700 5 ALF-YEARNUM PIC 99. 118800 5 ALF-MONTHNUM PIC 99. 118900 5 ALF-DAYNUM PIC 99. 119000 3 ALF-DATE REDEFINES ALF-PART1 PIC 9(8). 119100 119200 3 ALF-PART2. 119300 5 ALF-HH PIC 99. 119400 5 ALF-MM PIC 99. 119500 3 ALF-TIME REDEFINES ALF-PART2 PIC 9(4). 119600 119700 3 ALF-PART3. 119800 5 ALF-FILL PIC X VALUE "0". 119900 5 ALF-WEEKDAYNUM PIC 9. 120000 120100 1 TIMEX. 120200 5 TIMEX1 PIC 9(4) COMP VALUE 0. 120300 5 TIMEX2 REDEFINES TIMEX1. 120400 7 TIMEX-TOP PIC X. 120500 7 TIMEX-BOTTOM PIC X. 120600 120700 1 TIME-FORMAT. 120800 5 HH PIC 99. 120900 5 FILLER PIC X VALUE ":". 121000 5 MM PIC 99. 121100 5 FILLER PIC X VALUE ":". 121200 5 SS PIC 99. 121300 121400 1 TIME-IN. 121500 5 THH PIC 99. 121600 5 TMM PIC 99. 121700 5 TSS PIC 99. 121800 121900 1 COMMAND-AREA. 122000 5 COMMANDA PIC X(72) VALUE " ". 122100 5 FILLER PIC X VALUE %15. 122200 122300 1 ACCEPT-AREA. 122400 5 ACCEPT-1 PIC X. 122500 5 ACCEPTR. 122600 7 ACCEPT-NUM PIC 9(9). 122700 7 ACCEPT-ITEM. 122800 9 ACCEPT-JS PIC X. 122900 9 ACCEPT-REST PIC X(70). 123000 123100 123200 1 DSPL-ITM. 123300 5 DISPLAY-ITEM PIC ---,---,--9. 123400 5 DISPLAY-ITEM11 REDEFINES DISPLAY-ITEM. 123500 7 FILLER PIC X(5). 123600 7 DISPLAY-ITEM6. 123700 9 FILLER PIC XX. 123800 9 DISPLAY-ITEM4. 123900 11 FILLER PIC XX. 124000 11 DISPLAY-ITEM2 PIC XX. 124100 124200 1 OPERAND-NUMBER. 124300 5 ON-NUM PIC 9(6) VALUE 0. 124400 5 ON-NUMX REDEFINES ON-NUM. 124500 7 FILLER PIC XX. 124600 7 OPERAND-NUMX. 124700 9 OPERAND-NUM PIC 9(4). 124800 9 OPERAND-NUMR REDEFINES OPERAND-NUM. 124900 11 FILLER PIC XX. 125000 11 OPERAND-NUMX2 PIC 99. 125100 125200 1 F1-PARAMS. 125300 5 F1-FILE-NAME PIC X(60) 125400 VALUE "VT011106.BACKUPS.TEMP ". 125500 5 F1-FILENUM PIC S9(4) COMP VALUE 0. 125600 5 F1-FOPTIONS PIC 9(4) COMP VALUE 0. 125700 5 F1-AOPTIONS PIC 9(4) COMP VALUE 0. 125800 5 F1-REC-SIZE PIC S9(4) COMP VALUE 2046. 125900 5 F1-CONTROL PIC 9(4) COMP VALUE 0. 126000 5 F1-LENGTH PIC S9(4) COMP VALUE 2046. 126100 5 F1-EOF PIC 9 VALUE 0. 126200 88 F1-END VALUE 1, 8, 9. 126300 126400 1 FCHECK. 126500 5 FCHECK-ERROR-CODE PIC S9(4) COMP VALUE 0. 126600 5 FCHECK-FILENUM PIC S9(4) COMP VALUE 0. 126700 5 FCHECK-NUMREC PIC S9(4) COMP VALUE 0. 126800 5 FCHECK-MSGLEN PIC S9(4) COMP VALUE 36. 126900 5 G-RECSRESULT PIC S9(4) COMP VALUE 0. 127000 127100 1 INFO. 127200 5 INFO-X PIC X VALUE " ". 127300 5 INFO-R PIC X(79) VALUE " ". 127400 127500 1 FERROR PIC S9(4) COMP VALUE 0. 127600 127700 1 FITEMS. 127800 5 IFILE-EOF PIC 9(4) COMP VALUE 19. 127900 5 IFILE-CODE PIC 9(4) COMP VALUE 9. 128000 5 IFILE-RECORD-SIZE PIC 9(4) COMP VALUE 14. 128100 5 IFILE-FOPTIONS PIC 9(4) COMP VALUE 13. 128200 5 IFILE-NAME PIC 9(4) COMP VALUE 1. 128300 5 IFILE-GROUP PIC 9(4) COMP VALUE 2. 128400 5 IFILE-ACCOUNT PIC 9(4) COMP VALUE 3. 128500 5 IFILE-CDATE PIC 9(4) COMP VALUE 8. 128600 5 IFILE-CTIME PIC 9(4) COMP VALUE 24. 128700 5 IFILE-LEOF PIC 9(4) COMP VALUE 19. 128800 5 IFILE-CREATOR PIC 9(4) COMP VALUE 0. 128900 129000 1 FVALUES. 129100 5 FILE-EOF PIC S9(9) COMP VALUE 0. 129200 5 FILE-CODE PIC S9(4) BINARY VALUE 9. 129300 5 FILE-RECORD-SIZE PIC S9(4) BINARY VALUE 0. 129400 5 FILE-FOPTIONS PIC S9(4) COMP VALUE 0. 129500 5 FILE-NAME-INFO. 129600 7 FILE-LABEL-NAME PIC X(8). 129700 7 FILE-GROUP PIC X(8). 129800 7 FILE-ACCOUNT PIC X(8). 129900 5 FILE-CDATE PIC S9(4) COMP VALUE 0. 130000 5 FILE-CTIME PIC S9(9) COMP VALUE 0. 130100 5 FILE-LEOF PIC S9(9) COMP VALUE 0. 130200 130300 77 CDATE PIC X(17) VALUE SPACES. 130400 77 CTIME PIC X(8) VALUE SPACES. 130500 130600 01 FULLDATE. 130700 5 FULLDAY PIC XXX. 130800 130900 5 FILLER PIC XX. 131000 88 FULL-COMMA1 VALUE ", ". 131100 131200 5 FILLER PIC X(4). 131300 88 JAN VALUE "JAN ". 131400 88 FEB VALUE "FEB ". 131500 88 MAR VALUE "MAR ". 131600 88 APR VALUE "APR ". 131700 88 MAY VALUE "MAY ". 131800 88 JUN VALUE "JUN ". 131900 88 JUL VALUE "JUL ". 132000 88 AUG VALUE "AUG ". 132100 88 SEP VALUE "SEP ". 132200 88 OCT VALUE "OCT ". 132300 88 NOV VALUE "NOV ". 132400 88 DEC VALUE "DEC ". 132500 88 FULL-MONTH-VALID VALUES 132600 "JAN " "FEB " "MAR " "APR " "MAY " "JUN " 132700 "JUL " "AUG " "SEP " "OCT " "NOV " "DEC ". 132800 132900 5 FULL-DAY PIC 99. 133000 5 FILLER REDEFINES FULL-DAY. 133100 7 FULL-DAY1 PIC X. 133200 7 FULL-DAY2 PIC X. 133300 133400 5 FILLER PIC XX. 133500 88 FULL-COMMA2 VALUE ", ". 133600 133700 5 FULL-YEAR PIC 9(4). 133800 133900 5 FILLER PIC XX. 134000 88 FULL-COMMA3 VALUE ", ". 134100 134200 5 FULL-HR PIC 99. 134300 5 FILLER REDEFINES FULL-HR. 134400 7 FULL-HR1 PIC X. 134500 7 FULL-HR2 PIC X. 134600 134700 5 FILLER PIC X. 134800 88 COLON VALUE ":". 134900 135000 5 FULL-MIN PIC 99. 135100 5 FULL-SPACE PIC X. 135200 135300 5 FILLER PIC XX. 135400 88 AM VALUE "AM". 135500 88 PM VALUE "PM". 135600 135700 1 FIERRORS. 135800 5 FIERROR OCCURS 25 TIMES PIC S9(4) COMP VALUE 0. 135900 136000 1 LOGREC. 136100 3 LOG-HEADER. 136200 5 LOGTYPE PIC S9(4) COMP. 136300 5 LOGLEN PIC S9(4) COMP. 136400 5 LOGPIN PIC S9(4) COMP. 136500 5 LOGDATE PIC 9(4) COMP. 136600 136700 5 LOGTIME PIC 9(8) COMP. 136800 5 LOGTIMEX REDEFINES LOGTIME. 136900 7 LOGTIME-HOUR PIC X. 137000 7 LOGTIME-MIN PIC X. 137100 7 LOGTIME-SS PIC X. 137200 7 LOGTIME-SS10 PIC X. 137300 137400 5 LOGIND1 PIC X. 137500 5 LOGIND2 PIC X. 137600 137700 5 LOGSESS PIC S9(4) COMP. 137800 137900 3 LOG-102. 138000 5 LOGJOB PIC X(16). 138100 5 LOGUSER PIC X(16). 138200 5 LOGGROUP PIC X(16). 138300 5 LOGACCOUNT PIC X(16). 138400 5 LOGONGROUP PIC X(16). 138500 5 LOGLDEV PIC S9(4) COMP. 138600 5 LOGLDEV-OUT PIC S9(4) COMP. 138700 5 LOGSUCCESS PIC X. 138800 5 LOGQUEUE PIC X. 138900 5 LOGCPULIMIT PIC S9(8) COMP. 139000 5 LOGINPRI PIC X. 139100 5 LOGOUTPRI PIC X. 139200 5 LOGCIPROG PIC X(16). 139300 5 LOGCIGROUP PIC X(16). 139400 5 LOGCIACCOUNT PIC X(16). 139500 5 LOGMPEXLSTATUS PIC S9(8) COMP. 139600 5 LOGJUNK PIC X(4). 139700 139800 3 LOG-103 REDEFINES LOG-102. 139900 4 FIRST-103. 140000 5 LOGMAXPRI103 PIC S9(4) COMP. 140100 5 LOGMAXPROCCREATE PIC S9(4) COMP. 140200 5 LOGCPU PIC S9(9) COMP. 140300 5 LOGMIN PIC S9(9) COMP. 140400 4 SECOND-103. 140500 5 LOGUSER-103 PIC X(16). 140600 5 LOGGROUP-103 PIC X(16). 140700 5 LOGACCOUNT-103 PIC X(16). 140800 5 LOGJSNAME PIC X(16). 140900 4 NOT-103. 141000 5 FILLER PIC X(72). 141100 141200 3 LOG-FILLER. 141300 5 LOG-FILLJUNK PIC X(2048). 141400 141500*------------------------------------------------------------ 141600 141700 PROCEDURE DIVISION. 141800 SECTION1 SECTION. 141900 STARTUP. 142000 142100 CALL INTRINSIC "GETINFO" USING PARM-INFO, PARM-SIZE, 142200 PARM-VALUE. 142300 142400 CALL INTRINSIC "WHO" USING WHO-MODE \\ \\ 142500 WHO-USER, WHO-GROUP, WHO-ACCOUNT. 142600 142700 DIVIDE 4 INTO WHO-MODE. 142800 142900 CALL "SETCTLYTRAP". 143000 MOVE 0 TO CTLYSET. 143100 143200 143300 MOVE SPACES TO DISPLAY-LINE. 143400 143500 DISPLAY " File Backup Distiller:". 143600 143700 143800 DISPLAY " CSB220: Version 1.0 Compiled " WHEN-COMPILED. 143900 DISPLAY " ". 144000 144100 144200 IF PARM-INFO = "HELP" PERFORM HELP STOP RUN. 144300 144400 MOVE SPACES TO DISPLAY-LINE. 144500 MOVE 0 TO SUB. 144600 INITIALIZE TBI. 144700 144800 CALL INTRINSIC "PUTJCW" USING JCWNAME, JCWVALUE, JCWSTATUS. 144900 145000 IF PARM-INFO = SPACES 145100 DISPLAY " No parameters for CSB220." 145200 ELSE 145300 MOVE PARM-INFO TO INFO 145400 PERFORM JUSTIFY-INFO 145500 MOVE INFO TO PARM-INFO. 145600 145700 IF PARM-VALUE = 3 AND PARM-INFO NOT = SPACES 145800 PERFORM DB-OPEN 145900 MOVE PARM-INFO TO TAPE-SEARCH 146000 PERFORM FIND-TAPE 146100 PERFORM DB-CLOSE. 146200 146300 IF PARM-VALUE = 3 146400 DISPLAY "Tape File Backup Search Ended." 146500 STOP RUN. 146600 146700 IF PARM-VALUE = 666 AND PARM-INFO = "INITIALIZE" 146800 PERFORM INITIALIZE-FILES 146900 STOP RUN. 147000 147100 IF PARM-VALUE = 666 AND PARM-INFO = "CTB INIT" 147200 PERFORM CTB-INIT 147300 STOP RUN. 147400 147500 IF PARM-VALUE = 666 147600 DISPLAY "** CSB220 Invalid initialization parmeters!" 147700 STOP RUN. 147800 147900 148000 IF PARM-VALUE = 61 OR 62 PERFORM UPLOAD-RFILE. 148100 148200 IF PARM-VALUE = 63 PERFORM UPLOAD-VT STOP RUN. 148300 148400 IF PARM-VALUE = 2 PERFORM FINGURE-IT. 148500 148600 IF PARM-VALUE = 1 PERFORM FIGURE-IT. 148700 148800 IF PARM-VALUE = 66 AND PARM-INFO = "VALIDATE" 148900 PERFORM VALIDATE-RECORDS 149000 ELSE 149100 IF PARM-VALUE = 66 AND PARM-INFO = "CLEANUP" 149200 PERFORM DELETE-BACKUPS. 149300 149400 IF PARM-VALUE = 4 PERFORM SHOW-BACKUPS. 149500 149600 IF PARM-VALUE = 0 PERFORM FIGURE-IT. 149700 149800 DISPLAY " ". 149900 DISPLAY " -- CSB220 COMPLETED.". 150000 150100 STOP RUN. 150200 150300 HELP. 150400*--------------------------------------------------------- 150500* 150600* HELP 150700 150800*--------------------------------------------------------- 150900 151000 DISPLAY "Parmeters:" 151100 DISPLAY " ". 151200 DISPLAY "PARM=0". 151300 DISPLAY " List backed up file(s)". 151400 DISPLAY ' INFO="filename(@).group.account"'. 151500 DISPLAY " filename(@).@.@". 151600 DISPLAY " filename(@)". 151700 DISPLAY " [assumes current group and account when blank]". 151800 DISPLAY " ". 151900 DISPLAY " Items listed:". 152000 DISPLAY " File Group Account Stored Vol Session Modified". 152100 DISPLAY " ". 152200 DISPLAY " Example:". 152300 DISPLAY " :CSB220 TEST". 152400 DISPLAY " ". 152500 152600 DISPLAY "PARM=1". 152700 DISPLAY " List backed up file(s)". 152800 DISPLAY ' INFO="filename(@).group.account"'. 152900 DISPLAY " filename(@).@.@". 153000 DISPLAY " filename(@)". 153100 DISPLAY " ". 153200 DISPLAY " [assumes current group and account when blank]". 153300 153400 DISPLAY " ". 153500 DISPLAY " Same as PARM=0 except different items listed:". 153600 DISPLAY " ". 153700 DISPLAY 153800 " Filename Code Recsze Type EOF Session Backup Date". 153900 DISPLAY " ". 154000 DISPLAY " Example:". 154100 DISPLAY ' :RUN CSB220;PARM=1;INFO="TEST"'. 154200 DISPLAY " ". 154300 154400 154500 DISPLAY "PARM=2". 154600 DISPLAY " Generate restore for a file". 154700 DISPLAY " ". 154800 DISPLAY ' INFO="filename"'. 154900 DISPLAY " filename.group". 155000 DISPLAY " filename.group.account". 155100 DISPLAY " ". 155200 DISPLAY " [assumes current group and account when blank]". 155300 DISPLAY " ". 155400 DISPLAY " Note: The file cannot have any wild card (@)". 155500 DISPLAY " ". 155600 DISPLAY 155700 " Backups of file are shown with left side numbers." 155800 DISPLAY " Enter the number representing your choice.". 155900 DISPLAY " Tapes and file numbers will be displayed.". 156000 DISPLAY " A RESTOREJ file will be created for " 156100 " streaming a restore.". 156200 DISPLAY " ". 156300 DISPLAY " ". 156400 DISPLAY " Example:". 156500 DISPLAY ' :RUN CSB220;PARM=2;INFO="TEST"'. 156600 DISPLAY " ". 156700 156800 DISPLAY "PARM=3". 156900 DISPLAY " Show all backup information related to a tape.". 157000 DISPLAY " ". 157100 DISPLAY ' INFO="volume"'. 157200 DISPLAY " ". 157300 DISPLAY " Example:". 157400 DISPLAY ' :RUN CSB220;PARM=2;INFO="901234"'. 157500 DISPLAY " ". 157600 157700 DISPLAY "PARM=4". 157800 DISPLAY " List all backups". 157900 DISPLAY " ". 158000 DISPLAY " Yields information for each backup:". 158100 DISPLAY " #Session / Date / Time / " 158200 "Tape VSN of main volume / Message". 158300 DISPLAY " ". 158400 DISPLAY " Example:". 158500 DISPLAY " :RUN CSB220;PARM=4". 158600 DISPLAY " ". 158700*-------------------------------------------------------------- 158800* 158900* PARM=63 Info should be virtual tape backup on disc, 159000* but the program will ask (whether from a session or 159100* not) for the file name if it is not given in INFO= 159200* 159300* UPLOAD-VT loads data concerning backed-up files held within 159400* a virtual tape backup on disc. 159500* 159600* The upload creates temporary files to process the backup; 159700* because it is on disc and no tapes are needed, 159800* processing can begin right away and does. 159900* 160000* The CTB cross-references date and time to the CSB so the 160100* original backup file on disc can be found to do 160200* restores; file modify attributes are used to insure 160300* the disc file is the correct one--a rename or copy 160400* changes the modify date, so be warned. 160500* 160600 UPLOAD-VT. 160700 IF PARM-INFO = SPACES PERFORM UPLOAD-VT-FILENAME. 160800 160900 IF PARM-INFO NOT = SPACES PERFORM UPLOAD-VT1 ELSE 161000 DISPLAY "No virtual backup name given for processing" 161100 DISPLAY " no processing will be done.". 161200 161300 UPLOAD-VT1. 161400 UNSTRING PARM-INFO DELIMITED BY "." OR SPACE 161500 INTO SEARCH-FILE, SEARCH-GROUP, SEARCH-ACCOUNT. 161600 161700 IF SEARCH-GROUP = SPACES MOVE WHO-GROUP TO SEARCH-GROUP. 161800 161900 IF SEARCH-ACCOUNT = SPACES 162000 MOVE WHO-ACCOUNT TO SEARCH-ACCOUNT. 162100 162200 MOVE SPACES TO PARM-INFO. 162300 162400 STRING SEARCH-FILE "." SEARCH-GROUP "." SEARCH-ACCOUNT 162500 DELIMITED BY SPACE 162600 INTO PARM-INFO. 162700 162800 MOVE PARM-INFO TO F1-FILE-NAME. 162900 163000 CALL INTRINSIC "FLABELINFO" USING 163100 F1-FILE-NAME, 2, FERROR, FITEMS, FVALUES, FIERRORS. 163200 163300 IF CC NOT = 0 163400 MOVE "8" TO INFO-IN. 163500 163600 MOVE FERROR TO FCHECK-ERROR-CODE. 163700 163800 IF FCHECK-ERROR-CODE > 0 PERFORM FCHECK-ERROR 163900 MOVE "8" TO INFO-IN. 164000 164100 IF INFO-IN-OK 164200 IF FILE-RECORD-SIZE > 2048 164300 DISPLAY "** WRONG FILE RECORD SIZE ** " 164400 MOVE "7" TO INFO-IN. 164500 164600 IF INFO-IN-OK 164700 IF FILE-CODE = 21074 OR -21074 NEXT SENTENCE 164800 ELSE 164900 DISPLAY "File specified might not be a virtual backup". 165000 165100 IF INFO-IN-OK 165200 PERFORM VT-UPLOAD2 165300 ELSE 165400 DISPLAY " ** Invalid virtual disk file **" 165500 DISPLAY 165600 " ** No CSB220 processing will take place **". 165700 165800 VT-UPLOAD2. 165900 OPEN I-O CTB. 166000 MOVE SPACES TO FULLDATE. 166100 166200 CALL INTRINSIC "FMTDATE" 166300 USING FILE-CDATE, FILE-CTIME, FULLDATE. 166400 166500 INSPECT FULLDATE REPLACING ALL LOW-VALUES BY SPACES. 166600 166700 IF FULL-DAY1 = " " MOVE "0" TO FULL-DAY1. 166800 166900 IF FULL-HR1 = " " MOVE "0" TO FULL-HR1. 167000 167100 INITIALIZE CTB-REC. 167200 167300 MOVE F1-FILE-NAME TO CTB-FILE. 167400 167500 MOVE FILE-CODE TO CTB-CODE. 167600 167700 MOVE FILE-LEOF TO CTB-MEOF. 167800 167900 MOVE FULL-YEAR TO DATEYYYY. 168000 168100 MOVE 1 TO DATEMM. 168200 MOVE FULL-DAY TO DATEDD. 168300 168400 IF JAN MOVE 1 TO DATEMM. 168500 IF FEB MOVE 2 TO DATEMM. 168600 IF MAR MOVE 3 TO DATEMM. 168700 IF APR MOVE 4 TO DATEMM. 168800 IF MAY MOVE 5 TO DATEMM. 168900 IF JUN MOVE 6 TO DATEMM. 169000 IF JUL MOVE 7 TO DATEMM. 169100 IF AUG MOVE 8 TO DATEMM. 169200 IF SEP MOVE 9 TO DATEMM. 169300 IF OCT MOVE 10 TO DATEMM. 169400 IF NOV MOVE 11 TO DATEMM. 169500 IF DEC MOVE 12 TO DATEMM. 169600 169700 MOVE DATEPACKED TO CTB-DATE. 169800 169900 MOVE FULL-HR TO TIMEHH. 170000 170100 MOVE FULL-MIN TO TIMEMM. 170200 170300 MOVE TIME2 TO CTB-TIME. 170400 170500 INITIALIZE TBI. 170600 170700 MOVE CTB-KEY TO TBI-ALTKEY. 170800 170900 SET CTB-NORMAL TO TRUE. 171000 READ CTB INVALID KEY SET CTB-INV TO TRUE. 171100 171200 IF CTB-NORMAL 171300 DELETE CTB INVALID KEY SET CTB-INV TO TRUE. 171400 171500 INITIALIZE CTB-REC. 171600 MOVE TBI-ALTKEY TO CTB-KEY. 171700 171800 MOVE F1-FILE-NAME TO CTB-FILE. 171900 MOVE FILE-CODE TO CTB-CODE. 172000 MOVE FILE-LEOF TO CTB-MEOF. 172100 172200 MOVE FILE-CODE TO DSPLY. 172300 172400 STRING "Backup file " DELIMITED BY SIZE 172500 F1-FILE-NAME DELIMITED BY SPACE 172600 " Modified ", FULLDATE DELIMITED BY SIZE 172700 INTO DISPLAY-LINE. 172800 172900 PERFORM LIST-OUT. 173000 173100 DISPLAY DSPLY " file code". 173200 173300 MOVE FILE-LEOF TO DSPLY. 173400 DISPLAY DSPLY " blocks in virtual file.". 173500 173600 PERFORM VT-UPLOAD3. 173700 173800 VT-UPLOAD3. 173900 DISPLAY "Now purging and creating XXVTLIST and XXVTPARM " 174000 "to process virtual disk file:". 174100 174200 MOVE "PURGE XXVTLIST" TO COMMANDA. 174300 PERFORM DO-COMMAND. 174400 174500 MOVE "PURGE XXVTLIST;TEMP" TO COMMANDA. 174600 PERFORM DO-COMMAND. 174700 174800 MOVE "PURGE XXVTPARM" TO COMMANDA. 174900 PERFORM DO-COMMAND. 175000 175100 MOVE "PURGE XXVTPARM;TEMP" TO COMMANDA. 175200 PERFORM DO-COMMAND. 175300 175400 MOVE "RESET XXVTPARM" TO COMMANDA. 175500 PERFORM DO-COMMAND. 175600 175700 MOVE "RESET XXVTLIST" TO COMMANDA. 175800 PERFORM DO-COMMAND. 175900 176000 MOVE 176100 "FILE XXVTLIST;REC=,,F,ASCII;DEV=DISC;CCTL;TEMP" 176200 TO COMMANDA. 176300 176400 PERFORM DO-COMMAND. 176500 176600 OPEN OUTPUT XXVTPARM. 176700 176800 MOVE " DISPLAY NOCONSOLE" TO XXVTPARMA. 176900 WRITE XXVTPARMA. 177000 177100 MOVE " SELECT /" TO XXVTPARMA. 177200 WRITE XXVTPARMA. 177300 177400 MOVE " LISTDIR FROM (DISC NAME " TO XXVTPARMA. 177500 WRITE XXVTPARMA. 177600 177700 MOVE SPACES TO XXVTPARMA. 177800 STRING " " DELIMITED BY SIZE 177900 F1-FILE-NAME DELIMITED BY SPACE 178000 ")" DELIMITED BY SIZE 178100 INTO XXVTPARMA. 178200 WRITE XXVTPARMA. 178300 178400 MOVE " REPORT (FULLNAME,VOLNAME,MEDIA, " 178500 TO XXVTPARMA. 178600 WRITE XXVTPARMA. 178700 178800 MOVE " FILECODE,RECSIZE,RECTYPE,EOF, " 178900 TO XXVTPARMA. 179000 WRITE XXVTPARMA. 179100 179200 MOVE 179300 " DATES,CRETIME,MODTIME,ACCTIME,PATHNAME " 179400 TO XXVTPARMA. 179500 WRITE XXVTPARMA. 179600 179700 MOVE " TO *XXVTLIST)" TO XXVTPARMA. 179800 WRITE XXVTPARMA. 179900 180000 MOVE " /GO" TO XXVTPARMA. 180100 WRITE XXVTPARMA. 180200 180300 MOVE " EXIT " TO XXVTPARMA. 180400 WRITE XXVTPARMA. 180500 180600 CLOSE XXVTPARM. 180700 180800 MOVE "RUN BP.PUB.TYM < XXVTPARM" TO COMMANDA. 180900 PERFORM DO-COMMAND. 181000 181100 OPEN I-O CSB. 181200 181300 OPEN INPUT XFILE. 181400 PERFORM VT-READ UNTIL XFILE-EOF. 181500 CLOSE XFILE. 181600 181700 IF CTB-RECORDS > 0 181800 INITIALIZE CSB-REC 181900 MOVE CTB-KEY TO CSB-ALTKEY 182000 PERFORM CSB-WRITE. 182100 182200 CLOSE CSB. 182300 182400 MOVE CTB-RECORDS TO DSPLY. 182500 WRITE CTB-REC INVALID KEY 182600 DISPLAY "CTB Record not written". 182700 182800 CLOSE CTB. 182900 183000 DISPLAY DSPLY " files stored in virtual file.". 183100 183200 UPLOAD-VT-FILENAME. 183300 DISPLAY "Enter virtual filename to search: ". 183400 ACCEPT INFO. 183500 PERFORM JUSTIFY-INFO. 183600 MOVE INFO TO PARM-INFO. 183700 183800 VT-READ. 183900 IF NOT XFILE-EOF 184000 MOVE SPACES TO XFILE-REC 184100 READ XFILE AT END SET XFILE-EOF TO TRUE. 184200 184300 IF NOT XFILE-EOF 184400 INSPECT XFILE-REC REPLACING ALL LOW-VALUES BY SPACES 184500 IF XFILE-REC NOT = SPACES 184600 IF XRTOSKIP NEXT SENTENCE 184700 ELSE 184800 IF XRNA1 OR XRNA2 184900 NEXT SENTENCE 185000 ELSE 185100* DISPLAY XRFILENAME XRDOT1 XRGROUP XRDOT1 XRACCOUNT 185200 PERFORM VT-READ1. 185300 185400 VT-READ1. 185500 SET NOTSELECTED TO TRUE. 185600 MOVE "A1" TO LEVEL-MADE. 185700 185800 IF XRCS1Y AND XRCS2Y AND XRAS1Y AND 185900 XRCS2Y AND XRMS1Y AND XRMS2Y 186000 MOVE "A2" TO LEVEL-MADE 186100 IF XRCM NUMERIC AND XRCD NUMERIC AND XRCY NUMERIC 186200 MOVE "A3" TO LEVEL-MADE 186300 IF XRAM NUMERIC AND XRAD NUMERIC AND XRAY NUMERIC 186400 MOVE "A4" TO LEVEL-MADE 186500 IF XRMM NUMERIC AND XRMD NUMERIC AND XRMY NUMERIC 186600 MOVE "A5" TO LEVEL-MADE 186700 IF XRCM > 00 AND XRCM < 13 AND XRAD > 0 AND XRAD < 32 186800 MOVE "A6" TO LEVEL-MADE 186900 IF XRAM > 00 AND XRAM < 13 AND XRAD > 0 AND XRAD < 32 187000 MOVE "A7" TO LEVEL-MADE 187100 IF XRMM > 00 AND XRMM < 13 AND XRMD > 0 AND XRMD < 32 187200 MOVE "A8" TO LEVEL-MADE 187300 IF XRCTC AND XRATC AND XRMTC 187400 MOVE "A9" TO LEVEL-MADE 187500 IF XRCTHR NUMERIC AND XRCTMI NUMERIC 187600 MOVE "B1" TO LEVEL-MADE 187700 IF XRCTHR < 25 AND XRCTMI < 61 187800 MOVE "B2" TO LEVEL-MADE 187900 IF XRATHR NUMERIC AND XRATMI NUMERIC 188000 MOVE "B3" TO LEVEL-MADE 188100 IF XRATHR < 25 AND XRATMI < 61 188200 MOVE "B4" TO LEVEL-MADE 188300 IF XRMTHR NUMERIC AND XRMTMI NUMERIC 188400 MOVE "B5" TO LEVEL-MADE 188500 IF XRMTHR < 25 AND XRMTMI < 61 188600 MOVE "B6" TO LEVEL-MADE 188700 PERFORM VT-READ2. 188800 188900 IF NOTSELECTED IF NOT LEVELA 189000 DISPLAY "Level=" LEVEL-MADE "-" XFILE-REC. 189100 189200 VT-READ2. 189300 SET SELECTED TO TRUE. 189400 ADD 1 TO FILES1. 189500 189600 ADD 1 TO FILES4. 189700 189800 INITIALIZE CSB-REC. 189900 MOVE XRFILENAME TO CSB-FILE. 190000 MOVE XRGROUP TO CSB-GROUP. 190100 MOVE XRACCOUNT TO CSB-ACCOUNT. 190200 MOVE "0" TO XSTATUS. 190300 MOVE XRVOLNAME TO XVOLNAME. 190400 190500 MOVE XRFILECODE TO XFILECODE. 190600 MOVE XRRECSIZE TO XRECSIZE. 190700 MOVE XRRECTYPE TO XRECTYPE. 190800 190900 INSPECT XREOF REPLACING ALL SPACES BY ZEROS. 191000 191100 IF XREOF9 NUMERIC 191200 MOVE XREOF9 TO XEOF. 191300 191400 MOVE 20 TO DATECC. 191500 MOVE XRCY TO DATEYY. 191600 IF XRCY > 80 MOVE 19 TO DATECC. 191700 MOVE XRCM TO DATEMM. 191800 MOVE XRCD TO DATEDD. 191900 MOVE DATEPACKED TO XCDATE. 192000 192100 MOVE XRCTHR TO TIMEHH. 192200 MOVE XRCTMI TO TIMEMM. 192300 MOVE TIME2 TO XCTIME. 192400 192500 MOVE 20 TO DATECC. 192600 MOVE XRAY TO DATEYY. 192700 IF XRAY > 80 MOVE 19 TO DATECC. 192800 MOVE XRAM TO DATEMM. 192900 MOVE XRAD TO DATEDD. 193000 MOVE DATEPACKED TO XADATE. 193100 193200 MOVE XRATHR TO TIMEHH. 193300 MOVE XRATMI TO TIMEMM. 193400 MOVE TIME2 TO XATIME. 193500 193600 MOVE 20 TO DATECC. 193700 MOVE XRMY TO DATEYY. 193800 IF XRCY > 80 MOVE 19 TO DATECC. 193900 MOVE XRMM TO DATEMM. 194000 MOVE XRMD TO DATEDD. 194100 MOVE DATEPACKED TO XMDATE. 194200 194300 MOVE XRMTHR TO TIMEHH. 194400 MOVE XRMTMI TO TIMEMM. 194500 MOVE TIME2 TO XMTIME. 194600 194700 MOVE CTB-KEY TO CSB-ALTKEY. 194800 194900 PERFORM CSB-WRITE. 195000 195100 IF CSB-NORMAL 195200 ADD 1 TO CTB-RECORDS 195300 ELSE 195400 PERFORM CSB-REWRITE 195500 IF CSB-NORMAL 195600 ADD 1 TO CTB-RECORDS 195700 ELSE 195800 DISPLAY "Virtual record not written to CSB:" 195900 DISPLAY CSB-FILE-KEY, " " 196000 CSB-DATE, " - " 196100 CSB-TIME. 196200*---------------------------------------------------------------- 196300 CHECKOUT. 196400 SET CTB-NORMAL TO TRUE. 196500 MOVE CTB-FILE TO F1-FILE-NAME. 196600 196700 CALL INTRINSIC "FLABELINFO" USING 196800 F1-FILE-NAME, 2, FERROR, FITEMS, FVALUES, FIERRORS. 196900 197000 IF CC NOT = 0 197100 SET CTB-NOMATCH TO TRUE. 197200 197300 MOVE FERROR TO FCHECK-ERROR-CODE. 197400 197500 IF FCHECK-ERROR-CODE > 0 PERFORM FCHECK-ERROR 197600 SET CTB-NOMATCH TO TRUE. 197700 197800 IF CTB-NORMAL 197900 IF FILE-RECORD-SIZE > 2048 198000 SET CTB-NOMATCH TO TRUE. 198100 198200 MOVE SPACES TO FULLDATE. 198300 198400 CALL INTRINSIC "FMTDATE" 198500 USING FILE-CDATE, FILE-CTIME, FULLDATE. 198600 198700 INSPECT FULLDATE REPLACING ALL LOW-VALUES BY SPACES. 198800 198900 IF FULL-DAY1 = " " MOVE "0" TO FULL-DAY1. 199000 199100 IF FULL-HR1 = " " MOVE "0" TO FULL-HR1. 199200 199300 IF FILE-CODE NOT = CTB-CODE 199400 SET CTB-NOMATCH TO TRUE. 199500 199600 IF FILE-LEOF NOT = CTB-MEOF 199700 SET CTB-NOMATCH TO TRUE. 199800 199900 MOVE FULL-YEAR TO DATEYYYY. 200000 200100 MOVE 1 TO DATEMM. 200200 MOVE FULL-DAY TO DATEDD. 200300 200400 IF JAN MOVE 1 TO DATEMM. 200500 IF FEB MOVE 2 TO DATEMM. 200600 IF MAR MOVE 3 TO DATEMM. 200700 IF APR MOVE 4 TO DATEMM. 200800 IF MAY MOVE 5 TO DATEMM. 200900 IF JUN MOVE 6 TO DATEMM. 201000 IF JUL MOVE 7 TO DATEMM. 201100 IF AUG MOVE 8 TO DATEMM. 201200 IF SEP MOVE 9 TO DATEMM. 201300 IF OCT MOVE 10 TO DATEMM. 201400 IF NOV MOVE 11 TO DATEMM. 201500 IF DEC MOVE 12 TO DATEMM. 201600 201700 IF DATEPACKED NOT = CTB-DATE 201800 SET CTB-NOMATCH TO TRUE. 201900 202000 MOVE FULL-HR TO TIMEHH. 202100 202200 MOVE FULL-MIN TO TIMEMM. 202300 202400 IF TIME2 NOT = CTB-TIME 202500 SET CTB-NOMATCH TO TRUE. 202600 202700 IF CTB-NOMATCH 202800 DISPLAY "Virtual backup file has different " 202900 "modification date/time stamp than recorded " 203000 "in the Backup Catalog.". 203100 203200*---------------------------------------------------------------- 203300 203400 DELETE-BACKUPS. 203500 DISPLAY " ". 203600 DISPLAY " --CSB220 Cleanup phase started.". 203700 203800 OPEN I-O CSB. 203900 PERFORM DELETE-BACKUPS1 UNTIL CSB-EOF. 204000 CLOSE CSB. 204100 204200 IF FILES4 > 0 204300 MOVE FILES4 TO DSPLY 204400 DISPLAY DSPLY " File records attempted deletion." 204500 IF PURGED-FILES > 0 204600 MOVE PURGED-FILES TO DSPLY 204700 DISPLAY DSPLY " File records deleted." 204800 IF FILES5 > 0 204900 MOVE FILES5 TO DSPLY 205000 DISPLAY DSPLY " File records deletion unsuccessful.". 205100 205200 DISPLAY " --CSB220 Cleanup complete.". 205300 DISPLAY " ". 205400 205500 DELETE-BACKUPS1. 205600 PERFORM CSB-READ. 205700 205800 IF NOT CSB-EOF 205900 IF XSTATUS = "9" 206000 PERFORM DELETE-BACKUPS2. 206100 206200 DELETE-BACKUPS2. 206300 ADD 1 TO FILES4. 206400 PERFORM CSB-DELETE. 206500 IF CSB-INV ADD 1 TO FILES5 206600 ELSE 206700 ADD 1 TO PURGED-FILES. 206800 206900*--------------------------------------------------------- 207000* From PARM-VALUE = 4 207100 207200 SHOW-BACKUPS. 207300 DISPLAY " ". 207400 DISPLAY "CSB220: Now showing all backup sessions.". 207500 DISPLAY " ". 207600 DISPLAY "Session Date Time VOLUME1". 207700 OPEN INPUT CTB. 207800 OPEN INPUT CSB. 207900 PERFORM SHOW-BACKUPS1 UNTIL CSB-EOF. 208000 CLOSE CSB. 208100 CLOSE CTB. 208200 208300 SHOW-BACKUPS1. 208400 PERFORM CSB-READ. 208500 208600 208700 IF CTLYSET > 0 208800 DISPLAY "...Control-Y" 208900 DISPLAY "Processing terminated--" 209000 SET CSB-EOF TO TRUE. 209100 209200 IF NOT CSB-EOF PERFORM SHOW-BACKUPS2. 209300 209400 SHOW-BACKUPS2. 209500 IF CSB-K1 NOT = SPACES 209600 SET CSB-EOF TO TRUE 209700 ELSE 209800 IF CSB-DATE NOT = 0 209900 PERFORM SHOW-BACKUPS3. 210000 210100 SHOW-BACKUPS3. 210200 ADD 1 TO SUB. 210300 MOVE CSB-TIME TO TIME2. 210400 210500 MOVE CSB-DATE TO DATEPACKED. 210600 210700 IF XSTATUS NOT = "9" 210800 PERFORM SHOW-BACKUPS4 210900 ELSE 211000 PERFORM SHOW-BACKUPS6. 211100 211200 SHOW-BACKUPS4. 211300 IF CSB-SESSION NOT = " " 211400 DISPLAY " " 211500 CSB-SESSION " " 211600 DATEMM "/" DATEDD "/" DATECC DATEYY " " 211700 TIMEHH ":" TIMEMM 211800 " " XVOLNAME " " COMMENTS-DS 211900 ELSE 212000 PERFORM SHOW-BACKUPS5. 212100 212200 212300 SHOW-BACKUPS5. 212400 INITIALIZE CTB-REC. 212500 MOVE CSB-ALTKEY TO CTB-KEY. 212600 READ CTB INVALID KEY 212700 DISPLAY "Additional information not available for:". 212800 212900 MOVE CTB-RECORDS TO CTB-DISPLAY. 213000 213100 DISPLAY " " 213200 CSB-SESSION " " 213300 DATEMM "/" DATEDD "/" DATECC DATEYY " " 213400 TIMEHH ":" TIMEMM 213500 " " CTB-FILE " " CTB-DISPLAY " Files Saved". 213600 213700 213800 SHOW-BACKUPS6. 213900 DISPLAY "-" 214000 CSB-SESSION " " 214100 DATEMM "/" DATEDD "/" DATECC DATEYY " " 214200 TIMEHH ":" TIMEMM 214300 " " XVOLNAME " " COMMENTS-DS. 214400 214500*-------------------------------------------------------------- 214600*-------------------------------------------------------------- 214700* From PARM-VALUE = 2 INFO can be = "filename" 214800 214900 FINGURE-IT. 215000 INITIALIZE SEARCH-RECORD. 215100 215200 IF PARM-INFO = SPACES 215300 PERFORM FINGURE-ITK1. 215400 215500 IF PARM-INFO NOT = SPACES 215600 UNSTRING PARM-INFO DELIMITED BY "." OR SPACE 215700 INTO SEARCH-FILE, SEARCH-GROUP, SEARCH-ACCOUNT. 215800 215900 IF SEARCH-GROUP = SPACES 216000 MOVE WHO-GROUP TO SEARCH-GROUP. 216100 216200 IF SEARCH-ACCOUNT = SPACES 216300 MOVE WHO-ACCOUNT TO SEARCH-ACCOUNT. 216400 216500 PERFORM FINGURE-ITKEY. 216600 216700 FINGURE-ITK1. 216800 DISPLAY "Enter filename to search: ". 216900 ACCEPT INFO. 217000 PERFORM JUSTIFY-INFO. 217100 MOVE INFO TO PARM-INFO. 217200 217300 FINGURE-ITKEY. 217400 SET FMH-SW TO TRUE. 217500 DISPLAY "Searching on " SEARCH-RECORD. 217600 217700 MOVE SEARCH-FILE TO AT-FILE. 217800 217900 STRING SEARCH-FILE "." SEARCH-GROUP "." SEARCH-ACCOUNT 218000 DELIMITED BY SPACE 218100 INTO FINDFILE. 218200 218300 MOVE AT-FILE TO SEARCH-FILE. 218400 MOVE SEARCH-FILE TO FF-MATCH. 218500 INSPECT FF-MATCH REPLACING ALL SPACES BY HIGH-VALUES. 218600 218700 OPEN INPUT CSB. 218800 INITIALIZE CSB-REC. 218900 MOVE SEARCH-RECORD TO CSB-K1. 219000 219100 PERFORM CSB-START. 219200 219300 IF CSB-NORMAL 219400 MOVE SEARCH-RECORD TO CSB-K1 219500 PERFORM FINGURE-IT2 UNTIL NOT CSB-NORMAL OR 219600 CSB-FILE > FF-MATCH 219700 PERFORM FINGURE-IT4 219800 ELSE 219900 DISPLAY "No start find on record.". 220000 220100 CLOSE CSB. 220200 220300 FINGURE-IT2. 220400 PERFORM CSB-READ. 220500 220600 220700 IF CTLYSET > 0 220800 DISPLAY "...Control-Y" 220900 DISPLAY "Processing terminated--" 221000 SET CSB-EOF TO TRUE. 221100 221200 221300 IF CSB-NORMAL 221400 IF SEARCH-RECORD = CSB-K1 221500 PERFORM FINGURE-IT3 221600 ELSE 221700 SET CSB-EOF TO TRUE. 221800 221900 FINGURE-IT3. 222000 IF VALIDATE-PTR NOT > 699 222100 ADD 1 TO VALIDATE-PTR 222200 MOVE VALIDATE-PTR TO FM1-PTR 222300 MOVE CSB-ALTKEY TO MATRIX-KEY (VALIDATE-PTR). 222400 222500 222600 PERFORM PRINT-FM1. 222700 222800 FINGURE-IT4. 222900 DISPLAY " ". 223000 DISPLAY "Enter number of backup selection:". 223100 MOVE SPACES TO INFO. 223200 PERFORM FINGURE-IN UNTIL INFO NOT = SPACES. 223300 223400 MOVE INFO TO SJW-XO. 223500 223600 MOVE 0 TO SJW-NUM. 223700 223800 PERFORM NUM-MOVE UNTIL SJW-X > "9" OR < "0". 223900 224000 IF SJW-NUM = 0 DISPLAY "No selection given." 224100 ELSE 224200 IF SJW-NUM > VALIDATE-PTR DISPLAY "Selection out of range." 224300 ELSE 224400 PERFORM FINGURE-IT5. 224500 224600 FINGURE-IN. 224700 ACCEPT INFO. 224800 PERFORM JUSTIFY-INFO. 224900 225000 FINGURE-IT5. 225100 IF MATRIX-SESSION (SJW-NUM) NOT = SPACES 225200 PERFORM FINGURE-IT5A 225300 ELSE 225400 PERFORM FINGURE-IT30. 225500 225600 FINGURE-IT5A. 225700 225800 DISPLAY "Selection is " SJW-NUM. 225900 226000 PERFORM DB-OPEN. 226100 226200 MOVE MATRIX-DATE (SJW-NUM) TO DATEPACKED. 226300 MOVE DATEYY TO CREATE-YY. 226400 MOVE DATEMM TO CREATE-MM. 226500 MOVE DATEDD TO CREATE-DD. 226600 226700 MOVE MATRIX-TIME (SJW-NUM) TO CREATE-TIME-DS. 226800 MOVE MATRIX-SESSION (SJW-NUM) TO SESSION-DS. 226900 227000 MOVE CREATE-DATE-DS TO SAVE-CREATE-DATE. 227100 MOVE CREATE-TIME-DS TO SAVE-CREATE-TIME. 227200 MOVE SESSION-DS TO SAVE-SESSION. 227300 227400 DISPLAY " ". 227500 DISPLAY "Now searching for backup for " 227600 SAVE-SESSION " on " SAVE-CREATE-DATE " at " 227700 SAVE-CREATE-TIME. 227800 227900 PERFORM FINGURE-IT6 UNTIL IMAGE-STATUS NOT = 0. 228000 228100 PERFORM DB-CLOSE. 228200 228300 IF SS-PTR1 > 0 228400 PERFORM SORT-START 228500 MOVE SS-PTR1 TO DSPLY 228600 PERFORM FINGURE-IT20 228700 DISPLAY DSPLY " Tapes used for backup:" 228800 DISPLAY " " 228900 MOVE 0 TO SS-PTR2 229000 PERFORM FINGURE-IT9 SS-PTR1 TIMES 229100 PERFORM FINGURE-IT90. 229200 229300 FINGURE-IT6. 229400* Mode 2 is a Serial Read: 229500 CALL "DBGET" USING BASE, DS-DATA-SET-GEN, MODE2, STAT, 229600 ALL-LIST, DB-DATA-SET-GEN, DUMMY. 229700 229800 IF IMAGE-STATUS = 0 229900 PERFORM FINGURE-IT7. 230000 230100 FINGURE-IT7. 230200 IF CREATE-DATE-DS = SAVE-CREATE-DATE 230300 IF CREATE-TIME-DS = SAVE-CREATE-TIME 230400 IF SESSION-DS = SAVE-SESSION 230500 IF SS-PTR1 < 700 230600 PERFORM FINGURE-IT8. 230700 230800 FINGURE-IT8. 230900 ADD 1 TO SS-PTR1. 231000 231100 MOVE FILE-NAME-DS TO BACKUPS-FILES (SS-PTR1). 231200 231300 STRING FILE-NAME-DS "." 231400 GROUP-NAME-DS "." 231500 ACCOUNT-NAME-DS 231600 DELIMITED BY SPACES INTO BACKUPS-FILE (SS-PTR1). 231700 231800 MOVE TAPE-NUMBER-DS TO BACKUPS-VOLUME (SS-PTR1). 231900 232000 MOVE GEN-GENNUM-DS TO BACKUPS-GENNUM (SS-PTR1). 232100 MOVE GEN-GENOF-DS TO BACKUPS-GENOF (SS-PTR1). 232200 MOVE GEN-GEN-DS TO BACKUPS-GEN (SS-PTR1). 232300 232400 FINGURE-IT9. 232500 232600 ADD 1 TO SS-PTR2. 232700 232800 IF BACKUPS-GENNUM (SS-PTR2) = 01 232900 233000 DISPLAY '"FILE ' BACKUPS-FILE (SS-PTR2) 233100 233200 ";LABEL=" BACKUPS-VOLUME (SS-PTR2) 233300 233400 ";GEN=" BACKUPS-GEN (SS-PTR2) '"' 233500 233600 " (Tape " BACKUPS-GENNUM (SS-PTR2) " of Set " 233700 233800 BACKUPS-GENOF (SS-PTR2) ")" 233900 234000 PERFORM FINGURE-IT22 234100 234200 ELSE 234300 234400 DISPLAY " " 234500 234600 " " BACKUPS-VOLUME (SS-PTR2) " " 234700 234800 " " BACKUPS-GENNUM (SS-PTR2) 234900 235000 MOVE SPACES TO RESTOREJ-REC 235100 STRING "!TELLOP Need " BACKUPS-GENNUM (SS-PTR2) 235200 " tape volume: " BACKUPS-VOLUME (SS-PTR2) 235300 " for restore" 235400 DELIMITED BY SIZE 235500 INTO RESTOREJ-REC 235600 WRITE RESTOREJ-REC. 235700 235800 235900 FINGURE-IT20. 236000 OPEN OUTPUT RESTOREJ. 236100 MOVE SPACES TO RESTOREJ-REC. 236200 236300 STRING "!JOB RESTOREJ," DELIMITED BY SIZE 236400 WHO-USER "." WHO-ACCOUNT DELIMITED BY SPACES 236500 INTO RESTOREJ-REC. 236600 236700 WRITE RESTOREJ-REC. 236800 236900 MOVE "!COMMENT" TO RESTOREJ-REC. 237000 WRITE RESTOREJ-REC. 237100 237200 MOVE SPACES TO RESTOREJ-REC. 237300 STRING "!TELLOP Restore for " DELIMITED BY SIZE 237400 FINDFILE DELIMITED BY SPACES 237500 " Now Starting " DELIMITED BY SIZE 237600 INTO RESTOREJ-REC. 237700 WRITE RESTOREJ-REC. 237800 237900 FINGURE-IT22. 238000 MOVE "!COMMENT" TO RESTOREJ-REC. 238100 WRITE RESTOREJ-REC. 238200 238300 MOVE SPACES TO RESTOREJ-REC. 238400 STRING '!TR "FILE ' DELIMITED BY SIZE 238500 BACKUPS-FILES (SS-PTR2) 238600 "=" 238700 BACKUPS-FILE (SS-PTR2) 238800 ";GEN=" 238900 BACKUPS-GEN (SS-PTR2) 239000 '"' 239100 DELIMITED BY SPACES 239200 INTO RESTOREJ-REC. 239300 239400 WRITE RESTOREJ-REC. 239500 239600 ADD 1 TO RESTOREX-PTR. 239700 239800 STRING '!TR "SAVE ' DELIMITED BY SIZE 239900 BACKUPS-FILE (SS-PTR2) 240000 '"' 240100 DELIMITED BY SPACES 240200 INTO RESTOREXO (RESTOREX-PTR). 240300 240400 MOVE SPACES TO RESTOREJ-REC. 240500 240600 STRING "!TELLOP Need " BACKUPS-GENNUM (SS-PTR2) 240700 " tape volume: " 240800 BACKUPS-VOLUME (SS-PTR2) " for restore" 240900 DELIMITED BY SIZE 241000 INTO RESTOREJ-REC. 241100 241200 WRITE RESTOREJ-REC. 241300 241400************************************************************* 241500* 241600* Logic for restoring backed-up file from virtual backup 241700* tape on disc. 241800* 241900 242000 FINGURE-IT30. 242100 242200 MOVE MATRIX-DATE (SJW-NUM) TO DATEPACKED. 242300 MOVE DATEYY TO CREATE-YY. 242400 MOVE DATEMM TO CREATE-MM. 242500 MOVE DATEDD TO CREATE-DD. 242600 242700 MOVE MATRIX-TIME (SJW-NUM) TO CREATE-TIME-DS. 242800 MOVE MATRIX-SESSION (SJW-NUM) TO SESSION-DS. 242900 243000 MOVE CREATE-DATE-DS TO SAVE-CREATE-DATE. 243100 MOVE CREATE-TIME-DS TO SAVE-CREATE-TIME. 243200 243300 DISPLAY " ". 243400 DISPLAY "Now searching for backup " 243500 " on " SAVE-CREATE-DATE " at " 243600 SAVE-CREATE-TIME. 243700 243800 OPEN INPUT CTB. 243900 INITIALIZE CTB-REC. 244000 MOVE MATRIX-DATE (SJW-NUM) TO CTB-DATE. 244100 MOVE MATRIX-TIME (SJW-NUM) TO CTB-TIME. 244200 244300 SET CTB-NORMAL TO TRUE. 244400 244500 READ CTB INVALID KEY 244600 SET CTB-INV TO TRUE 244700 DISPLAY "Unable to find virtual backup file". 244800 244900 IF CTB-NORMAL PERFORM FINGURE-IT310. 245000 CLOSE CTB. 245100 245200 FINGURE-IT310. 245300 DISPLAY "Backup is in Virtual Disk File " CTB-FILE. 245400 OPEN OUTPUT RESTOREJ. 245500 MOVE SPACES TO RESTOREJ-REC. 245600 245700 STRING "!JOB RESTOREJ," DELIMITED BY SIZE 245800 WHO-USER "." WHO-ACCOUNT DELIMITED BY SPACES 245900 INTO RESTOREJ-REC. 246000 246100 WRITE RESTOREJ-REC. 246200 246300 MOVE "!COMMENT" TO RESTOREJ-REC. 246400 WRITE RESTOREJ-REC. 246500 246600 MOVE "!CONTINUE" TO RESTOREJ-REC. 246700 WRITE RESTOREJ-REC. 246800 246900 MOVE "!RUN BP.PUB.TYM" TO RESTOREJ-REC. 247000 WRITE RESTOREJ-REC. 247100 247200 MOVE SPACES TO RESTOREJ-REC. 247300 STRING " SELECT " DELIMITED BY SIZE 247400 SEARCH-FILE "." SEARCH-GROUP "." SEARCH-ACCOUNT 247500 DELIMITED BY SPACES 247600 INTO RESTOREJ-REC. 247700 WRITE RESTOREJ-REC. 247800 247900 MOVE SPACES TO RESTOREJ-REC. 248000 248100 STRING " RESTORE FROM (DISC NAME " DELIMITED BY SIZE 248200 CTB-FILE DELIMITED BY SPACES 248300 ")" 248400 DELIMITED BY SIZE 248500 INTO RESTOREJ-REC. 248600 WRITE RESTOREJ-REC. 248700 248800 MOVE " KEEPNEW REPORT OLDDATE " TO RESTOREJ-REC. 248900 WRITE RESTOREJ-REC. 249000 249100 MOVE "/GO" TO RESTOREJ-REC. 249200 WRITE RESTOREJ-REC. 249300 249400 MOVE "/EXIT" TO RESTOREJ-REC. 249500 WRITE RESTOREJ-REC. 249600 249700 MOVE "!COMMENT" TO RESTOREJ-REC. 249800 WRITE RESTOREJ-REC. 249900 250000 MOVE "!EOJ" TO RESTOREJ-REC. 250100 WRITE RESTOREJ-REC. 250200 CLOSE RESTOREJ. 250300 250400 DISPLAY "RESTOREJ job stream file created.". 250500 250600 FINGURE-IT90. 250700 MOVE "!COMMENT" TO RESTOREJ-REC. 250800 WRITE RESTOREJ-REC. 250900 251000 MOVE SPACES TO RESTOREJ-REC. 251100 STRING "!TELLOP Now restoring " DELIMITED BY SIZE 251200 SEARCH-FILE "." SEARCH-GROUP "." SEARCH-ACCOUNT 251300 DELIMITED BY SPACES 251400 INTO RESTOREJ-REC. 251500 WRITE RESTOREJ-REC. 251600 251700 MOVE "!COMMENT" TO RESTOREJ-REC. 251800 WRITE RESTOREJ-REC. 251900 252000 MOVE "!CONTINUE" TO RESTOREJ-REC. 252100 WRITE RESTOREJ-REC. 252200 252300 MOVE "!RUN BP.PUB.TYM" TO RESTOREJ-REC. 252400 WRITE RESTOREJ-REC. 252500 252600 MOVE SPACES TO RESTOREJ-REC. 252700 STRING " SELECT " DELIMITED BY SIZE 252800 SEARCH-FILE "." SEARCH-GROUP "." SEARCH-ACCOUNT 252900 DELIMITED BY SPACES 253000 INTO RESTOREJ-REC. 253100 WRITE RESTOREJ-REC. 253200 253300 MOVE SPACES TO RESTOREJ-REC. 253400 253500 STRING " RESTORE FROM *" DELIMITED BY SIZE 253600 BACKUPS-FILES (1) DELIMITED BY SPACES 253700 " KEEPNEW REPORT OLDDATE " 253800 DELIMITED BY SIZE 253900 INTO RESTOREJ-REC. 254000 WRITE RESTOREJ-REC. 254100 254200 MOVE "/GO" TO RESTOREJ-REC. 254300 WRITE RESTOREJ-REC. 254400 254500 MOVE "/EXIT" TO RESTOREJ-REC. 254600 WRITE RESTOREJ-REC. 254700 254800 MOVE "!COMMENT" TO RESTOREJ-REC. 254900 WRITE RESTOREJ-REC. 255000 255100 MOVE "!IF JCW <= WARN THEN" TO RESTOREJ-REC. 255200 WRITE RESTOREJ-REC. 255300 255400 255500 MOVE SPACES TO RESTOREJ-REC. 255600 STRING "!TELLOP Restore for " DELIMITED BY SIZE 255700 FINDFILE DELIMITED BY SPACES 255800 " Successful " DELIMITED BY SIZE 255900 INTO RESTOREJ-REC. 256000 WRITE RESTOREJ-REC. 256100 256200 MOVE "!ELSE" TO RESTOREJ-REC. 256300 WRITE RESTOREJ-REC. 256400 256500 MOVE "!SHOWJCW" TO RESTOREJ-REC. 256600 WRITE RESTOREJ-REC. 256700 256800 MOVE '!JPAUSE "********* Restore Unsuccessful!" ' 256900 TO RESTOREJ-REC. 257000 WRITE RESTOREJ-REC. 257100 257200 MOVE "!ENDIF" TO RESTOREJ-REC. 257300 WRITE RESTOREJ-REC. 257400 257500 MOVE "!COMMENT" TO RESTOREJ-REC. 257600 WRITE RESTOREJ-REC. 257700 257800 IF RESTOREX-PTR > 0 257900 MOVE 0 TO SUB 258000 PERFORM FINGURE-IT99 RESTOREX-PTR TIMES. 258100 258200 MOVE "!COMMENT" TO RESTOREJ-REC. 258300 WRITE RESTOREJ-REC. 258400 258500 258600 MOVE SPACES TO RESTOREJ-REC. 258700 STRING "!TELLOP Restore for " DELIMITED BY SIZE 258800 FINDFILE DELIMITED BY SPACES 258900 " Completed " DELIMITED BY SIZE 259000 INTO RESTOREJ-REC. 259100 WRITE RESTOREJ-REC. 259200 259300 MOVE "!COMMENT" TO RESTOREJ-REC. 259400 WRITE RESTOREJ-REC. 259500 259600 MOVE "!EOJ" TO RESTOREJ-REC. 259700 WRITE RESTOREJ-REC. 259800 CLOSE RESTOREJ. 259900 260000 DISPLAY " ". 260100 DISPLAY "CSB220: RESTOREJ has the recovery job for " 260200 "retrieving " FINDFILE. 260300 260400 FINGURE-IT99. 260500 ADD 1 TO SUB. 260600 WRITE RESTOREJ-REC FROM RESTOREXO (SUB). 260700 260800 SORT-START. 260900 MOVE SS-PTR1 TO SS-PTR3. 261000 MOVE 1 TO SS-PTR2. 261100 261200 PERFORM SORT-X1 UNTIL SS-PTR3 NOT > SS-PTR2. 261300 261400 SORT-X1. 261500 IF SSS-KEY (SS-PTR2) > SSS-KEY (SS-PTR3) 261600 MOVE SSS-OCCURS (SS-PTR3) TO SRT-RECORD 261700 MOVE SSS-OCCURS (SS-PTR2) TO SSS-OCCURS (SS-PTR3) 261800 MOVE SRT-RECORD TO SSS-OCCURS (SS-PTR2). 261900 262000 MOVE SS-PTR2 TO SS-PTR4. 262100 262200 COMPUTE SS-PTR5 = (SS-PTR3 - SS-PTR2) - 1. 262300 262400 IF SS-PTR5 > 0 262500 PERFORM SORT-X2 SS-PTR5 TIMES. 262600 262700 ADD 1 TO SS-PTR2. 262800 SUBTRACT 1 FROM SS-PTR3. 262900 263000 SORT-X2. 263100 ADD 1 TO SS-PTR4. 263200 263300 IF SSS-KEY (SS-PTR4) > SSS-KEY (SS-PTR3) 263400 MOVE SSS-OCCURS (SS-PTR3) TO SRT-RECORD 263500 MOVE SSS-OCCURS (SS-PTR4) TO SSS-OCCURS (SS-PTR3) 263600 MOVE SRT-RECORD TO SSS-OCCURS (SS-PTR4) 263700 ELSE 263800 IF SSS-KEY (SS-PTR4) < SSS-KEY (SS-PTR2) 263900 MOVE SSS-OCCURS (SS-PTR2) TO SRT-RECORD 264000 MOVE SSS-OCCURS (SS-PTR4) TO SSS-OCCURS (SS-PTR2) 264100 MOVE SRT-RECORD TO SSS-OCCURS (SS-PTR4). 264200 264300 NUM-MOVE. 264400 MOVE SJW-R3 TO SJW2. 264500 264600*-------------------------------------------------------------- 264700* 264800* Checking the attributes of the virtual tape on disc file: 264900* 265000 265100 FILE-CHECK. 265200 CALL INTRINSIC "FLABELINFO" USING 265300 F1-FILE-NAME, 2, FERROR, FITEMS, FVALUES, FIERRORS. 265400 265500 IF CC NOT = 0 265600 MOVE "8" TO INFO-IN. 265700 265800 MOVE FERROR TO FCHECK-ERROR-CODE. 265900 266000 IF FCHECK-ERROR-CODE > 0 PERFORM FCHECK-ERROR 266100 MOVE "8" TO INFO-IN. 266200 266300 IF INFO-IN-OK 266400 IF FILE-RECORD-SIZE > 2048 266500 DISPLAY "** WRONG FILE RECORD SIZE ** " 266600 MOVE "7" TO INFO-IN 266700 ELSE 266800 IF FILE-CODE NOT = 0 AND NOT = 710 266900 MOVE FILE-CODE TO DSPLY 267000 DISPLAY "** WRONG TYPE OF FILE ** " 267100 " (CODE =" DSPLY ")" 267200 MOVE "7" TO INFO-IN. 267300 267400 IF INFO-IN-OK 267500 IF FILE-FOPTIONS NOT = 5 AND NOT = 7 AND NOT = 0 267600 AND NOT = 1029 AND NOT = 1031 AND NOT = 65 267700 MOVE FILE-FOPTIONS TO DSPLY 267800 DISPLAY "** WRONG FILE TYPE ** " 267900 " FOPTIONS = (" DSPLY ")" 268000 MOVE "7" TO INFO-IN. 268100 268200 IF INFO-IN-OK 268300 IF FILE-EOF < 1 268400 DISPLAY " ** NO RECORDS ON SELECTED FILE **" 268500 MOVE "5" TO INFO-IN 268600 ELSE 268700 MOVE FILE-EOF TO DSPLY 268800 DISPLAY DSPLY " RECORDS ARE TO BE PROCESSED.". 268900 269000 IF INFO-IN-OK 269100 PERFORM FOPEN-INPUT. 269200 269300 IF INFO-IN-OK 269400 IF F1-END 269500 MOVE "4" TO INFO-IN 269600 DISPLAY " INFO-IN-OK SET TO 4.". 269700 269800 IF NOT INFO-IN-OK 269900 DISPLAY "** ERRORS PREVENT LOG EXAMINATION" 270000 DISPLAY " PROCESS TERMINATED **". 270100 270200 FCLOSE-INPUT. 270300 IF F1-FILENUM > 0 270400 CALL INTRINSIC "FCLOSE" USING F1-FILENUM, 0, 0. 270500 270600 MOVE 9 TO F1-EOF 270700 270800 MOVE 0 TO F1-EOF. 270900 MOVE 0 TO F1-FILENUM. 271000 271100 FOPEN-INPUT. 271200 MOVE 0 TO FCHECK-ERROR-CODE. 271300 MOVE 0 TO SUB. 271400 MOVE 65 TO F1-FOPTIONS. 271500 MOVE 0 TO F1-AOPTIONS. 271600 MOVE 0 TO F1-FILENUM. 271700 MOVE FILE-RECORD-SIZE TO F1-REC-SIZE. 271800 271900 CALL INTRINSIC "FOPEN" USING F1-FILE-NAME 272000 F1-FOPTIONS, 272100 F1-AOPTIONS, 272200 F1-REC-SIZE 272300 GIVING F1-FILENUM. 272400 272500 IF CC NOT = 0 272600 PERFORM FCHECK-INPUT 272700 MOVE 9 TO F1-EOF 272800 ELSE 272900 MOVE 2 TO F1-EOF. 273000 273100 FREAD-INPUT. 273200 MOVE SPACES TO LOGREC. 273300 273400 CALL INTRINSIC "FREAD" USING 273500 F1-FILENUM, 273600 LOGREC, 273700 F1-REC-SIZE, 273800 GIVING F1-LENGTH 273900 IF CC NOT = 0 274000 MOVE 8 TO F1-EOF 274100 DISPLAY " End of file found in FREAD-INPUT " 274200 MOVE RECORD-COUNT TO DSPLY 274300 DISPLAY DSPLY " Records were read." 274400 ELSE 274500 ADD 1 TO RECORD-COUNT. 274600 274700 IF F1-END AND RECORD-COUNT = 0 274800 PERFORM FCHECK-INPUT. 274900 275000 FCHECK-INPUT. 275100 CALL INTRINSIC "FCHECK" USING F1-FILENUM, 275200 FCHECK-ERROR-CODE, \\, \\, FCHECK-NUMREC. 275300 275400 IF FCHECK-ERROR-CODE NOT = 0 275500 PERFORM FCHECK-ERROR. 275600 275700 FCHECK-ERROR. 275800 CALL INTRINSIC "FERRMSG" USING FCHECK-ERROR-CODE 275900 INFO, FCHECK-MSGLEN 276000 MOVE 120 TO LINE-LENGTH 276100 STRING "FILE ERROR FOR " DELIMITED BY SIZE 276200 F1-FILE-NAME DELIMITED BY SPACES 276300 ": " INFO DELIMITED BY SIZE 276400 INTO DISPLAY-LINE 276500 PERFORM LISTOUT. 276600 276700 276800*-------------------------------------------------------------- 276900* From PARM=5 or 0 (or not given) 277000* INFO can be = "filename.group.account" 277100 FIGURE-IT. 277200 INITIALIZE SEARCH-RECORD. 277300 IF PARM-INFO = SPACES 277400 PERFORM FIGURE-ITK1. 277500 277600 IF PARM-INFO NOT = SPACES 277700 UNSTRING PARM-INFO DELIMITED BY "." OR SPACE 277800 INTO SEARCH-FILE, SEARCH-GROUP, SEARCH-ACCOUNT. 277900 278000 IF SEARCH-GROUP = SPACES 278100 MOVE WHO-GROUP TO SEARCH-GROUP. 278200 278300 IF SEARCH-ACCOUNT = SPACES 278400 MOVE WHO-ACCOUNT TO SEARCH-ACCOUNT. 278500 278600 IF SEARCH-GROUP = "@" MOVE SPACES TO SEARCH-GROUP. 278700 IF SEARCH-ACCOUNT = "@" MOVE SPACES TO SEARCH-ACCOUNT. 278800 278900 PERFORM FIGURE-ITKEY. 279000 279100 FIGURE-ITK1. 279200 DISPLAY "Enter filename to search: ". 279300 ACCEPT INFO. 279400 PERFORM JUSTIFY-INFO. 279500 MOVE INFO TO PARM-INFO. 279600 279700 FIGURE-ITKEY. 279800 SET FMH-SW TO TRUE. 279900 DISPLAY "Searching on " SEARCH-RECORD. 280000 280100 MOVE SEARCH-FILE TO AT-FILE. 280200 280300 IF SEARCH-FILE8 (1) = "@" 280400 MOVE 1 TO AT-FILE-PTR ELSE 280500 IF SEARCH-FILE8 (2) = "@" 280600 MOVE 2 TO AT-FILE-PTR ELSE 280700 IF SEARCH-FILE8 (3) = "@" 280800 MOVE 3 TO AT-FILE-PTR ELSE 280900 IF SEARCH-FILE8 (4) = "@" 281000 MOVE 4 TO AT-FILE-PTR ELSE 281100 IF SEARCH-FILE8 (5) = "@" 281200 MOVE 5 TO AT-FILE-PTR ELSE 281300 IF SEARCH-FILE8 (6) = "@" 281400 MOVE 6 TO AT-FILE-PTR ELSE 281500 IF SEARCH-FILE8 (7) = "@" 281600 MOVE 7 TO AT-FILE-PTR ELSE 281700 IF SEARCH-FILE8 (8) = "@" 281800 MOVE 8 TO AT-FILE-PTR. 281900 282000 IF AT-FILE-PTR = 1 MOVE SPACES TO AT-FILE ELSE 282100 IF AT-FILE-PTR = 2 MOVE SPACES TO AT-FILE2 ELSE 282200 IF AT-FILE-PTR = 3 MOVE SPACES TO AT-FILE3 ELSE 282300 IF AT-FILE-PTR = 4 MOVE SPACES TO AT-FILE4 ELSE 282400 IF AT-FILE-PTR = 5 MOVE SPACES TO AT-FILE5 ELSE 282500 IF AT-FILE-PTR = 6 MOVE SPACES TO AT-FILE6 ELSE 282600 IF AT-FILE-PTR = 7 MOVE SPACES TO AT-FILE7 ELSE 282700 IF AT-FILE-PTR = 8 MOVE SPACES TO AT-FILE8. 282800 282900 MOVE AT-FILE TO SEARCH-FILE. 283000 MOVE SEARCH-FILE TO FF-MATCH. 283100 INSPECT FF-MATCH REPLACING ALL SPACES BY HIGH-VALUES. 283200 283300 OPEN INPUT CSB. 283400 INITIALIZE CSB-REC. 283500 MOVE SEARCH-RECORD TO CSB-K1. 283600 283700 PERFORM CSB-START. 283800 283900 IF CSB-NORMAL 284000 MOVE SEARCH-RECORD TO CSB-K1 284100 PERFORM FIGURE-IT2 UNTIL NOT CSB-NORMAL OR 284200 CSB-FILE > FF-MATCH 284300 ELSE 284400 DISPLAY "No start find on record.". 284500 284600 CLOSE CSB. 284700 284800 FIGURE-IT2. 284900 PERFORM CSB-READ. 285000 285100 IF CTLYSET > 0 285200 DISPLAY "...Control-Y" 285300 DISPLAY "Processing terminated--" 285400 SET CSB-EOF TO TRUE. 285500 285600 IF CSB-NORMAL 285700 IF SEARCH-RECORD = CSB-K1 285800 PERFORM FIGURE-IT3 285900 ELSE 286000 PERFORM FIGUREIT-COMP. 286100 286200 FIGUREIT-COMP. 286300 IF SEARCH-GROUP = CSB-GROUP OR "@" OR " " 286400 IF SEARCH-ACCOUNT = CSB-ACCOUNT OR "@" OR " " 286500 IF SEARCH-FILE = CSB-FILE OR AT-FILE-PTR = 1 286600 PERFORM FIGURE-IT3 286700 ELSE 286800 IF AT-FILE-PTR > 0 286900 PERFORM FIGURE-IT4. 287000 287100 FIGURE-IT3. 287200 IF PARM-VALUE = 1 287300 PERFORM PRINT-FM2 287400 ELSE 287500 PERFORM PRINT-FM1. 287600* PERFORM DIAGNOSEX2. 287700 287800 FIGURE-IT4. 287900 MOVE CSB-FILE TO AT-FILE. 288000 288100 IF AT-FILE-PTR = 2 MOVE SPACES TO AT-FILE2 ELSE 288200 IF AT-FILE-PTR = 3 MOVE SPACES TO AT-FILE3 ELSE 288300 IF AT-FILE-PTR = 4 MOVE SPACES TO AT-FILE4 ELSE 288400 IF AT-FILE-PTR = 5 MOVE SPACES TO AT-FILE5 ELSE 288500 IF AT-FILE-PTR = 6 MOVE SPACES TO AT-FILE6 ELSE 288600 IF AT-FILE-PTR = 7 MOVE SPACES TO AT-FILE7 ELSE 288700 IF AT-FILE-PTR = 8 MOVE SPACES TO AT-FILE8. 288800 288900 IF AT-FILE = SEARCH-FILE PERFORM FIGURE-IT3. 289000 289100 PRINT-FM1. 289200 MOVE CSB-FILE TO FM1-FILE 289300 MOVE CSB-GROUP TO FM1-GROUP 289400 MOVE CSB-ACCOUNT TO FM1-ACCOUNT. 289500 289600 MOVE CSB-DATE TO DATEPACKED. 289700 MOVE CSB-TIME TO TIME2. 289800 MOVE CSB-SESSION TO FM1-SESSION. 289900 290000 MOVE DATECC TO FM1-CC. 290100 MOVE DATEYY TO FM1-YY. 290200 MOVE DATEMM TO FM1-MO. 290300 MOVE DATEDD TO FM1-DD. 290400 290500 MOVE TIMEHH TO FM1-HH. 290600 MOVE TIMEMM TO FM1-MM. 290700 290800 MOVE XVOLNAME TO FM1-VOLUME. 290900 MOVE CSB-SESSION TO FM1-SESSION. 291000 291100 MOVE XMDATE TO DATEPACKED. 291200 MOVE XMTIME TO TIME2. 291300 291400 291500 MOVE DATECC TO FM1-MCC. 291600 MOVE DATEYY TO FM1-MYY. 291700 MOVE DATEMM TO FM1-MMM. 291800 MOVE DATEDD TO FM1-MDD. 291900 292000 MOVE TIMEHH TO FM1-MHH. 292100 MOVE TIMEMM TO FM1-MMI. 292200 292300 IF FMH-SW 292400 DISPLAY " " 292500 DISPLAY FMH 292600 MOVE "0" TO FM1-SW. 292700 292800 MOVE " " TO FM1-STATUS. 292900 IF XSTATUS = "9" MOVE "-" TO FM1-STATUS. 293000 293100 DISPLAY FM1. 293200 293300 PRINT-FM2. 293400 MOVE CSB-FILE TO FM2-FILE 293500 MOVE CSB-GROUP TO FM2-GROUP 293600 MOVE CSB-ACCOUNT TO FM2-ACCOUNT. 293700 293800 MOVE XFILECODE TO FM2-FILECODE. 293900 294000 MOVE XRECSIZE TO FM2-RECSIZE. 294100 294200 MOVE XRECTYPE TO FM2-RECTYPE. 294300 294400 MOVE XEOF TO FM2-EOF. 294500 294600 MOVE CSB-DATE TO DATEPACKED. 294700 MOVE CSB-TIME TO TIME2. 294800 MOVE CSB-SESSION TO FM2-SESSION. 294900 295000 MOVE DATECC TO FM2-CC. 295100 MOVE DATEYY TO FM2-YY. 295200 MOVE DATEMM TO FM2-MO. 295300 MOVE DATEDD TO FM2-DD. 295400 295500 MOVE TIMEHH TO FM2-HH. 295600 MOVE TIMEMM TO FM2-MM. 295700 295800 MOVE CSB-SESSION TO FM2-SESSION. 295900 296000 MOVE XMDATE TO DATEPACKED. 296100 MOVE XMTIME TO TIME2. 296200 296300 IF FMH2-SW 296400 DISPLAY " " 296500 DISPLAY FMH2 296600 MOVE "0" TO FM2-SW. 296700 296800 MOVE " " TO FM2-STATUS. 296900 IF XSTATUS = "9" MOVE "-" TO FM2-STATUS. 297000 297100 DISPLAY FM2. 297200 297300*------------------------------------------------------------- 297400* From PARM=61 or 62 297500* 297600* PARM=62 is original load from rfile 297700* PARM=61 is all other loads from rfile 297800 297900 UPLOAD-RFILE. 298000 298100 COMPUTE LENN = FUNCTION LENGTH (RFILE-REC). 298200 MOVE LENN TO LENR. 298300 DISPLAY LENR " is the length of RFILE-REC.". 298400 298500 SORT SORT-FILE ASCENDING SORT-KEY 298600 INPUT PROCEDURE SORT-IN 298700 OUTPUT PROCEDURE SORT-OUT. 298800 298900*--------------------------------------------------------------- 299000* From PARM=666 and INFO="INITIALIZE" 299100* 299200* Just because this will erase an old file and 299300* create a brand new empty one. 299400* 299500 INITIALIZE-FILES. 299600 DISPLAY "Now Initializing CSB file.". 299700 299800 MOVE "PURGE CSB" TO COMMANDA. 299900 PERFORM DO-COMMAND. 300000 300100 OPEN OUTPUT CSB. 300200 300300 INITIALIZE CSB-REC. 300400 300500 WRITE CSB-REC INVALID KEY 300600 DISPLAY "CSB initial record not saved". 300700 300800 CLOSE CSB. 300900 301000 MOVE "SAVE CSB" TO COMMANDA. 301100 PERFORM DO-COMMAND. 301200 301300 DISPLAY "CSB now initialized.". 301400 301500 PERFORM CTB-INIT. 301600 301700 MOVE "LISTFILE CSB,2" TO COMMANDA. 301800 PERFORM DO-COMMAND. 301900 302000 DISPLAY " ". 302100 DISPLAY " -- CSB220 COMPLETED.". 302200 302300 302400*--------------------------------------------------------------- 302500* From PARM=666 and INFO="CTB INIT" 302600* 302700* Just because this will erase an old file and 302800* create a brand new empty one. 302900* 303000 CTB-INIT. 303100 DISPLAY "Now Initializing CSB file.". 303200 303300 MOVE "PURGE CTB" TO COMMANDA. 303400 PERFORM DO-COMMAND. 303500 303600 OPEN OUTPUT CTB. 303700 303800 INITIALIZE CTB-REC. 303900 304000 WRITE CTB-REC INVALID KEY 304100 DISPLAY "CTB initial record not saved". 304200 304300 CLOSE CTB. 304400 304500 MOVE "SAVE CTB" TO COMMANDA. 304600 PERFORM DO-COMMAND. 304700 304800 DISPLAY "CTB now initialized.". 304900 305000 MOVE "LISTFILE CTB,2" TO COMMANDA. 305100 305200*------------------------------------------------------------ 305300 305400 DATA-BASE SECTION. 305500 DB-OPEN. 305600 305700* READ ACCESS only 305800 CALL "DBOPEN" USING BASE, PASSWORD, MODE5, STAT. 305900 IF IMAGE-STATUS NOT = 0 306000 DISPLAY " DBOPEN failed on " BASE-NAME 306100 PERFORM DBEXPLAINX. 306200 306300 DB-CLOSE. 306400 MOVE 0 TO IMAGE-STATUS. 306500 306600 IF BASE-ID NOT = SPACES 306700 CALL "DBCLOSE" USING BASE, DUMMY, MODE1, STAT. 306800 306900*----------------------------------------------------------- 307000* From PARM=6 and INFO="VALIDATE" 307100* 307200 VALIDATE-RECORDS. 307300 DISPLAY "--CSB220 Validating backup records.". 307400 PERFORM DB-OPEN. 307500 OPEN I-O CSB. 307600 OPEN INPUT CTB. 307700 PERFORM VALIDATE-RECORDS1 UNTIL CSB-EOF. 307800 CLOSE CTB. 307900 CLOSE CSB. 308000 PERFORM DB-CLOSE. 308100 308200 IF VALIDATE-PTR > 0 308300 PERFORM MARK-RECORDS 308400 MOVE VALIDATE-PTR TO DSPLY 308500 DISPLAY DSPLY " Record sets marked for deletion.". 308600 308700 DISPLAY "--CSB220 Validation complete.". 308800 308900 MARK-RECORDS. 309000 DISPLAY "--CSB220 now marking all deletion records.". 309100 MOVE VALIDATE-PTR TO DSPLY. 309200 DISPLAY " ". 309300 DISPLAY DSPLY " Keys to mark for deletion". 309400 309500 SET CSB-NORMAL TO TRUE. 309600 OPEN I-O CSB. 309700 PERFORM MARK-RECORDS1 UNTIL CSB-EOF. 309800 CLOSE CSB. 309900 310000 DISPLAY "--CSB220 record marking for deletion now complete.". 310100 310200 MARK-RECORDS1. 310300 PERFORM CSB-READ. 310400 IF NOT CSB-EOF PERFORM MARK-RECORDS2. 310500 310600 MARK-RECORDS2. 310700 MOVE 0 TO VALIDATE-PTR1. 310800 IF XSTATUS NOT = "9" 310900 PERFORM MARK-RECORDS3 UNTIL VALIDATE-PTR1 > VALIDATE-PTR. 311000 311100 MARK-RECORDS3. 311200 ADD 1 TO VALIDATE-PTR1. 311300 311400 IF VALIDATE-PTR1 NOT > VALIDATE-PTR 311500 IF MATRIX-KEY (VALIDATE-PTR1) = CSB-ALTKEY 311600 PERFORM MARK-RECORDS4. 311700 311800 MARK-RECORDS4. 311900 MOVE "9" TO XSTATUS. 312000 PERFORM CSB-REWRITE. 312100 312200 MOVE 701 TO VALIDATE-PTR1. 312300 312400 VALIDATE-RECORDS1. 312500 PERFORM CSB-READ. 312600 IF NOT CSB-EOF PERFORM VALIDATE-RECORDS2. 312700 312800 VALIDATE-RECORDS2. 312900 IF CSB-K1 NOT = SPACES 313000 SET CSB-EOF TO TRUE 313100 ELSE 313200 IF CSB-DATE NOT = 0 313300 IF CSB-SESSION = SPACES 313400 PERFORM VALIDATE-RECORDS2A 313500 ELSE 313600 PERFORM VALIDATE-RECORDS3. 313700 313800 VALIDATE-RECORDS2A. 313900 INITIALIZE CTB-REC. 314000 MOVE CSB-DATE TO CTB-DATE. 314100 MOVE CSB-TIME TO CTB-TIME. 314200 314300 SET CTB-NORMAL TO TRUE. 314400 314500 READ CTB INVALID KEY SET CTB-INV TO TRUE. 314600 314700 IF CTB-NORMAL 314800 DISPLAY "Now checking " CTB-FILE 314900 PERFORM CHECKOUT. 315000 315100 IF NOT CTB-NORMAL 315200 DISPLAY "CTB record found not valid" 315300 PERFORM NOT-VALID 315400 PERFORM VALIDATE-RECORDS4 315500 PERFORM CSB-REWRITE 315600 IF CSB-INV DISPLAY " Preceding record not rewritten--". 315700 315800 VALIDATE-RECORDS3. 315900 PERFORM VALIDATE-TAPE. 316000 MOVE " " TO XSTATUS. 316100 316200 IF NOTVALID PERFORM VALIDATE-RECORDS4. 316300 PERFORM CSB-REWRITE. 316400 316500 IF CSB-INV DISPLAY " Preceding record not rewritten--". 316600 316700 VALIDATE-RECORDS4. 316800 MOVE "9" TO XSTATUS. 316900 317000 ADD 1 TO SUB. 317100 MOVE CSB-TIME TO TIME2. 317200 317300 MOVE CSB-DATE TO DATEPACKED. 317400 317500 DISPLAY 317600 CSB-SESSION " " 317700 DATEMM "/" DATEDD "/" DATECC DATEYY " " 317800 TIMEHH ":" TIMEMM 317900 " " XVOLNAME. 318000 318100*------------------------------------------------------------ 318200 318300 VALIDATE-TAPE. 318400 MOVE XVOLNAME TO TAPE-SEARCH. 318500 318600 MOVE SPACE TO VALID-SW. 318700 MOVE CSB-SESSION TO SAVE-SESSION. 318800 318900 CALL "DBFIND" USING BASE, DS-DATA-SET-GEN, MODE1, STAT, 319000 DI-TAPE-NUMBER, TAPE-SEARCH. 319100 319200 IF IMAGE-STATUS NOT = 0 319300 DISPLAY "Validate-Tape on DBFIND" 319400 PERFORM DBEXPLAINX 319500 PERFORM NOT-VALID 319600 ELSE 319700 PERFORM VALIDATE-TAPE1. 319800 319900 NOT-VALID. 320000 SET NOTVALID TO TRUE. 320100 320200 IF VALIDATE-PTR NOT > 699 320300 ADD 1 TO VALIDATE-PTR 320400 MOVE CSB-ALTKEY TO MATRIX-KEY (VALIDATE-PTR). 320500 320600 VALIDATE-TAPE1. 320700 CALL "DBGET" USING BASE, DS-DATA-SET-GEN, MODE5, STAT, 320800 ALL-LIST, DB-DATA-SET-GEN, DUMMY. 320900 321000 IF IMAGE-STATUS NOT = 0 321100 DISPLAY "Validate-Tape1 on DBGET" 321200 PERFORM NOT-VALID 321300 ELSE 321400 IF SESSION-DS NOT = SAVE-SESSION 321500 321600 PERFORM NOT-VALID. 321700 321800*------------------------------------------------------------ 321900* PARM=3;INFO="tape vsn" 322000 322100 FIND-TAPE. 322200 CALL "DBFIND" USING BASE, DS-DATA-SET-GEN, MODE1, STAT, 322300 DI-TAPE-NUMBER, TAPE-SEARCH. 322400 322500 IF IMAGE-STATUS = 0 322600 PERFORM GET-TAPE 322700 ELSE 322800 DISPLAY TAPE-SEARCH " is not on file." 322900 PERFORM DBEXPLAINX. 323000 323100 GET-TAPE. 323200 CALL "DBGET" USING BASE, DS-DATA-SET-GEN, MODE5, STAT, 323300 ALL-LIST, DB-DATA-SET-GEN, DUMMY. 323400 323500 IF IMAGE-STATUS = 0 323600 PERFORM GET-TAPE1 323700 ELSE 323800 323900 DISPLAY TAPE-SEARCH " not found on file." 324000 PERFORM DBEXPLAINX. 324100 324200 DBEXPLAINX. 324300 DISPLAY BASE. 324400 DISPLAY DS-DATA-SET-GEN. 324500 DISPLAY DI-TAPE-NUMBER. 324600 DISPLAY "Search = " TAPE-SEARCH. 324700 CALL "DBEXPLAIN" USING STAT. 324800 324900 GET-TAPE1. 325000 MOVE CREATE-DATE-DS TO SAVE-CREATE-DATE. 325100 MOVE CREATE-TIME-DS TO SAVE-CREATE-TIME. 325200 MOVE SESSION-DS TO SAVE-SESSION. 325300 325400 DISPLAY "Now searching for backup for " 325500 SAVE-SESSION " on " SAVE-CREATE-DATE " at " 325600 SAVE-CREATE-TIME. 325700 325800* "Rewind" DATA-SET-GEN: 325900 CALL "DBCLOSE" USING BASE, DS-DATA-SET-GEN, MODE3, STAT. 326000 326100 PERFORM GET-FILE2 UNTIL IMAGE-STATUS NOT = 0. 326200 326300 GET-FILE2. 326400* Mode 2 is a Serial Read: 326500 CALL "DBGET" USING BASE, DS-DATA-SET-GEN, MODE2, STAT, 326600 ALL-LIST, DB-DATA-SET-GEN, DUMMY. 326700 326800 IF IMAGE-STATUS = 0 326900 PERFORM GET-FILE3. 327000 327100 GET-FILE3. 327200 IF CREATE-DATE-DS = SAVE-CREATE-DATE 327300 IF CREATE-TIME-DS = SAVE-CREATE-TIME 327400 IF SESSION-DS = SAVE-SESSION 327500 PERFORM GET-FILE4. 327600 327700 GET-FILE4. 327800 IF TBI-SESSION = SPACES 327900 328000 MOVE CREATE-YY TO DATEYY 328100 MOVE 20 TO DATECC 328200 328300 MOVE CREATE-MM TO DATEMM 328400 MOVE CREATE-DD TO DATEDD 328500 MOVE CREATE-DATE-DS TO TBI-DATE 328600 MOVE CREATE-TIME-DS TO TBI-TIME 328700 MOVE SESSION-DS TO TBI-SESSION 328800 MOVE 20 TO DATECC 328900 MOVE CREATE-YY TO DATEYY 329000 MOVE CREATE-MM TO DATEMM 329100 MOVE CREATE-DD TO DATEDD 329200 MOVE DATEPACKED TO TBI-DATE 329300 IF DATEYY > 70 MOVE 19 TO DATECC 329400 MOVE DATEPACKED TO TBI-DATE. 329500 329600 DISPLAY TAPE-NUMBER-DS " of " FILENAME-DS " Gen=" 329700 GEN-VER-VOL-DS. 329800 329900*------------------------------------------------------------- 330000 330100 MUNDANE SECTION. 330200 330300 PROCESS-FILES. 330400 IF NOT RFILE-EOF 330500 MOVE SPACES TO RFILE-REC 330600 READ RFILE AT END SET RFILE-EOF TO TRUE. 330700 330800 IF NOT RFILE-EOF 330900 INSPECT RFILE-REC REPLACING ALL LOW-VALUES BY SPACES 331000 IF RFILE-REC NOT = SPACES 331100 IF TOSKIP NEXT SENTENCE 331200 ELSE 331300 IF NOT NA1 AND NOT NA2 331400 PERFORM PROCESS-FILES1. 331500 331600 PROCESS-FILES1. 331700 SET NOTSELECTED TO TRUE. 331800 MOVE "A1" TO LEVEL-MADE. 331900 332000 IF RCS1Y AND RCS2Y AND RAS1Y AND RCS2Y AND RMS1Y AND RMS2Y 332100 MOVE "A2" TO LEVEL-MADE 332200 IF RCM NUMERIC AND RCD NUMERIC AND RCY NUMERIC 332300 MOVE "A3" TO LEVEL-MADE 332400 IF RAM NUMERIC AND RAD NUMERIC AND RAY NUMERIC 332500 MOVE "A4" TO LEVEL-MADE 332600 IF RMM NUMERIC AND RMD NUMERIC AND RMY NUMERIC 332700 MOVE "A5" TO LEVEL-MADE 332800 IF RCM > 00 AND RCM < 13 AND RAD > 0 AND RAD < 32 332900 MOVE "A6" TO LEVEL-MADE 333000 IF RAM > 00 AND RAM < 13 AND RAD > 0 AND RAD < 32 333100 MOVE "A7" TO LEVEL-MADE 333200 IF RMM > 00 AND RMM < 13 AND RMD > 0 AND RMD < 32 333300 MOVE "A8" TO LEVEL-MADE 333400 IF RCTC AND RATC AND RMTC 333500 MOVE "A9" TO LEVEL-MADE 333600 IF RCTHR NUMERIC AND RCTMI NUMERIC 333700 MOVE "B1" TO LEVEL-MADE 333800 IF RCTHR < 25 AND RCTMI < 61 333900 MOVE "B2" TO LEVEL-MADE 334000 IF RATHR NUMERIC AND RATMI NUMERIC 334100 MOVE "B3" TO LEVEL-MADE 334200 IF RATHR < 25 AND RATMI < 61 334300 MOVE "B4" TO LEVEL-MADE 334400 IF RMTHR NUMERIC AND RMTMI NUMERIC 334500 MOVE "B5" TO LEVEL-MADE 334600 IF RMTHR < 25 AND RMTMI < 61 334700 MOVE "B6" TO LEVEL-MADE 334800 PERFORM PROCESS-FILES2. 334900 335000 IF NOTSELECTED IF NOT LEVELA 335100 DISPLAY "Level=" LEVEL-MADE "-" RFILE-REC. 335200 335300 PROCESS-FILES2. 335400 SET SELECTED TO TRUE. 335500 ADD 1 TO FILES1. 335600 335700 PERFORM INSERT-TAPES. 335800 335900 ADD 1 TO FILES4. 336000 PERFORM TOSORT. 336100 336200 RELEASE SORT-RECORD. 336300 336400*------------------------------------------------------------ 336500 336600 INSERT-TAPES. 336700 IF RVOLNAME NOT = SPACES PERFORM INSERT-TAPES1. 336800 336900 INSERT-TAPES1. 337000 MOVE 0 TO SUB. 337100 337200 IF TAPE-VOLUMES = 0 337300 MOVE RVOLNAME TO TAPES 337400 MOVE 1 TO TAPE-VOLUMES 337500 ELSE 337600 PERFORM INSERT-TAPES2 UNTIL SUB > TAPE-VOLUMES. 337700 337800 INSERT-TAPES2. 337900 ADD 1 TO SUB. 338000 IF SUB > TAPE-VOLUMES 338100 MOVE SUB TO TAPE-VOLUMES 338200 MOVE RVOLNAME TO TAPE-VOLUME (TAPE-VOLUMES) 338300 MOVE 98 TO SUB 338400 ELSE 338500 IF RVOLNAME = TAPE-VOLUME (SUB) 338600 MOVE 98 TO SUB. 338700 338800 DISPLAY-TAPES. 338900 MOVE 0 TO SUB. 339000 339100 IF TAPE-VOLUMES > 0 339200 DISPLAY " " 339300 DISPLAY "Tape volumes found:" 339400 PERFORM DISPLAY-TAPES1 TAPE-VOLUMES TIMES 339500 DISPLAY "---". 339600 339700 DISPLAY-TAPES1. 339800 ADD 1 TO SUB. 339900 340000 IF TBI-SESSION = SPACES 340100 DISPLAY " ". 340200 PERFORM DISPLAY-TAPES2 340300 MOVE TAPE-VOLUME (SUB) TO IVOLNAME 340400 DISPLAY " ". 340500 340600 DISPLAY "(" SUB ")" TAPE-VOLUME (SUB). 340700 340800 DISPLAY-TAPES2. 340900 MOVE TAPE-VOLUME (SUB) TO TAPE-SEARCH. 341000 341100 PERFORM DB-OPEN. 341200 341300 PERFORM FIND-TAPE. 341400 341500 PERFORM DB-CLOSE. 341600 341700*-------------------------------------------------------------- 341800 341900 TOSORT. 342000 INITIALIZE SORT-RECORD. 342100 MOVE RFILENAME TO SFILENAME. 342200 MOVE RGROUP TO SGROUP. 342300 MOVE RACCOUNT TO SACCOUNT. 342400 MOVE "0" TO SSTATUS. 342500 MOVE RVOLNAME TO SVOLNAME. 342600 342700 MOVE RFILECODE TO SFILECODE. 342800 MOVE RRECSIZE TO SRECSIZE. 342900 MOVE RRECTYPE TO SRECTYPE. 343000 343100 INSPECT REOF REPLACING ALL SPACES BY ZEROS. 343200 343300 IF REOF9 NUMERIC 343400 MOVE REOF9 TO SEOF. 343500 343600 MOVE 20 TO DATECC. 343700 MOVE RCY TO DATEYY. 343800 IF RCY > 80 MOVE 19 TO DATECC. 343900 MOVE RCM TO DATEMM. 344000 MOVE RCD TO DATEDD. 344100 MOVE DATEPACKED TO SCDATE. 344200 MOVE RCTHR TO TIMEHH. 344300 MOVE RCTMI TO TIMEMM. 344400 MOVE TIME2 TO SCTIME. 344500 344600 MOVE 20 TO DATECC. 344700 MOVE RAY TO DATEYY. 344800 IF RAY > 80 MOVE 19 TO DATECC. 344900 MOVE RAM TO DATEMM. 345000 MOVE RAD TO DATEDD. 345100 MOVE DATEPACKED TO SADATE. 345200 MOVE RATHR TO TIMEHH. 345300 MOVE RATMI TO TIMEMM. 345400 MOVE TIME2 TO SATIME. 345500 345600 MOVE 20 TO DATECC. 345700 MOVE RMY TO DATEYY. 345800 IF RCY > 80 MOVE 19 TO DATECC. 345900 MOVE RMM TO DATEMM. 346000 MOVE RMD TO DATEDD. 346100 MOVE DATEPACKED TO SMDATE. 346200 MOVE RMTHR TO TIMEHH. 346300 MOVE RMTMI TO TIMEMM. 346400 MOVE TIME2 TO SMTIME. 346500 346600*-------------------------------------------------------------- 346700 346800 CSB-READ. 346900 SET CSB-NORMAL TO TRUE. 347000 READ CSB NEXT AT END SET CSB-EOF TO TRUE. 347100 347200 CSB-READKEY. 347300 SET CSB-NORMAL TO TRUE. 347400 READ CSB INVALID KEY SET CSB-INV TO TRUE. 347500 347600 CSB-START. 347700 SET CSB-NORMAL TO TRUE. 347800 START CSB KEY NOT < CSB-KEY INVALID KEY 347900 SET CSB-INV TO TRUE. 348000 348100 CSB-STARTALT. 348200 SET CSB-NORMAL TO TRUE. 348300 START CSB KEY NOT < CSB-ALTKEY INVALID KEY 348400 SET CSB-INV TO TRUE. 348500 348600 CSB-WRITE. 348700 SET CSB-NORMAL TO TRUE. 348800 WRITE CSB-REC INVALID KEY SET CSB-INV TO TRUE. 348900 349000 CSB-REWRITE. 349100 SET CSB-NORMAL TO TRUE. 349200 REWRITE CSB-REC INVALID KEY SET CSB-INV TO TRUE. 349300 349400 CSB-DELETE. 349500 SET CSB-NORMAL TO TRUE. 349600 DELETE CSB INVALID KEY SET CSB-INV TO TRUE. 349700 349800*------------------------------------------------------- 349900 350000 LIST-OUT. 350100 MOVE 120 TO LINE-LENGTH. 350200 350300 PERFORM LIST-OUT1 UNTIL LINE-LENGTH < 2 OR 350400 DSPLY-LN (LINE-LENGTH) NOT = " ". 350500 350600 ADD 1 TO LINE-LENGTH. 350700 350800 PERFORM LIST-OUTA. 350900 351000 LIST-OUTA. 351100 COMPUTE NEG-LENGTH = LINE-LENGTH * (-1). 351200 351300 DISPLAY DISPLAY-LINE. 351400 351500 MOVE 120 TO LINE-LENGTH. 351600 MOVE SPACES TO DISPLAY-LINE. 351700 351800 LIST-OUT1. 351900 IF DSPLY-LN (LINE-LENGTH) = " " 352000 SUBTRACT 1 FROM LINE-LENGTH. 352100 352200 LISTOUT. 352300 MOVE 120 TO LINE-LENGTH. 352400 352500 PERFORM LIST-OUT1 UNTIL LINE-LENGTH < 2 OR 352600 DSPLY-LN (LINE-LENGTH) NOT = " ". 352700 352800 COMPUTE NEG-LENGTH = LINE-LENGTH * (-1). 352900 353000 DISPLAY DISPLAY-LINE. 353100 353200 MOVE 120 TO LINE-LENGTH. 353300 MOVE SPACES TO DISPLAY-LINE. 353400 353500*------------------------------------------------------------ 353600 353700 JUSTIFY-INFO. 353800 IF INFO NOT = SPACES 353900 PERFORM JUSTIFY-INFO1 UNTIL INFO-X NOT = " ". 354000 354100 INSPECT INFO CONVERTING LOWER TO UPPER. 354200 354300 JUSTIFY-INFO1. 354400 MOVE INFO-R TO INFO. 354500 354600 JUSTIFY-JOB. 354700 IF JSNUMX NOT = SPACES 354800 IF JSNUM1 = " " OR "0" 354900 MOVE JSNUM2 TO JSNUMX. 355000 355100 MOVE-SJW. 355200 MOVE SJW-R3 TO SJW. 355300 355400 DO-COMMAND. 355500 CALL INTRINSIC "HPCICOMMAND" USING 355600 COMMAND-AREA, CMD-ERROR, CMD-PARAM. 355700 355800 IF CC NOT = 0 355900 MOVE CMD-ERROR TO DSPLY-ITM 356000 DISPLAY " * COMMAND ERROR " DSPLY-ITM " FOR " 356100 DISPLAY COMMANDA 356200 MOVE CMD-PARAM TO DSPLY-ITM 356300 DISPLAY DSPLY-ITM " = PARAM.". 356400 356500*---------------------------------------------------------- 356600 356700 SORTOUT. 356800 RETURN SORT-FILE AT END SET SORT-END TO TRUE. 356900 357000 IF NOT SORT-END PERFORM SORT-SELECT. 357100 357200 SORT-SELECT. 357300 MOVE TBI-DATE TO SDATE. 357400 MOVE TBI-TIME TO STIME. 357500 MOVE TBI-SESSION TO SSESSION. 357600 357700 MOVE SORT-RECORD TO CSB-REC. 357800 357900 IF PARM-VALUE = 62 358000 PERFORM CSB-WRITE 358100 PERFORM CHECK-CSB 358200 ELSE 358300 IF PARM-VALUE = 61 358400 PERFORM CSB-PUT. 358500 358600 CSB-PUT. 358700 PERFORM CSB-READKEY. 358800 358900 IF NOT CSB-NORMAL 359000 PERFORM CSB-PUT1 359100 ELSE 359200 IF SORT-RECORD NOT = CSB-REC 359300 PERFORM CSB-PUT2. 359400 359500 CSB-PUT1. 359600 MOVE SORT-RECORD TO CSB-REC. 359700 PERFORM CSB-WRITE. 359800 PERFORM CHECK-CSB. 359900 360000 CSB-PUT2. 360100 MOVE SORT-RECORD TO CSB-REC. 360200 PERFORM CSB-REWRITE. 360300 PERFORM CHECK-CSB. 360400 360500 CHECK-CSB. 360600 360700 IF NOT CSB-NORMAL 360800 DISPLAY CSB-FILE "." 360900 CSB-GROUP "." 361000 CSB-ACCOUNT "-" 361100 CSB-DATE "(" 361200 CSB-TIME ")=" 361300 CSB-SESSION " Not saved.". 361400 361500*------------------------------------------------------------ 361600 361700 SORT-IN SECTION. 361800 SORT-IN1. 361900 DISPLAY "File sort begins.". 362000 OPEN INPUT RFILE. 362100 362200 PERFORM PROCESS-FILES UNTIL RFILE-EOF. 362300 362400 CLOSE RFILE. 362500 362600 SET CSB-NORMAL TO TRUE. 362700 362800 OPEN I-O CSB. 362900 363000 DISPLAY " ". 363100 363200 PERFORM DISPLAY-TAPES. 363300 363400 DISPLAY " ". 363500 363600 IF TBI-SESSION NOT = SPACES 363700 MOVE TBI TO CSB-REC 363800 PERFORM CSB-WRITE 363900 IF CSB-INV 364000 PERFORM CSB-REWRITE 364100 IF CSB-INV 364200 DISPLAY " CSB record not written.". 364300 364400 MOVE TBI-TIME TO TIME2. 364500 364600 DISPLAY "Time of backup: " 364700 DATEMM "/" DATEDD "/" DATECC DATEYY 364800 "-" TIMEHH ":" TIMEMM. 364900 365000 DISPLAY "Job or Session: " TBI-SESSION. 365100 365200 DISPLAY " ". 365300 365400 DISPLAY "File sort ended.". 365500 DISPLAY " ". 365600 365700 SORT-OUT SECTION. 365800 SORT-OUT1. 365900 DISPLAY "Start of sort-return phase.". 366000 PERFORM SORTOUT UNTIL SORT-END. 366100 DISPLAY "End of sort-return phase.". 366200 366300 IF FILES1 > 0 366400 MOVE FILES1 TO DSPLY 366500 DISPLAY DSPLY " Total Files written.". 366600 366700 IF FILES4 > 0 366800 MOVE FILES4 TO DSPLY 366900 DISPLAY DSPLY " Files written.". 367000 367100 CLOSE CSB. 367200 367300 end program CSB220. 367400 367500$CONTROL SOURCE,BOUNDS,LIST,DYNAMIC 367600 IDENTIFICATION DIVISION. 367700 PROGRAM-ID. SETCTLYTRAP. 367800 AUTHOR. JOHN MOORE. 367900 DATE-WRITTEN. 368000 DATE-COMPILED. 368100* THIS PROGRAM Sets the Control-Y Trap. 368200 368300 ENVIRONMENT DIVISION. 368400 CONFIGURATION SECTION. 368500 SPECIAL-NAMES. 368600 CONDITION-CODE IS C-C. 368700 DATA DIVISION. 368800 WORKING-STORAGE SECTION. 368900 01 PROCNAME PIC X(20) VALUE "!CONTROL_Y_TRAP!". 369000 01 PLABEL PIC S9(9) COMP. 369100 01 OLDPLABEL PIC S9(9) COMP. 369200 01 PROGFILE PIC X(40). 369300 01 CTLYSET EXTERNAL PIC S9(4) COMP. 369400 369500 PROCEDURE DIVISION. 369600 010-START. 369700 CALL INTRINSIC "HPMYPROGRAM" USING PROGFILE. 369800 CALL INTRINSIC "HPGETPROCPLABEL" USING PROCNAME, 369900 PLABEL, \\, PROGFILE. 370000 CALL INTRINSIC "XCONTRAP" USING PLABEL OLDPLABEL. 370100 EXIT PROGRAM. 370200 370300 ENTRY "CONTROL_Y_TRAP". 370400 COMPUTE CTLYSET = 1. 370500 DISPLAY "ENTERED CONTROL Y". 370600 CALL INTRINSIC "RESETCONTROL". 370700 370800 end program SETCTLYTRAP.