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.