Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50534/libary.lib
There are 19 other files named libary.lib in the archive. Click here to see a list.
C2~ 7KH @C2~ 7KH [MY IM5] }M5] aJ
xl@ aJ
xlD aJ
xlH $aJ
xlL .aJ
xn 9aJ KZ` WaJ$X` _aJ% s^ aJ%{R aJ~ 7KH #aJ~) #aK)` #,aK*7 $
aK+I % aK]th &$aKMy &=aK ]` &ReC&|h &weC&|i 'zoN5] ) oNdY[P *;oN~]C4 ,joO%yr ,s
ENTER MACRO APR.
MOVE IN-NAME1 TO FM1, V-NAME.
MOVE TODAY TO P-TODAY, TOD.
( IF VALIDAT = "Y" PERFORM OPEN-VLD.
2 OPEN INPUT FORMAT-FILE.
< READ FORMAT-FILE; AT END STOP RUN.
F MOVE FORMAT-REC TO LEDFMT-RECORD.
P IF SPC NOT = "(" GO TO GET-PW.
Z MOVE 0 TO REC-TYPE.
d ENTER MACRO UNSSCR USING REC-TYPE, LEDFMT-RECORD.
n MOVE ZERO TO LINE-COUNT.
x PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = POS-KEY.
COMPUTE AC1 = LINE-COUNT / 6.
MOVE AC1 TO FIELD1.
COMPUTE AC1 = LINE-COUNT + LENGTH-OF-FIELD(POS-KEY).
COMPUTE AC1 = AC1 / 6.
* MOVE AC1 TO FIELD2.
4 IF AC1 > FIELD2 ADD 1 TO FIELD2.
> COMPUTE FIELD2 = FIELD2 - FIELD1.
H COMPUTE AC1 = NUM-CHARS / 6 - (FIELD1 + FIELD2).
R MOVE AC1 TO FIELD3.
\ ENTER MACRO INIT USING FIELD1, FIELD2, FIELD3.
f
pGET-PW.
z IF VERSION-NUMBER = VERS GO TO CHK-PW.
DISPLAY "VERSION NUMBER INCOMPATIBILITY".
DISPLAY "FORMAT FILE HAS BEEN CHANGED".
DISPLAY "RECOMPILE PROGRAM TO CORRECT THIS PROBLEM".
" STOP RUN.
,
6CHK-PW.
@ SET NUM-PAGES UP BY 1.
J ENTER MACRO NOECHO USING PRIV-IND, OPCONT-1, PRI, USER-PASSWORD.
T SET PRIV-IND TO ZERO.
^
hOPA1.
r SET PRIV-IND UP BY 1.
| IF PRIV-IND > 28 OPEN INPUT FILE-IN, GO TO ALL-DONE.
IF USER-PASSWORD = NAMES(PRIV-IND) GO TO OPCONT-1.
GO TO OPA1.
$OPCONT-1.
. OPEN INPUT FILE-IN.
8 IF GET-DATE NOT = "Y" GO TO OPA2.
B IF TOP-LINE(1) < 3 MOVE 3 TO TOP-LINE(1).
L
VOPA2.
` IF PRIV(PRIV-IND) = 3 MOVE 1 TO TOP-LINE(1).
j DISPLAY "CSS DATA BASE MANAGEMENT SYSTEM CSSDBM(V05B)".
t PERFORM A.
~ DISPLAY "LONG OR SHORT DIALOG: "; WITH NO ADVANCING.
ACCEPT DEL-RESP.
IF DEL-RESP = "S" MOVE 999 TO BLOCKING-FACTOR.
&STAR.
0 MOVE "!!!!!!!!!!" TO SAVE-01.
: MOVE SPACE TO FUN1.
D MOVE ZEROES TO FUN2.
N MOVE ZEROES TO REC-IND1.
X DISPLAY "*"; WITH NO ADVANCING.
b ACCEPT FUNCTION.
l IF FUN1 = "C" GO TO CHNG-REC.
v IF FUN1 = "D" GO TO DEL-REC.
IF FUN1 = "F" GO TO ALL-DONE.
IF FUN1 = "I" GO TO INSERT-REC.
IF FUN1 = "N" GO TO NEXT-REC.
IF FUN1 = "P" GO TO PAGE-IT.
( IF FUN1 = "S" GO TO FIND-REC.
2 IF FUN1 = "T" PERFORM DISPLAY-REC THRU DR-BREAK, GO TO STAR.
< DISPLAY "C TO CHANGE".
F DISPLAY "D TO DELETE".
P DISPLAY "F TO CLOSE OUT FILE".
Z DISPLAY "I TO INSERT".
d DISPLAY "N FOR NEXT RECORD".
n DISPLAY "P FOR NEXT PAGE".
x DISPLAY "S TO SEARCH".
DISPLAY "T TO TYPE CURRENT RECORD".
GO TO STAR.
CHNG-REC.
* IF PRIV(PRIV-IND) = 0 DISPLAY "YOU HAVE NO WRITE PRIVELEGES", GO TO STAR.
4 IF REC-KEY = SPACES DISPLAY "BUFFER EMPTY", GO TO STAR.
> MOVE REC-IN TO REC-IN1.
H IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
R SET CR-IND TO ZERO.
\ MOVE LOW-VALUES TO CR-ARRAY.
f DISPLAY "TYPE IN LINE NUMBERS YOU WISH TO CHANGE".
p DISPLAY "TERMINATE WITH A 0".
z
CR1.
SET CR-IND UP BY 1.
DISPLAY "*"; WITH NO ADVANCING.
" ACCEPT CR-BUFFER(CR-IND).
, IF CR-BUFFER(CR-IND) = ZERO GO TO CR2.
6 IF CR-BUFFER(CR-IND) < TOP-LINE(1) DISPLAY "LINES NOT AVAILABLE TO YOU"
@ ,SET CR-IND DOWN BY 1, GO TO CR1.
J IF CR-BUFFER(CR-IND) > NUMBER-FIELDS, SET CR-IND DOWN BY 1
T ,DISPLAY "THAT LINE NUMBER DOESN'T EXIST IN YOUR DATA BASE"
^ ,GO TO CR1.
h IF CR-IND > 19 GO TO CR2.
r GO TO CR1.
|
CR2.
SET CNG-FLAG TO ZERO.
PERFORM CR-NEW THRU CRN-EXIT VARYING CR-IND FROM 1 BY 1
$ ,UNTIL CR-IND > 20.
. IF CNG-FLAG = 1 GO TO STAR.
8 IF GET-DATE = "Y" PERFORM REWRIT-DATE.
B PERFORM OPEN-I-O THRU OI-1.
L MOVE REC-IN1 TO REC-IN.
V IF SPC = "Y" PERFORM WRONG.
` MOVE REC-KEY TO SYM-KEY.
j REWRITE REC-IN; INVALID KEY STOP RUN.
t PERFORM OPEN-INPUT.
~ IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
GO TO STAR.
&
0DEL-REC.
: IF PRIV(PRIV-IND) = 0 DISPLAY "YOU HAVE NO WRITE PRIVELEGES", GO TO STAR.
D DISPLAY "TYPE KEY TO BE DELETED: "; WITH NO ADVANCING.
N ACCEPT SYM-KEY.
X IF SYM-KEY = LOW-VALUES DISPLAY "NO SUCH KEY", GO TO STAR.
b PERFORM OC.
l READ FILE-IN; INVALID KEY DISPLAY "NO SUCH KEY" GO TO STAR.
v IF SPC = "Y" PERFORM RIGHT.
IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
DISPLAY "DELETE THIS RECORD ARE YOU SURE: "; WITH NO ADVANCING.
ACCEPT DEL-RESP.
IF DEL-RESP NOT = "Y" GO TO STAR.
(
2DA-1.
< SET GOOD-FLAG TO ZERO.
F OPEN I-O AUD-FILE.
P IF GOOD-FLAG = 1 GO TO DA-1.
Z MOVE REC-IN TO REC-IN1.
d SET REC-IND1 TO ZERO.
n PERFORM AUD-DEL THRU AD-EXIT VARYING PR-IND FROM 1 BY 1
x ,UNTIL PR-IND > 150.
CLOSE AUD-FILE.
PERFORM OPEN-I-O THRU OI-1.
DELETE REC-IN; INVALID KEY DISPLAY "PROGRAM E R R O R" STOP RUN.
CLOSE FILE-IN.
* OPEN INPUT FILE-IN.
4 MOVE SPACES TO REC-IN.
> GO TO STAR.
H
R
\INSERT-REC.
f IF PRIV(PRIV-IND) = 0 DISPLAY "YOU HAVE NO WRITE PRIVELEGES", GO TO STAR.
p MOVE ZERO TO LINE-COUNT, WRK-IND.
z PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = TOP-LINE(1).
MOVE LINE-COUNT TO REC-IND1.
MOVE ZERO TO LINE-COUNT.
MOVE SPACES TO REC-IN1, WORK-RECORD.
" SET PR-IND DOWN BY 1.
,
6IR-LOOP.
@ SET PR-IND UP BY 1.
J IF LENGTH-OF-FIELD(PR-IND) = ZEROES GO TO IR1.
T PERFORM SHOW-SIZE THRU SS-DIS.
^ DISPLAY CLR-Z " " PROMPT-TABLE(PR-IND) " :"; WITH NO ADVANCING.
h ACCEPT WORK-RECORD.
r IF WORK-RECORD NOT = "L" GO TO IR-CONT.
| DISPLAY "# "; WITH NO ADVANCING.
CCEPT FUN3.
F FUN3 > NUMBER-FIELDS DISPLAY "THAT LINE DOESN'T EXIST"
SET PR-IND DOWN BY 1, GO TO IR-LOOP.
F FUN3 < TOP-LINE(1) DISPLAY "LINE NOT AVAILABLE TO YOU"
SET PR-IND DOWN BY 1, GO TO IR-LOOP.
ET LINE-COUNT TO ZERO.
PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = FUN3.
MOVE LINE-COUNT TO REC-IND1.
MOVE ZERO TO LINE-COUNT.
COMPUTE PR-IND = FUN3 - 1.
VE ZERO TO FUN2, FUN3.
GO TO IR-LOOP.
IR-CONT.
IF WORK-RECORD = "F" AND PR-IND = TOP-LINE(1) GO TO STAR.
IF WORK-RECORD = "F" AND PR-IND NOT = TOP-LINE(1) GO TO IR-WRITE.
& IF PR-IND NOT = I GO TO IR1.
0 MOVE WORK-RECORD TO REC-CHECK.
: MOVE REC-NUM TO SYM-KEY.
D PERFORM OC.
N READ FILE-IN; INVALID KEY GO TO IR1.
X IF SPC = "Y" PERFORM RIGHT.
b DISPLAY SYM-KEY " ALREADY EXISTS", GO TO STAR.
l
vIR1.
IF WORK-RECORD = "F" GO TO IR-WRITE.
IF LENGTH-OF-FIELD(PR-IND) = ZEROES GO TO IR-WRITE.
IF VALIDAT NOT = "Y" GO TO IR1-CONT.
PERFORM VALID-CHK THRU VC-EXIT.
( IF VLD-FLAG = ZERO GO TO IR1-CONT.
2 IF WORK-RECORD = SAVE-01 GO TO IR1-CONT.
< MOVE WORK-RECORD TO SAVE-01.
F SET PR-IND DOWN BY 1, GO TO IR-LOOP.
P
ZIR1-CONT.
d PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
n MOVE SPACES TO WORK-RECORD.
x SET WRK-IND TO ZERO.
GO TO IR-LOOP.
IR-WRITE.
IF GET-DATE = "Y" PERFORM WT-DATE THRU REWRIT-DATE.
* MOVE REC-IN1 TO REC-IN.
4 IF REC-KEY = SPACES DISPLAY "NO KEY" GO TO STAR.
> CLOSE FILE-IN.
H
RIW-1.
\ SET GOOD-FLAG TO ZERO.
f OPEN I-O FILE-IN.
p IF GOOD-FLAG = 1 GO TO IW-1.
z MOVE REC-IN1 TO REC-IN.
MOVE REC-KEY TO SYM-KEY.
IF SPC = "Y" PERFORM WRONG.
WRITE REC-IN; INVALID KEY DISPLAY "THAT RECORD IS ALREADY IN THIS FILE."
" ,PERFORM OPEN-INPUT, GO TO STAR.
,
6IA-1.
@ SET GOOD-FLAG TO ZERO.
J OPEN I-O AUD-FILE.
T IF GOOD-FLAG = 1 GO TO IA-1.
^ MOVE SPACES TO AUD-REC.
h SET REC-IND1 TO ZERO.
r PERFORM AUD-INS THRU AI-EXIT VARYING PR-IND FROM 1 BY 1
| ,UNTIL PR-IND > 150.
CLOSE AUD-FILE.
PERFORM OPEN-INPUT.
IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
$ GO TO INSERT-REC.
.
8NEXT-REC.
B MOVE ZERO TO LINE-COUNT, FLAG1.
L MOVE FUN2 TO FUN3.
V IF FUN3 = ZERO MOVE 1 TO FUN3.
` MOVE LOW-VALUES TO SYM-KEY.
j PERFORM NR THRU NR-EXIT.
t IF FLAG1 = 1, SET FLAG1 TO ZERO GO TO STAR.
~ IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
GO TO STAR.
NR.
& READ FILE-IN; INVALID KEY GO TO NR-BAD.
0 IF SPC = "Y" PERFORM RIGHT.
: SET LINE-COUNT UP BY 1.
D IF LINE-COUNT = FUN3 GO TO NR-EXIT.
N GO TO NR.
X
bNR-BAD.
l DISPLAY "END OF FILE".
v SET FLAG1 TO 1.
NR-EXIT. EXIT.
(PAGE-IT.
2 MOVE REC-IN TO REC-IN1.
< IF FUN2 NOT = LOW-VALUES MOVE FUN2 TO FUN3.
F IF FUN3 < 2 SET FUN3 TO 1.
P IF FUN3 > NUM-PAGES SET TP-IND TO 1, PERFORM DISPLAY-REC THRU
Z DR-BREAK, GO TO STAR.
d MOVE ZERO TO LINE-COUNT.
n PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL
x ;PR-IND = TOP-LINE(FUN3) OR TOP-LINE(FUN3) = ZERO.
COMPUTE TP-IND = FUN3 + 1.
MOVE LINE-COUNT TO REC-IND1.
SET LINE-COUNT TO ZERO.
PERFORM DR1 THRU DR-BREAK.
* GO TO STAR.
4
>
HFIND-REC.
R DISPLAY "TYPE IN THE KEY YOU ARE SEARCHING FOR: "; WITH NO ADVANCING.
\ ACCEPT SYM-KEY.
f PERFORM OC.
p READ FILE-IN; INVALID KEY DISPLAY "NO SUCH KEY" GO TO STAR.
z IF SPC = "Y" PERFORM RIGHT.
IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
GO TO STAR.
"
,ALL-DONE.
6 CLOSE FILE-IN.
@ ENTER MACRO EXIT1.
J
T
^OPEN-VLD.
h OPEN INPUT VLD-FILE.
r READ VLD-FILE; AT END STOP RUN.
|
VALID-CHK.
MOVE REC-IND1 TO VLD-IND.
MOVE ZERO TO VLD-FLAG.
$ PERFORM CHECK-VLD THRU CV-DONE VARYING WRK-IND FROM 1 BY 1
. ,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
8 IF VLD-FLAG = ZERO GO TO VC-EXIT.
B MOVE WORK-RECORD TO REC-CHECK.
L MOVE SPACES TO WORK-RECORD.
V PERFORM SHOW-SIZE THRU SS-DIS.
` DISPLAY CLR-Z " " PROMPT-TABLE(PR-IND) " :" REC-CHECK.
j MOVE SPACES TO ARROW-REGISTER.
t MOVE REC-CHECK TO WORK-RECORD.
~ MOVE ZERO TO WRK-IND.
MOVE REC-IND1 TO VLD-IND.
PERFORM ARROW-SETUP VARYING WRK-IND FROM 1 BY 1 UNTIL
,WRK-IND > LENGTH-OF-FIELD(PR-IND).
& DISPLAY Y ARROW-REGISTER.
0 SET VLD-FLAG TO 1.
:
DVC-EXIT. EXIT.
N
XARROW-SETUP.
b SET VLD-FLAG TO ZERO.
l PERFORM CHECK-VLD THRU CV-DONE.
v IF VLD-FLAG = 1 MOVE "^" TO ARROW-BUFF(WRK-IND).
CHECK-VLD.
SET VLD-IND UP BY 1.
IF VLD-CHR(VLD-IND) = "X" GO TO CV-DONE.
( IF VLD-CHR(VLD-IND) = "A" PERFORM SEE-ALPHA, GO TO CV-DONE.
2 IF VLD-CHR(VLD-IND) = "N" PERFORM SEE-NUMERIC THRU SN-EXIT, GO TO CV-DONE.
< IF WR1(WRK-IND) = SPACE GO TO CV-DONE.
F IF WR1(WRK-IND) NOT = VLD-CHR(VLD-IND) SET VLD-FLAG TO 1.
P
ZCV-DONE. EXIT.
d
nSEE-ALPHA.
x IF WR1(WRK-IND) NOT ALPHABETIC SET VLD-FLAG TO 1.
SEE-NUMERIC.
IF WR1(WRK-IND) IS NUMERIC GO TO SN-EXIT.
IF WR1(WRK-IND) = SPACE GO TO SN-EXIT.
* IF WR1(WRK-IND) = "-" GO TO SN-EXIT.
4 SET VLD-FLAG TO 1.
>
HSN-EXIT. EXIT.
R
\DISPLAY-REC.
f MOVE REC-IN TO REC-IN1.
p MOVE ZERO TO PR-IND, REC-IND1, WRK-IND.
z SET TP-IND TO 2.
MOVE ZERO TO LINE-COUNT.
PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = TOP-LINE(1).
MOVE LINE-COUNT TO REC-IND1.
" MOVE ZERO TO LINE-COUNT.
, MOVE TOP-LINE(1) TO PR-IND.
6 GO TO DR2.
@
JDR-LOOP.
T SET PR-IND UP BY 1.
^DR1.
h IF TP-IND < 2 GO TO DISPLAY-REC.
r IF TP-IND > NUM-PAGES GO TO DISPLAY-REC.
| IF LENGTH-OF-FIELD(PR-IND) = ZEROES GO TO DR1A.
IF PROMPT-TABLE(PR-IND) = "STOP" GO TO DR1A.
IF PR-IND = TOP-LINE(TP-IND) GO TO DR1A.
GO TO DR2.
$
.DR1A.
8 COMPUTE LINE-COUNT = TERM-LINES - LINE-COUNT.
B IF BLOCKING-FACTOR NOT = 999, PERFORM A LINE-COUNT TIMES.
L SET LINE-COUNT TO ZERO.
V GO TO DR-BREAK.
`
jDR2.
t MOVE SPACES TO WORK-RECORD.
~ PERFORM DR-MOVE VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
MOVE PR-IND TO CLR-Z.
MOVE CLR-Z TO LINE-NUM.
MOVE PROMPT-TABLE(PR-IND) TO PROMPT OF DISPLAY-LINE.
& MOVE " :" TO DL-COLON.
0 MOVE WORK-RECORD TO DL-INFO.
: DISPLAY DISPLAY-LINE.
D SET LINE-COUNT UP BY 1.
N GO TO DR-LOOP.
X
bDR-BREAK. EXIT.
l
vCR-NEW.
IF CR-BUFFER(CR-IND) = ZERO GO TO CRN-EXIT.
MOVE SPACES TO WORK-RECORD.
MOVE ZERO TO REC-IND1.
PERFORM CR-NEXT VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = CR-BUFFER(CR-IND).
( PERFORM DR-MOVE VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
2 MOVE WORK-RECORD TO AUD-HOLD.
< MOVE ":" TO WR1(WRK-IND).
F MOVE PR-IND TO CLR-Z.
P DISPLAY CLR-Z " " PROMPT-TABLE(PR-IND) " :" WORK-RECORD.
Z DISPLAY CLR-Z X " :"; WITH NO ADVANCING.
d ACCEPT WORK-RECORD.
n MOVE ZERO TO REC-IND1.
x PERFORM CR-NEXT VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = CR-BUFFER(CR-IND).
MOVE CR-BUFFER(CR-IND) TO PR-IND.
IF VALIDAT NOT = "Y" GO TO CR-NEW-1.
PERFORM VALID-CHK THRU VC-EXIT.
IF VLD-FLAG = ZERO GO TO CR-NEW-1.
* IF WORK-RECORD = SAVE-01 GO TO CR-NEW-1.
4 MOVE WORK-RECORD TO SAVE-01.
> GO TO CR-NEW.
H
RCR-NEW-1.
\ SET GOOD-FLAG TO ZERO.
f OPEN I-O AUD-FILE.
p IF GOOD-FLAG = 1 GO TO CR-NEW-1.
z MOVE 1 TO AUD-DIG.
MOVE AUD-HOLD TO AUD-OLD.
MOVE PR-IND TO AD-2.
MOVE WORK-RECORD TO AUD-NEW.
" MOVE PR-IND TO AUD-FNUM.
, MOVE PROMPT-TABLE(PR-IND) TO AUD-FNAME.
6 PERFORM AUD-OC.
@ CLOSE AUD-FILE.
J PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
T IF PR-IND NOT = I GO TO CRN-EXIT.
^ IF WORK-RECORD = SPACES DISPLAY "NULL KEY FIELD", SET CR-IND DOWN BY 1
h ,GO TO CRN-EXIT.
r MOVE REC-KEY TO SAVE-01.
| MOVE REC-IN1 TO REC-IN.
! MOVE REC-KEY TO SYM-KEY.
! READ FILE-IN; INVALID KEY GO TO CKEY-OK.
! IF SPC = "Y" PERFORM RIGHT.
!$ PERFORM A.
!. DISPLAY "A RECORD WITH THAT KEY ALREADY EXISTS".
!8 DISPLAY "TYPE T TO VIEW IT".
!B PERFORM A.
!L SET CNG-FLAG TO 1.
!V SET CR-IND TO 21.
!` GO TO CRN-EXIT.
!j
!tCKEY-OK.
!~ CLOSE FILE-IN.
"
"CO-1.
" SET GOOD-FLAG TO ZERO.
"& OPEN I-O FILE-IN.
"0 IF GOOD-FLAG = 1 GO TO CO-1.
": PERFORM SAVE-KEY.
"D MOVE SYM-KEY TO SAVE-01.
"N MOVE REC-IN1 TO REC-IN.
"X MOVE REC-KEY TO SYM-KEY.
"b DELETE REC-IN; INVALID KEY DISPLAY "DELETE ERROR", STOP RUN.
"l PERFORM SAVE-KEY.
"v MOVE REC-IN1 TO REC-IN.
# MOVE REC-KEY TO SYM-KEY.
#
IF SPC = "Y" PERFORM WRONG.
# WRITE REC-IN INVALID KEY DISPLAY "WRITE ERROR", STOP RUN.
# PERFORM OPEN-INPUT.
#(
#2CRN-EXIT. EXIT.
#<
#F
#P
#ZDR-MOVE.
#d SET REC-IND1 UP BY 1.
#n MOVE RI1(REC-IND1) TO WR1(WRK-IND).
#x
$
$
MOVE-REC.
$ SET REC-IND1 UP BY 1.
$ MOVE WR1(WRK-IND) TO RI1(REC-IND1).
$*
$4
$>A.
$H DISPLAY " ".
$R
$\TOTAL-UP.
$f COMPUTE LINE-COUNT = LINE-COUNT + LENGTH-OF-FIELD(PR-IND).
$p
$z
%CR-NEXT.
% COMPUTE REC-IND1 = REC-IND1 + LENGTH-OF-FIELD(PR-IND).
%
%"SHOW-SIZE.
%, IF VALIDAT = "N" GO TO SSNV.
%6 MOVE PR-IND TO VL1-IND.
%@ MOVE ZERO TO LINE-COUNT.
%J PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1
%T ,UNTIL PR-IND = VL1-IND.
%^ MOVE ZERO TO WRK-IND.
%h MOVE SPACES TO WORK-RECORD.
%r COMPUTE AR-IND = LINE-COUNT + 1.
%| PERFORM GET-VLD VARYING AR-IND FROM AR-IND BY 1
& ,UNTIL WRK-IND = LENGTH-OF-FIELD(PR-IND).
& COMPUTE LINE-COUNT = WRK-IND + 1.
& GO TO SS-DIS.
&$
&.SSNV.
&8 PERFORM NUL-FIELD VARYING LINE-COUNT FROM 1 BY 1 UNTIL, LINE-COUNT > LENGTH-OF-FIELD(PR-IND).
&B
&LSS-DIS.
&V MOVE PR-IND TO CLR-Z.
&` MOVE ":" TO WR1(LINE-COUNT).
&j DISPLAY CLR-Z X " :" WORK-RECORD.
&t MOVE SPACES TO WORK-RECORD.
&~
'NUL-FIELD.
' MOVE "-" TO WR1(LINE-COUNT).
' GET-VLD.
'& SET WRK-IND UP BY 1.
'0 MOVE VLD-CHR(AR-IND) TO WR1(WRK-IND).
':
'DWT-DATE.
'N MOVE P-DATE TO WORK-RECORD.
'X SET PR-IND TO 1.
'b MOVE ZERO TO REC-IND1.
'l PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1
'v ,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
(
(
REWRIT-DATE.
( MOVE P-DATE TO WORK-RECORD.
( MOVE LENGTH-OF-FIELD(1) TO REC-IND1.
(( SET PR-IND TO 2.
(2 PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1
(< ,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
(F
(POPEN-I-O.
(Z CLOSE FILE-IN.
(d
(nOI-1.
(x SET GOOD-FLAG TO ZERO.
) OPEN I-O FILE-IN.
)
IF GOOD-FLAG = 1 GO TO OI-1.
) READ FILE-IN; INVALID KEY DISPLAY "PROGRAM E R R O R", STOP RUN.
) IF SPC = "Y" PERFORM RIGHT.
)*
)4OPEN-INPUT.
)> CLOSE FILE-IN.
)H OPEN INPUT FILE-IN.
)R READ FILE-IN; INVALID KEY DISPLAY "PROGRAM E R R O R", STOP RUN.
)\ IF SPC = "Y" PERFORM RIGHT.
)f
)pOC.
)z CLOSE FILE-IN.
* OPEN INPUT FILE-IN.
*
*AUD-DEL.
*" IF LENGTH-OF-FIELD(PR-IND) = ZERO GO TO AD-EXIT.
*, MOVE SPACES TO WORK-RECORD.
*6 PERFORM DR-MOVE VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
*@ IF WORK-RECORD = SPACES GO TO AD-EXIT.
*J MOVE "@RECORD DELETED" TO AUD-NEW.
*T MOVE 2 TO AUD-DIG.
*^ MOVE PR-IND TO AUD-FNUM, AD-2.
*h MOVE PROMPT-TABLE(PR-IND) TO AUD-FNAME.
*r MOVE WORK-RECORD TO AUD-OLD.
*| PERFORM AUD-OC.
+
+AD-EXIT. EXIT.
+
+$AUD-INS.
+. IF LENGTH-OF-FIELD(PR-IND) = ZERO GO TO AI-EXIT.
+8 MOVE SPACES TO WORK-RECORD.
+B PERFORM DR-MOVE VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
+L IF WORK-RECORD = SPACES GO TO AI-EXIT.
+V MOVE WORK-RECORD TO AUD-NEW.
+` MOVE "@RECORD INSERTED" TO AUD-OLD.
+j MOVE ZERO TO AUD-DIG.
+t MOVE PR-IND TO AUD-FNUM, AD-2.
+~ MOVE PROMPT-TABLE(PR-IND) TO AUD-FNAME.
, PERFORM AUD-OC.
,
, AI-EXIT. EXIT.
,&
,0AUD-OC.
,: MOVE NAMES(PRIV-IND) TO AUD-CODE.
,D MOVE REC-KEY TO AUD-KEY.
,N MOVE TODAY TO AD-1.
,X MOVE AUD-DATE TO AUD-SKEY.
,b IF SPC = "Y" MOVE 2 TO REC-TYPE, ENTER MACRO SCRREC USING REC-TYPE, AUD-REC.
,l WRITE AUD-REC; INVALID KEY DISPLAY "AUDIT FILE WRITE ERROR", STOP RUN.
,v
- SAVE-KEY.
-
MOVE SAVE-01 TO WORK-RECORD.
- MOVE ZERO TO REC-IND1.
- PERFORM CR-NEXT VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = I.
-( PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(I).
-2
-<WRONG.
-F MOVE 1 TO REC-TYPE.
-P ENTER MACRO SCRREC USING REC-TYPE, REC-IN.
-Z
-dRIGHT.
-n MOVE 1 TO REC-TYPE.
-x ENTER MACRO UNSSCR USING REC-TYPE, REC-IN.
.
RECORD CONTAINS 141 CHARACTERS
BLOCK CONTAINS 35 RECORDS
VALUE OF IDENTIFICATION IS "DBMAUDIDX".
(
201 AUD-REC.
< 02 AUD-DATE.
F 03 AD-1 PIC X(12).
P 03 AD-2 PIC X(3).
Z 02 AUD-DIG PIC 9.
d 02 AUD-CODE PIC X(6).
n 02 AUD-KEY PIC X(32).
x 02 AUD-FNUM PIC 9(3).
02 AUD-FNAME PIC X(20).
02 AUD-OLD PIC X(32).
02 AUD-NEW PIC X(32).
VALUE OF IDENTIFICATION IS FORMAT-NAME.
01 FORMAT-REC PIC X(4035); DISPLAY-6.
VALUE OF IDENTIFICATION IS FORMAT-NAME
IF PRIV(PROMPT-IND) < 0 DISPLAY "NO PRIVILEGES TO RUN THIS PROGRAM"
,STOP RUN.
IF PRIV(PROMPT-IND) < 1 DISPLAY "NO PRIVILEGES TO RUN THIS PROGRAM"
,STOP RUN.
IF PRIV(PROMPT-IND) < 2 DISPLAY "NO PRIVILEGES TO RUN THIS PROGRAM"
,STOP RUN.
IF PRIV(PROMPT-IND) NOT = 3 DISPLAY "NO PRIVILEGES TO RUN THIS PROGRAM"
,STOP RUN.
ENTER MACRO APR.
MOVE FIN TO F-NAME.
OPEN INPUT FORMAT-FILE.
( READ FORMAT-FILE; AT END STOP RUN.
2 MOVE FORMAT-REC TO LEDFMT-RECORD.
< IF SPC NOT = "(" GO TO GET-PW.
F MOVE 0 TO REC-TYPE.
P ENTER MACRO UNSSCR USING REC-TYPE, LEDFMT-RECORD.
Z MOVE ZERO TO LINE-COUNT.
d PERFORM TOT-UP VARYING PROMPT-IND FROM 1 BY 1 UNTIL PROMPT-IND = POS-KEY.
n COMPUTE AC1 = LINE-COUNT / 6.
x MOVE AC1 TO FIELD1.
COMPUTE AC1 = LINE-COUNT + LENGTH-OF-FIELD(POS-KEY).
COMPUTE AC1 = AC1 / 6.
MOVE AC1 TO FIELD2.
IF AC1 > FIELD2 ADD 1 TO FIELD2.
* COMPUTE FIELD2 = FIELD2 - FIELD1.
4 COMPUTE AC1 = NUM-CHARS / 6 - (FIELD1 + FIELD2).
> MOVE AC1 TO FIELD3.
H ENTER MACRO INIT USING FIELD1, FIELD2, FIELD3.
R
\GET-PW.
f IF VERS-NUM NOT = VERSION-NUMBER
p ,DISPLAY "VERSION NUMBER INCONSISTANCY REGENERATE PROGRAM", STOP RUN.
z ENTER MACRO NOECHO USING PROMPT-IND, BREAK1, PRI, USER-PASSWORD.
SET PROMPT-IND TO ZERO.
LOOP1.
" SET PROMPT-IND UP BY 1.
, IF PROMPT-IND > 28 GO TO BREAK1.
6 IF USER-PASSWORD = NAMES(PROMPT-IND) GO TO BREAK1.
@ GO TO LOOP1.
J
TBREAK1.
^ IF PROMPT-IND > 28 DISPLAY "CANNOT ACCESS THIS DATA", STOP RUN.
h DISPLAY " ".
r GO TO PRIV-CHK.
|
TOT-UP.
COMPUTE LINE-COUNT = LINE-COUNT + LENGTH-OF-FIELD(PROMPT-IND).
OPEN INPUT FILE-OUT.
CLOSE FILE-OUT WITH DELETE.
MOVE ERRNUM TO TST-ERR.
IF CD-001 = 3 GO TO DEC-CON1.
IF CD-001 = 4 GO TO DEC-CON1.
( IF CD-001 = 5 GO TO DEC-CON1.
2 IF CD-001 = 7 GO TO DEC-CON1.
< GO TO HRD-ERR.
F
PDEC-CON1.
Z IF HIJ = 3 MOVE 1 TO GOOD-FLAG, ACTCODE.
d
nHRD-ERR.
x EXIT.
END DECLARATIVES.
DISPLAY "TYPE <CR> TO BEGIN PURGE ^C TO EXIT: "; WITH NO ADVANCING.
ACCEPT WORK-RECORD.
OPEN I-O FILE-IN, FILE-OUT.
( MOVE ZERO TO IN-CNT, ELG-CNT, PRG-CNT.
2 MOVE LOW-VALUES TO ISKEY.
CLOSE FILE-IN, FILE-OUT.
STOP RUN.
ENTER MACRO APR.
MOVE IN-NAME1 TO FM1, V-NAME.
MOVE TODAY TO P-TODAY, TOD.
( IF VALIDAT = "Y" PERFORM OPEN-VLD.
2 OPEN INPUT FORMAT-FILE.
< READ FORMAT-FILE; AT END STOP RUN.
F MOVE FORMAT-REC TO LEDFMT-RECORD.
P IF SPC NOT = "(" GO TO GET-PW.
Z MOVE 0 TO REC-TYPE.
d ENTER MACRO UNSSCR USING REC-TYPE, LEDFMT-RECORD.
n MOVE ZERO TO LINE-COUNT.
x PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = POS-KEY.
COMPUTE AC1 = LINE-COUNT / 6.
MOVE AC1 TO FIELD1.
COMPUTE AC1 = LINE-COUNT + LENGTH-OF-FIELD(POS-KEY).
COMPUTE AC1 = AC1 / 6.
* MOVE AC1 TO FIELD2.
4 IF AC1 > FIELD2 ADD 1 TO FIELD2.
> COMPUTE FIELD2 = FIELD2 - FIELD1.
H COMPUTE AC1 = NUM-CHARS / 6 - (FIELD1 + FIELD2).
R MOVE AC1 TO FIELD3.
\ ENTER MACRO INIT USING FIELD1, FIELD2, FIELD3.
f
pGET-PW.
z IF VERSION-NUMBER = VERS GO TO CHK-PW.
DISPLAY "VERSION NUMBER INCOMPATIBILITY".
DISPLAY "FORMAT FILE HAS BEEN CHANGED".
DISPLAY "RECOMPILE PROGRAM TO CORRECT THIS PROBLEM".
" STOP RUN.
,
6CHK-PW.
@ SET NUM-PAGES UP BY 1.
J ENTER MACRO NOECHO USING PRIV-IND, OPCONT-1, PRI, USER-PASSWORD.
T SET PRIV-IND TO ZERO.
^
hOPA1.
r SET PRIV-IND UP BY 1.
| IF PRIV-IND > 28 OPEN INPUT FILE-IN, GO TO ALL-DONE.
IF USER-PASSWORD = NAMES(PRIV-IND) GO TO OPCONT-1.
GO TO OPA1.
$OPCONT-1.
. OPEN INPUT FILE-IN.
8 IF GET-DATE NOT = "Y" GO TO OPA2.
B IF TOP-LINE(1) < 3 MOVE 3 TO TOP-LINE(1).
L
VOPA2.
` IF PRIV(PRIV-IND) = 3 MOVE 1 TO TOP-LINE(1).
j DISPLAY "CSS DATA BASE MANAGEMENT SYSTEM CSSDBM(V05B)".
t PERFORM A.
~ DISPLAY "LONG OR SHORT DIALOG: "; WITH NO ADVANCING.
ACCEPT DEL-RESP.
IF DEL-RESP = "S" MOVE 999 TO BLOCKING-FACTOR.
&STAR.
0 MOVE "!!!!!!!!!!" TO SAVE-01.
: MOVE SPACE TO FUN1.
D MOVE ZEROES TO FUN2.
N MOVE ZEROES TO REC-IND1.
X DISPLAY "*"; WITH NO ADVANCING.
b ACCEPT FUNCTION.
l IF FUN1 = "C" GO TO CHNG-REC.
v IF FUN1 = "D" GO TO DEL-REC.
IF FUN1 = "F" GO TO ALL-DONE.
IF FUN1 = "I" GO TO INSERT-REC.
IF FUN1 = "N" GO TO NEXT-REC.
IF FUN1 = "P" GO TO PAGE-IT.
( IF FUN1 = "S" GO TO FIND-REC.
2 IF FUN1 = "T" PERFORM DISPLAY-REC THRU DR-BREAK, GO TO STAR.
< DISPLAY "C TO CHANGE".
F DISPLAY "D TO DELETE".
P DISPLAY "F TO CLOSE OUT FILE".
Z DISPLAY "I TO INSERT".
d DISPLAY "N FOR NEXT RECORD".
n DISPLAY "P FOR NEXT PAGE".
x DISPLAY "S TO SEARCH".
DISPLAY "T TO TYPE CURRENT RECORD".
GO TO STAR.
CHNG-REC.
* IF PRIV(PRIV-IND) = 0 DISPLAY "YOU HAVE NO WRITE PRIVELEGES", GO TO STAR.
4 IF REC-KEY = SPACES DISPLAY "BUFFER EMPTY", GO TO STAR.
> MOVE REC-IN TO REC-IN1.
H IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
R SET CR-IND TO ZERO.
\ MOVE LOW-VALUES TO CR-ARRAY.
f DISPLAY "TYPE IN LINE NUMBERS YOU WISH TO CHANGE".
p DISPLAY "TERMINATE WITH A 0".
z
CR1.
SET CR-IND UP BY 1.
DISPLAY "*"; WITH NO ADVANCING.
" ACCEPT CR-BUFFER(CR-IND).
, IF CR-BUFFER(CR-IND) = ZERO GO TO CR2.
6 IF CR-BUFFER(CR-IND) < TOP-LINE(1) DISPLAY "LINES NOT AVAILABLE TO YOU"
@ ,SET CR-IND DOWN BY 1, GO TO CR1.
J IF CR-BUFFER(CR-IND) > NUMBER-FIELDS, SET CR-IND DOWN BY 1
T ,DISPLAY "THAT LINE NUMBER DOESN'T EXIST IN YOUR DATA BASE"
^ ,GO TO CR1.
h IF CR-IND > 19 GO TO CR2.
r GO TO CR1.
|
CR2.
SET CNG-FLAG TO ZERO.
PERFORM CR-NEW THRU CRN-EXIT VARYING CR-IND FROM 1 BY 1
$ ,UNTIL CR-IND > 20.
. IF CNG-FLAG = 1 GO TO STAR.
8 IF GET-DATE = "Y" PERFORM REWRIT-DATE.
B PERFORM OPEN-I-O THRU OI-1.
L MOVE REC-IN1 TO REC-IN.
V IF SPC = "Y" PERFORM WRONG.
` MOVE REC-KEY TO SYM-KEY.
j REWRITE REC-IN; INVALID KEY STOP RUN.
t PERFORM OPEN-INPUT.
~ IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
GO TO STAR.
&
0DEL-REC.
: IF PRIV(PRIV-IND) = 0 DISPLAY "YOU HAVE NO WRITE PRIVELEGES", GO TO STAR.
D DISPLAY "TYPE KEY TO BE DELETED: "; WITH NO ADVANCING.
N ACCEPT SYM-KEY.
X IF SYM-KEY = LOW-VALUES DISPLAY "NO SUCH KEY", GO TO STAR.
b PERFORM OC.
l READ FILE-IN; INVALID KEY DISPLAY "NO SUCH KEY" GO TO STAR.
v IF SPC = "Y" PERFORM RIGHT.
IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
DISPLAY "DELETE THIS RECORD ARE YOU SURE: "; WITH NO ADVANCING.
ACCEPT DEL-RESP.
IF DEL-RESP NOT = "Y" GO TO STAR.
( PERFORM OPEN-I-O THRU OI-1.
2 DELETE REC-IN; INVALID KEY DISPLAY "PROGRAM E R R O R" STOP RUN.
< CLOSE FILE-IN.
F OPEN INPUT FILE-IN.
P MOVE SPACES TO REC-IN.
Z GO TO STAR.
d
n
xINSERT-REC.
IF PRIV(PRIV-IND) = 0 DISPLAY "YOU HAVE NO WRITE PRIVELEGES", GO TO STAR.
MOVE ZERO TO LINE-COUNT, WRK-IND.
PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = TOP-LINE(1).
MOVE LINE-COUNT TO REC-IND1.
* MOVE ZERO TO LINE-COUNT.
4 MOVE SPACES TO REC-IN1, WORK-RECORD.
> SET PR-IND DOWN BY 1.
H
RIR-LOOP.
\ SET PR-IND UP BY 1.
f IF LENGTH-OF-FIELD(PR-IND) = ZEROES GO TO IR1.
p PERFORM SHOW-SIZE THRU SS-DIS.
z DISPLAY CLR-Z " " PROMPT-TABLE(PR-IND) " :"; WITH NO ADVANCING.
ACCEPT WORK-RECORD.
IF WORK-RECORD NOT = "L" GO TO IR-CONT.
DISPLAY "# "; WITH NO ADVANCING.
" ACCEPT FUN3.
, IF FUN3 > NUMBER-FIELDS DISPLAY "THAT LINE DOESN'T EXIST"
6 ,SET PR-IND DOWN BY 1, GO TO IR-LOOP.
@ IF FUN3 < TOP-LINE(1) DISPLAY "LINE NOT AVAILABLE TO YOU"
J ,SET PR-IND DOWN BY 1, GO TO IR-LOOP.
T SET LINE-COUNT TO ZERO.
^ PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = FUN3.
h MOVE LINE-COUNT TO REC-IND1.
r MOVE ZERO TO LINE-COUNT.
| COMPUTE PR-IND = FUN3 - 1.
VE ZERO TO FUN2, FUN3.
GO TO IR-LOOP.
T.
IF WORK-RECORD = "F" AND PR-IND = TOP-LINE(1) GO TO STAR.
F WORK-RECORD = "F" AND PR-IND NOT = TOP-LINE(1) GO TO IR-WRITE.
IF PR-IND NOT = I GO TO IR1.
MOVE WORK-RECORD TO REC-CHECK.
MOVE REC-NUM TO SYM-KEY.
PERFORM OC.
AD FILE-IN; INVALID KEY GO TO IR1.
SPC = "Y" PERFORM RIGHT.
ISPLAY SYM-KEY " ALREADY EXISTS", GO TO STAR.
IR1.
IF WORK-RECORD = "F" GO TO IR-WRITE.
& IF LENGTH-OF-FIELD(PR-IND) = ZEROES GO TO IR-WRITE.
0 IF VALIDAT NOT = "Y" GO TO IR1-CONT.
: PERFORM VALID-CHK THRU VC-EXIT.
D IF VLD-FLAG = ZERO GO TO IR1-CONT.
N IF WORK-RECORD = SAVE-01 GO TO IR1-CONT.
X MOVE WORK-RECORD TO SAVE-01.
b SET PR-IND DOWN BY 1, GO TO IR-LOOP.
l
vIR1-CONT.
PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
MOVE SPACES TO WORK-RECORD.
SET WRK-IND TO ZERO.
GO TO IR-LOOP.
(
2IR-WRITE.
< IF GET-DATE = "Y" PERFORM WT-DATE THRU REWRIT-DATE.
F MOVE REC-IN1 TO REC-IN.
P IF REC-KEY = SPACES DISPLAY "NO KEY" GO TO STAR.
Z CLOSE FILE-IN.
d
nIW-1.
x SET GOOD-FLAG TO ZERO.
OPEN I-O FILE-IN.
IF GOOD-FLAG = 1 GO TO IW-1.
MOVE REC-IN1 TO REC-IN.
MOVE REC-KEY TO SYM-KEY.
* IF SPC = "Y" PERFORM WRONG.
4 WRITE REC-IN; INVALID KEY DISPLAY "THAT RECORD IS ALREADY IN THIS FILE."
> ,PERFORM OPEN-INPUT, GO TO STAR.
H PERFORM OPEN-INPUT.
R IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
\ GO TO INSERT-REC.
f
pNEXT-REC.
z MOVE ZERO TO LINE-COUNT, FLAG1.
MOVE FUN2 TO FUN3.
IF FUN3 = ZERO MOVE 1 TO FUN3.
MOVE LOW-VALUES TO SYM-KEY.
" PERFORM NR THRU NR-EXIT.
, IF FLAG1 = 1, SET FLAG1 TO ZERO GO TO STAR.
6 IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
@ GO TO STAR.
J
TNR.
^ READ FILE-IN; INVALID KEY GO TO NR-BAD.
h IF SPC = "Y" PERFORM RIGHT.
r SET LINE-COUNT UP BY 1.
| IF LINE-COUNT = FUN3 GO TO NR-EXIT.
GO TO NR.
NR-BAD.
$ DISPLAY "END OF FILE".
. SET FLAG1 TO 1.
8
BNR-EXIT. EXIT.
L
V
`PAGE-IT.
j MOVE REC-IN TO REC-IN1.
t IF FUN2 NOT = LOW-VALUES MOVE FUN2 TO FUN3.
~ IF FUN3 < 2 SET FUN3 TO 1.
IF FUN3 > NUM-PAGES SET TP-IND TO 1, PERFORM DISPLAY-REC THRU
DR-BREAK, GO TO STAR.
MOVE ZERO TO LINE-COUNT.
& PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL
0 ;PR-IND = TOP-LINE(FUN3) OR TOP-LINE(FUN3) = ZERO.
: COMPUTE TP-IND = FUN3 + 1.
D MOVE LINE-COUNT TO REC-IND1.
N SET LINE-COUNT TO ZERO.
X PERFORM DR1 THRU DR-BREAK.
b GO TO STAR.
l
v
FIND-REC.
DISPLAY "TYPE IN THE KEY YOU ARE SEARCHING FOR: "; WITH NO ADVANCING.
ACCEPT SYM-KEY.
PERFORM OC.
( READ FILE-IN; INVALID KEY DISPLAY "NO SUCH KEY" GO TO STAR.
2 IF SPC = "Y" PERFORM RIGHT.
< IF BLOCKING-FACTOR NOT = 999 PERFORM DISPLAY-REC THRU DR-BREAK.
F GO TO STAR.
P
Z
dALL-DONE.
n CLOSE FILE-IN.
x ENTER MACRO EXIT1.
OPEN-VLD.
OPEN INPUT VLD-FILE.
* READ VLD-FILE; AT END STOP RUN.
4
>VALID-CHK.
H MOVE REC-IND1 TO VLD-IND.
R MOVE ZERO TO VLD-FLAG.
\ PERFORM CHECK-VLD THRU CV-DONE VARYING WRK-IND FROM 1 BY 1
f ,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
p IF VLD-FLAG = ZERO GO TO VC-EXIT.
z MOVE WORK-RECORD TO REC-CHECK.
MOVE SPACES TO WORK-RECORD.
PERFORM SHOW-SIZE THRU SS-DIS.
DISPLAY CLR-Z " " PROMPT-TABLE(PR-IND) " :" REC-CHECK.
" MOVE SPACES TO ARROW-REGISTER.
, MOVE REC-CHECK TO WORK-RECORD.
6 MOVE ZERO TO WRK-IND.
@ MOVE REC-IND1 TO VLD-IND.
J PERFORM ARROW-SETUP VARYING WRK-IND FROM 1 BY 1 UNTIL
T ,WRK-IND > LENGTH-OF-FIELD(PR-IND).
^ DISPLAY Y ARROW-REGISTER.
h SET VLD-FLAG TO 1.
r
|VC-EXIT. EXIT.
ARROW-SETUP.
SET VLD-FLAG TO ZERO.
$ PERFORM CHECK-VLD THRU CV-DONE.
. IF VLD-FLAG = 1 MOVE "^" TO ARROW-BUFF(WRK-IND).
8
BCHECK-VLD.
L SET VLD-IND UP BY 1.
V IF VLD-CHR(VLD-IND) = "X" GO TO CV-DONE.
` IF VLD-CHR(VLD-IND) = "A" PERFORM SEE-ALPHA, GO TO CV-DONE.
j IF VLD-CHR(VLD-IND) = "N" PERFORM SEE-NUMERIC THRU SN-EXIT, GO TO CV-DONE.
t IF WR1(WRK-IND) = SPACE GO TO CV-DONE.
~ IF WR1(WRK-IND) NOT = VLD-CHR(VLD-IND) SET VLD-FLAG TO 1.
CV-DONE. EXIT.
&SEE-ALPHA.
0 IF WR1(WRK-IND) NOT ALPHABETIC SET VLD-FLAG TO 1.
:
DSEE-NUMERIC.
N IF WR1(WRK-IND) IS NUMERIC GO TO SN-EXIT.
X IF WR1(WRK-IND) = SPACE GO TO SN-EXIT.
b IF WR1(WRK-IND) = "-" GO TO SN-EXIT.
l SET VLD-FLAG TO 1.
v
SN-EXIT. EXIT.
DISPLAY-REC.
MOVE REC-IN TO REC-IN1.
( MOVE ZERO TO PR-IND, REC-IND1, WRK-IND.
2 SET TP-IND TO 2.
< MOVE ZERO TO LINE-COUNT.
F PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = TOP-LINE(1).
P MOVE LINE-COUNT TO REC-IND1.
Z MOVE ZERO TO LINE-COUNT.
d MOVE TOP-LINE(1) TO PR-IND.
n GO TO DR2.
x
DR-LOOP.
SET PR-IND UP BY 1.
DR1.
IF TP-IND < 2 GO TO DISPLAY-REC.
* IF TP-IND > NUM-PAGES GO TO DISPLAY-REC.
4 IF LENGTH-OF-FIELD(PR-IND) = ZEROES GO TO DR1A.
> IF PROMPT-TABLE(PR-IND) = "STOP" GO TO DR1A.
H IF PR-IND = TOP-LINE(TP-IND) GO TO DR1A.
R GO TO DR2.
\
fDR1A.
p COMPUTE LINE-COUNT = TERM-LINES - LINE-COUNT.
z IF BLOCKING-FACTOR NOT = 999, PERFORM A LINE-COUNT TIMES.
SET LINE-COUNT TO ZERO.
GO TO DR-BREAK.
"DR2.
, MOVE SPACES TO WORK-RECORD.
6 PERFORM DR-MOVE VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
@ MOVE PR-IND TO CLR-Z.
J MOVE CLR-Z TO LINE-NUM.
T MOVE PROMPT-TABLE(PR-IND) TO PROMPT OF DISPLAY-LINE.
^ MOVE " :" TO DL-COLON.
h MOVE WORK-RECORD TO DL-INFO.
r DISPLAY DISPLAY-LINE.
| SET LINE-COUNT UP BY 1.
GO TO DR-LOOP.
DR-BREAK. EXIT.
$
.CR-NEW.
8 IF CR-BUFFER(CR-IND) = ZERO GO TO CRN-EXIT.
B MOVE SPACES TO WORK-RECORD.
L MOVE ZERO TO REC-IND1.
V PERFORM CR-NEXT VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = CR-BUFFER(CR-IND).
` PERFORM DR-MOVE VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
j MOVE ":" TO WR1(WRK-IND).
t MOVE PR-IND TO CLR-Z.
~ DISPLAY CLR-Z " " PROMPT-TABLE(PR-IND) " :" WORK-RECORD.
DISPLAY CLR-Z X " :"; WITH NO ADVANCING.
ACCEPT WORK-RECORD.
MOVE ZERO TO REC-IND1.
& PERFORM CR-NEXT VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = CR-BUFFER(CR-IND).
0 MOVE CR-BUFFER(CR-IND) TO PR-IND.
: IF VALIDAT NOT = "Y" GO TO CR-NEW-1.
D PERFORM VALID-CHK THRU VC-EXIT.
N IF VLD-FLAG = ZERO GO TO CR-NEW-1.
X IF WORK-RECORD = SAVE-01 GO TO CR-NEW-1.
b MOVE WORK-RECORD TO SAVE-01.
l GO TO CR-NEW.
v
CR-NEW-1.
PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
IF PR-IND NOT = I GO TO CRN-EXIT.
IF WORK-RECORD = SPACES DISPLAY "NULL KEY FIELD", SET CR-IND DOWN BY 1
( ,GO TO CRN-EXIT.
2 MOVE REC-KEY TO SAVE-01.
< MOVE REC-IN1 TO REC-IN.
F MOVE REC-KEY TO SYM-KEY.
P READ FILE-IN; INVALID KEY GO TO CKEY-OK.
Z IF SPC = "Y" PERFORM RIGHT.
d PERFORM A.
n DISPLAY "A RECORD WITH THAT KEY ALREADY EXISTS".
x DISPLAY "TYPE T TO VIEW IT".
PERFORM A.
SET CNG-FLAG TO 1.
SET CR-IND TO 21.
GO TO CRN-EXIT.
*
4CKEY-OK.
> CLOSE FILE-IN.
H
RCO-1.
\ SET GOOD-FLAG TO ZERO.
f OPEN I-O FILE-IN.
p IF GOOD-FLAG = 1 GO TO CO-1.
z PERFORM SAVE-KEY.
MOVE SYM-KEY TO SAVE-01.
MOVE REC-IN1 TO REC-IN.
MOVE REC-KEY TO SYM-KEY.
" DELETE REC-IN; INVALID KEY DISPLAY "DELETE ERROR", STOP RUN.
, PERFORM SAVE-KEY.
6 MOVE REC-IN1 TO REC-IN.
@ MOVE REC-KEY TO SYM-KEY.
J IF SPC = "Y" PERFORM WRONG.
T WRITE REC-IN INVALID KEY DISPLAY "WRITE ERROR", STOP RUN.
^ PERFORM OPEN-INPUT.
h
rCRN-EXIT. EXIT.
|
!
!
!DR-MOVE.
!$ SET REC-IND1 UP BY 1.
!. MOVE RI1(REC-IND1) TO WR1(WRK-IND).
!8
!B
!LMOVE-REC.
!V SET REC-IND1 UP BY 1.
!` MOVE WR1(WRK-IND) TO RI1(REC-IND1).
!j
!t
!~A.
" DISPLAY " ".
"
" TOTAL-UP.
"& COMPUTE LINE-COUNT = LINE-COUNT + LENGTH-OF-FIELD(PR-IND).
"0
":
"DCR-NEXT.
"N COMPUTE REC-IND1 = REC-IND1 + LENGTH-OF-FIELD(PR-IND).
"X
"bSHOW-SIZE.
"l IF VALIDAT = "N" GO TO SSNV.
"v MOVE PR-IND TO VL1-IND.
# MOVE ZERO TO LINE-COUNT.
#
PERFORM TOTAL-UP VARYING PR-IND FROM 1 BY 1
# ,UNTIL PR-IND = VL1-IND.
# MOVE ZERO TO WRK-IND.
#( MOVE SPACES TO WORK-RECORD.
#2 COMPUTE AR-IND = LINE-COUNT + 1.
#< PERFORM GET-VLD VARYING AR-IND FROM AR-IND BY 1
#F ,UNTIL WRK-IND = LENGTH-OF-FIELD(PR-IND).
#P COMPUTE LINE-COUNT = WRK-IND + 1.
#Z GO TO SS-DIS.
#d
#nSSNV.
#x PERFORM NUL-FIELD VARYING LINE-COUNT FROM 1 BY 1 UNTIL, LINE-COUNT > LENGTH-OF-FIELD(PR-IND).
$
$
SS-DIS.
$ MOVE PR-IND TO CLR-Z.
$ MOVE ":" TO WR1(LINE-COUNT).
$* DISPLAY CLR-Z X " :" WORK-RECORD.
$4 MOVE SPACES TO WORK-RECORD.
$>
$HNUL-FIELD.
$R MOVE "-" TO WR1(LINE-COUNT).
$\GET-VLD.
$f SET WRK-IND UP BY 1.
$p MOVE VLD-CHR(AR-IND) TO WR1(WRK-IND).
$z
%WT-DATE.
% MOVE P-DATE TO WORK-RECORD.
% SET PR-IND TO 1.
%" MOVE ZERO TO REC-IND1.
%, PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1
%6 ,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
%@
%JREWRIT-DATE.
%T MOVE P-DATE TO WORK-RECORD.
%^ MOVE LENGTH-OF-FIELD(1) TO REC-IND1.
%h SET PR-IND TO 2.
%r PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1
%| ,UNTIL WRK-IND > LENGTH-OF-FIELD(PR-IND).
&
&OPEN-I-O.
& CLOSE FILE-IN.
&$
&.OI-1.
&8 SET GOOD-FLAG TO ZERO.
&B OPEN I-O FILE-IN.
&L IF GOOD-FLAG = 1 GO TO OI-1.
&V READ FILE-IN; INVALID KEY DISPLAY "PROGRAM E R R O R", STOP RUN.
&` IF SPC = "Y" PERFORM RIGHT.
&j
&tOPEN-INPUT.
&~ CLOSE FILE-IN.
' OPEN INPUT FILE-IN.
' READ FILE-IN; INVALID KEY DISPLAY "PROGRAM E R R O R", STOP RUN.
' IF SPC = "Y" PERFORM RIGHT.
'&
'0OC.
': CLOSE FILE-IN.
'D OPEN INPUT FILE-IN.
'N
'XSAVE-KEY.
'b MOVE SAVE-01 TO WORK-RECORD.
'l MOVE ZERO TO REC-IND1.
'v PERFORM CR-NEXT VARYING PR-IND FROM 1 BY 1 UNTIL PR-IND = I.
( PERFORM MOVE-REC VARYING WRK-IND FROM 1 BY 1 UNTIL WRK-IND > LENGTH-OF-FIELD(I).
(
(WRONG.
( MOVE 1 TO REC-TYPE.
(( ENTER MACRO SCRREC USING REC-TYPE, REC-IN.
(2
(<RIGHT.
(F MOVE 1 TO REC-TYPE.
(P ENTER MACRO UNSSCR USING REC-TYPE, REC-IN.
(Z
OPEN I-O FILE-IN.
LOOP2.
( MOVE LOW-VALUES TO SYM-KEY.
2 READ FILE-IN; INVALID KEY GO TO ALL-DONE.
< IF SPC = "Y" PERFORM RIGHT.
SET ELG-CNT UP BY 1.
MOVE IRK TO OSKEY.
READ FILE-OUT; INVALID KEY GO TO WRITE-PRG.
( DISPLAY OSKEY " IS FOUND IN CURRENT AND PURGED FILE".
2 DISPLAY "RECORD NOT PURGED".
< DISPLAY "------------------------------------------------------------------------".
F GO TO LOOP-2.
P
ZWRITE-PRG.
d MOVE REC-IN TO REC-OUT.
n MOVE ORK TO OSKEY.
x WRITE REC-OUT; INVALID KEY DISPLAY "?FATAL WRITE ERROR", STOP RUN.
MOVE IRK TO ISKEY.
DELETE REC-IN; INVALID KEY DISPLAY "?FATAL DELETE ERROR", STOP RUN.
SET PRG-CNT UP BY 1.
MOVE LOW-VALUES TO ISKEY.
* GO TO LOOP-2.
4
>ALL-DONE.
H DISPLAY " ".
R DISPLAY IN-CNT " RECORDS READ".
\ DISPLAY ELG-CNT " RECORDS ELIGIBLE TO BE PURGED".
f DISPLAY PRG-CNT " RECORDS ACTUALLY PURGED".
p STOP RUN.
z
WRITE REC-OUT BEFORE ADVANCING 2 LINES.
SUBTRACT 2 FROM LINE-COUNT.
IF LINE-COUNT > 2 GO TO PL-EXIT.
( GO TO PL-HDR.
2
<PRINT-3.
F WRITE REC-OUT BEFORE ADVANCING N LINES.
P SUBTRACT N FROM LINE-COUNT.
Z IF LINE-COUNT > N GO TO PL-EXIT.
d GO TO PL-HDR.
n
xPRINT-1.
WRITE REC-OUT.
SUBTRACT 1 FROM LINE-COUNT.
IF LINE-COUNT > 1 GO TO PL-EXIT.
*PL-HDR.
4 MOVE SPACES TO REC-OUT.
>
HPRINT-CH-1.
R WRITE REC-OUT BEFORE TOP-OF-FORM.
\
fPRI1.
p SET PAGE-COUNT UP BY 1.
z MOVE PAGE-COUNT TO PAGE-NUM.
MOVE HEADER-1 TO REC-OUT.
WRITE REC-OUT BEFORE ADVANCING 2 LINES.
MOVE HEADER-2 TO REC-OUT.
" WRITE REC-OUT BEFORE ADVANCING 3 LINES.
, MOVE HEADER-3 TO REC-OUT.
6 WRITE REC-OUT.
@ MOVE HEADER-4 TO REC-OUT.
J WRITE REC-OUT BEFORE ADVANCING 2 LINES.
T MOVE 50 TO LINE-COUNT.
^
hPL-EXIT. EXIT.
r
|
DATE-CONVER.
MOVE SPACES TO DATE-FMT.
IF DB-MM NOT POSITIVE GO TO DC-EXIT.
$ IF DB-MM > 12 GO TO DC-EXIT.
. MOVE DB-DD TO DF-DD.
8 MOVE "-" TO DF-D1, DF-D2.
B MOVE M-BUFF(DB-MM) TO DF-MON.
L MOVE DB-YY TO DF-YR.
V
`DC-EXIT. EXIT.
WRITE REC-OUT BEFORE ADVANCING 2 LINES.
SUBTRACT 2 FROM LINE-COUNT.
IF LINE-COUNT > 2 GO TO PL-EXIT.
( GO TO PL-HDR.
2
<PRINT-3.
F WRITE REC-OUT BEFORE ADVANCING N LINES.
P SUBTRACT N FROM LINE-COUNT.
Z IF LINE-COUNT > N GO TO PL-EXIT.
d GO TO PL-HDR.
n
xPRINT-1.
WRITE REC-OUT.
SUBTRACT 1 FROM LINE-COUNT.
IF LINE-COUNT > 1 GO TO PL-EXIT.
*PL-HDR.
4 MOVE SPACES TO REC-OUT.
>
HPRINT-CH-1.
R WRITE REC-OUT BEFORE TOP-OF-FORM.
\
fPRI1.
p MOVE HEADER-1 TO REC-OUT.
z WRITE REC-OUT BEFORE ADVANCING 1 LINE.
MOVE HEADER-2 TO REC-OUT.
WRITE REC-OUT BEFORE ADVANCING 2 LINES.
MOVE HEADER-3 TO REC-OUT.
" WRITE REC-OUT.
, MOVE HEADER-4 TO REC-OUT.
6 WRITE REC-OUT BEFORE ADVANCING 1 LINE.
@ MOVE 14 TO LINE-COUNT.
J
TPL-EXIT. EXIT.
^
h
rDATE-CONVER.
| MOVE SPACES TO DATE-FMT.
IF DB-MM NOT POSITIVE GO TO DC-EXIT.
IF DB-MM > 12 GO TO DC-EXIT.
MOVE DB-DD TO DF-DD.
$ MOVE "-" TO DF-D1, DF-D2.
. MOVE M-BUFF(DB-MM) TO DF-MON.
8 MOVE DB-YY TO DF-YR.
B
LDC-EXIT. EXIT.
MOVE REC-KEY TO SYM-KEY.
IF SPC = "Y" PERFORM WRONG.
REWRITE REC-IN; INVALID KEY DISPLAY "PROGRAM ERROR ON A REWRITE"
( ,STOP RUN.
2 GO TO LOOP2.
<
FALL-DONE.
P STOP RUN.
MOVE 1 TO REC-TYPE.
ENTER MACRO SCRREC USING REC-TYPE, REC-IN.
(RIGHT.
2 MOVE 1 TO REC-TYPE.
< ENTER MACRO UNSSCR USING REC-TYPE, REC-IN.
F
OPEN INPUT FILE-IN, OUTPUT FILE-OUT.
MOVE TODAY TO P-TODAY.
MOVE P-DA TO H2-DA.
( MOVE M-BUFF(P-MO) TO H2-MON.
2 MOVE P-YR TO H2-YR.
< MOVE P-HR TO H2-HR.
F MOVE P-MIN TO H2-MIN.
P MOVE ZERO TO LINE-COUNT, PAGE-COUNT.
Z PERFORM PRI1 THRU PL-EXIT.
d MOVE "!" TO SAVE-06.
02 P-YR PIC 99.
02 P-MO PIC 99.
02 P-DA PIC 99.
( 02 P-HR PIC 99.
2 02 P-MIN PIC 99.
< 02 FILLER PIC X(2).
F
P01 MONTH-REGISTER.
Z 02 FILLER PIC X(36); VALUE "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC".
d
n01 MONTH-ARRAY REDEFINES MONTH-REGISTER.
x 02 M-BUFF OCCURS 12 TIMES PIC X(3).
01 HEADER-2.
02 FILLER PIC X(54); VALUE SPACES.
02 FILLER PIC X(7); VALUE "RUN ON ".
* 02 H2-DA PIC 99.
4 02 FILLER PIC X; VALUE "-".
> 02 H2-MON PIC X(3).
H 02 FILLER PIC X; VALUE "-".
R 02 H2-YR PIC 99.
\ 02 FILLER PIC X(4); VALUE " AT ".
f 02 H2-HR PIC 99.
p 02 FILLER PIC X; VALUE ":".
z 02 H2-MIN PIC 99.
02 FILLER PIC X(53); VALUE SPACES.
01 BREAK-LINE.
" 02 FILLER PIC X(21); VALUE "***** SUBTOTALS *****".
, 02 FILLER PIC X(5); VALUE SPACES.
6 02 BL-NAME PIC X(32).
@ 02 FILLER PIC X(74); VALUE SPACES.
J
T01 BREAK-LINE2.
^ 02 FILLER PIC X(24); VALUE "***** FINAL TOTALS *****".
h 02 FILLER PIC X(108); VALUE SPACES.
r
|01 BREAK-LINE1.
02 P-YR PIC 99.
02 P-MO PIC 99.
02 P-DA PIC 99.
( 02 P-HR PIC 99.
2 02 P-MIN PIC 99.
< 02 FILLER PIC X(2).
F 02 PAGE-NUM PIC 9(3).
P
Z01 MONTH-REGISTER.
d 02 FILLER PIC X(36); VALUE "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC".
n
x01 MONTH-ARRAY REDEFINES MONTH-REGISTER.
02 M-BUFF OCCURS 12 TIMES PIC X(3).
01 HEADER-2.
02 FILLER PIC X(24); VALUE SPACES.
* 02 FILLER PIC X(7); VALUE "RUN ON ".
4 02 H2-DA PIC 99.
> 02 FILLER PIC X; VALUE "-".
H 02 H2-MON PIC X(3).
R 02 FILLER PIC X; VALUE "-".
\ 02 H2-YR PIC 99.
f 02 FILLER PIC X(4); VALUE " AT ".
p 02 H2-HR PIC 99.
z 02 FILLER PIC X; VALUE ":".
02 H2-MIN PIC 99.
02 FILLER PIC X(23); VALUE SPACES.
"01 BREAK-LINE.
, 02 FILLER PIC X(21); VALUE "***** SUBTOTALS *****".
6 02 FILLER PIC X(5); VALUE SPACES.
@ 02 BL-NAME PIC X(32).
J 02 FILLER PIC X(14); VALUE SPACES.
T
^01 BREAK-LINE2.
h 02 FILLER PIC X(24); VALUE "***** FINAL TOTALS *****".
r 02 FILLER PIC X(48); VALUE SPACES.
|
01 BREAK-LINE1.
02 LEDFMT-RECORD.
03 PROMPT-TABLE OCCURS 150 TIMES PIC X(20).
03 LENGTH-OF-FIELD OCCURS 150 TIMES PIC 9(3).
( 03 NUMBER-FIELDS PIC 9(3).
2 03 NAMES OCCURS 28 TIMES PIC X(6).
< 03 VAL-ID PIC X.
F 03 AC-DAT PIC X.
P 03 SPC PIC X.
Z 03 FILLER PIC X(3).
d 03 IND-BLOCK-FACT PIC 9(3).
n 03 OVER-LAY-PAGE PIC 9(3).
x 03 BLOCKING-FACTOR PIC 9(3).
03 PRI.
05 PRIV OCCURS 28 TIMES PIC 9(3).
03 FILLER PIC X(3).
03 VERSION-NUMBER PIC 9(3).
* 03 NUM-CHARS PIC 9(4).
4 03 POS-KEY PIC 99.
> 03 NUM-PAGES PIC 9(3).
H 03 TOP-LINE OCCURS 50 TIMES PIC 9(3).
R 03 DECIMAL-POSIT OCCURS 150 TIMES PIC 9.
\ 02 WORK-RECORD.
f 03 WR1 OCCURS 72 TIMES PIC X.
p 02 FORMAT-NAME.
z 03 F-NAME PIC X(6).
03 FILLER PIC X(3); VALUE "FMT".
02 USER-PASSWORD PIC X(6).
02 TOD.
" 03 TOD1 PIC 9(6).
, 03 FILLER PIC X(6).
6 02 CSSDBM-INDEXES.
@ 03 PROMPT-IND PIC S9(3);COMP.
J 03 WRK-IND PIC S9(3);COMP.
T 03 FIELD1 PIC S9(3); COMP.
^ 03 FIELD2 PIC S9(3); COMP.
h 03 FIELD3 PIC S9(3); COMP.
r 03 AC1 PIC S9(3)V9(2); COMP.
| 03 REC-TYPE PIC S9(3); COMP.
01 DATE-BUFFER.
02 DB-YY PIC 99.
$ 02 DB-MM PIC 99.
. 02 DB-DD PIC 99.
8
B01 DATE-FMT.
L 02 DF-DD PIC 99.
V 02 DF-D1 PIC X.
` 02 DF-MON PIC X(3).
j 02 DF-D2 PIC X.
t 02 DF-YR PIC 99.
~
02 LEDFMT-RECORD.
03 PROMPT-TABLE OCCURS 150 TIMES PIC X(20).
03 LENGTH-OF-FIELD OCCURS 150 TIMES PIC 9(3).
( 03 NUMBER-FIELDS PIC 9(3).
2 03 NAMES OCCURS 28 TIMES PIC X(6).
< 03 VAL-ID PIC X.
F 03 AC-DAT PIC X.
P 03 SPC PIC X.
Z 03 FILLER PIC X(3).
d 03 IND-BLOCK-FACT PIC 9(3).
n 03 OVER-LAY-PAGE PIC 9(3).
x 03 BLOCKING-FACTOR PIC 9(3).
03 PRI.
05 PRIV OCCURS 28 TIMES PIC 9(3).
03 FILLER PIC X(3).
03 VERSION-NUMBER PIC 9(3).
* 03 NUM-CHARS PIC 9(4).
4 03 POS-KEY PIC 99.
> 03 NUM-PAGES PIC 9(3).
H 03 TOP-LINE OCCURS 50 TIMES PIC 9(3).
R 03 DECIMAL-POSIT OCCURS 150 TIMES PIC 9.
\ 02 WORK-RECORD.
f 03 WR1 OCCURS 34 TIMES PIC X.
p 02 FORMAT-NAME.
z 03 FM1 PIC X(6).
03 FILLER PIC X(3); VALUE "FMT".
02 VLD-NAME.
03 V-NAME PIC X(6).
" 03 FILLER PIC X(3); VALUE "VLD".
, 02 CR-ARRAY.
6 03 CR-BUFFER OCCURS 20 TIMES PIC 9(3); COMP.
@ 02 CNG-FLAG PIC 9.
J 02 DISPLAY-LINE.
T 03 LINE-NUM PIC X(5).
^ 03 PROMPT PIC X(20).
h 03 DL-COLON PIC X(3).
r 03 DL-INFO PIC X(34).
| 02 DEL-RESP PIC A.
02 PG-RESP PIC A.
02 ARROW-REGISTER.
03 ARROW-BUFF OCCURS 34 TIMES PIC X.
$ 02 SAVE-01 PIC X(34).
. 02 Y PIC X(28); VALUE "DATA E R R O R".
8 02 USER-PASSWORD PIC X(6).
B 02 TOD.
L 03 TOD1 PIC 9(6).
V 03 FILLER PIC X(6).
` 02 CLR-Z PIC ZZ9.
j 02 LINE-COUNT PIC S9(3);COMP.
t 02 FUNCTION.
~ 03 FUN1 PIC A.
03 FUN2.
05 FUN2A PIC 9.
05 FUN2B PIC 9.
& 02 FUN3 PIC S9(3); COMP.
0 02 X PIC X(22); VALUE SPACES.
: 02 CSSDBM-INDEXES.
D 03 PR-IND PIC S9(3);COMP.
N 03 REC-IND1 PIC S9(3);COMP.
X 03 WRK-IND PIC S9(3);COMP.
b 03 TP-IND PIC S9(3);COMP.
l 03 CR-IND PIC S9(3);COMP.
v 03 PRIV-IND PIC S9(3);COMP.
03 FLAG1 PIC S9; COMP.
03 VLD-FLAG PIC S9(3); COMP.
03 VLD-IND PIC S9(3); COMP.
03 AR-IND PIC S9(3); COMP.
( 03 VL1-IND PIC S9(3); COMP.
2 03 FIELD1 PIC S9(3); COMP.
< 03 FIELD2 PIC S9(3); COMP.
F 03 FIELD3 PIC S9(3); COMP.
P 03 AC1 PIC S9(3)V9(2); COMP.
Z 03 REC-TYPE PIC S9(3); COMP.
d
n01 TST-ERR.
x 02 AB PIC 99.
02 CD-001 PIC 99.
02 EFG PIC 9(3).
02 HIJ PIC 9(3).
02 OUTNAM1 PIC X(6).
02 OUTNAM2 PIC X(3); VALUE "SEQ".
02 P-DATE PIC 9(6).
02 FILLER PIC X(6).