PINPUT=TAPE0 00001PPUTIL 00002PPDELETE,FN=SFDACRTE 00003PPDEFINE,FN=SFDACRTE,ED=999999,TY=S,LR=80,NR=500 00004PPEX 00005PPLODDAT 00006PPSFDACRTECCS20 00007PP PROGRAM DACRTE B3600001PP 1 /B36 F CCS CCS 3.0 PSR'D/84 SL-149********PPC B3600003PPC CYBERCREDIT SYSTEM VERSION 3 B3600004PPC DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3600005PPC COPYRIGHT CONTROL DATA CORPORATION, 1979 B3600006PPC B3600007PP1 B3600008PPC THIS PROGRAM REASSIGNS QUEUES AND PRIORITIES FOR ALL ACTIVE B3600009PPC ACCOUNTS IN THE DELQMST FILE AND CREATES THE DLYASSN FILE B3600010PPC WHICH IS USED BY THE ON-LINE AUTOMATIC FUNCTION B3600011PP1 B3600012PP INTEGER DEQREQ(24),ASNREQ(24),DDATA(15),ADATA(15),ST,EFG,DT(3), B3600013PP 2 USER(4),HD(3,20),PRI(3,9),QUE(3,9),NQUE(2),NPRI(2),FDEL, B3600014PP 3 DEQREC(22000), ASNREC(462), QUEP(9), QUEL(9), PRIP(9), PRIL(9), ********PP 4 STG(40),LTHACT(2) B3600016PP1 B3600017PP EXTERNAL FMRDEL B3600018PP1 B3600019PP DATA DEQREQ, ASNREQ / 48*0 / B3600020PP DATA DDATA / 'DELQMST ', 8*$2020, 0, 0, 0 / B3600021PP DATA ADATA / 'DLYASSN ', 8*$2020, 0, 1, 0 / B3600022PP DATA NUMREC/22/, ST/0/, EFG/0/, LTHACT/'0360'/ ********PP DATA QUE, PRI / 54*$2020 / B3600024PP. B3600025PPC**** SET UP THE DELQMST STARTING CHARACTER POSITIONS FOR THE B3600026PPC QUEUE ASSIGNMENT PARAMETERS, IF NOT USED MUST BE ZERO (0) B3600027PP1 B3600028PPC P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600029PP DATA QUEP / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B3600030PP1 B3600031PPC**** SET UP THE DELQMST PARAMETER LENGTH IN CHARACTERS MAX. = 6 B3600032PPC IF UNUSED MUST BE ZERO (0) B3600033PP1 B3600034PPC P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600035PP DATA QUEL / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B3600036PP2 B3600037PPC**** SET UP THE STARTING CHARACTER POSITIONS IN DELQMST FILE FOR B3600038PPC THE PRIORITY ASSIGNMENT PARAMETERS, IF UNSED MUST BE ZERO (0) B3600039PP1 B3600040PPC P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600041PP DATA PRIP / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B3600042PP1 B3600043PPC**** SET UP THE PRIORITY PARAMETER CHARACTER LENGTHS MAX. = 6 B3600044PPC IF UNUSED MUST BE ZERO (0) B3600045PP1 B3600046PPC P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600047PP DATA PRIL / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B3600048PP1 B3600049PPC**** SET UP THE STARTING CHARACTER POSITIONS FOR THE MOST RECENT B3600050PPC PAYMENT AMOUNT AND PAYMENT DATE, USED FOR BROKEN PP'S B3600051PP1 B3600052PP DATA LDATE / 0 / , LAMT / 0 / B3600053PP. B3600054PPC ACCEPT LOGIN FROM ITOS B3600055PP CALL PGMIN ( USER, LU, MODE, NPORT ) B3600056PP1 B3600057PPC INITIALIZE VARIABLES B3600058PP ASSEM $C000,FMRDEL,$6800,FDEL B3600059PP CALL CCSBLK ( ASNREC, 920 ) B3600060PP IOSW = $3030 B3600061PP CALL UTHEAD ( HD, DT ) B3600062PP DDATA(14) = NUMREC B3600063PP M = 1 B3600064PP2 B3600065PPC OPEN FILES FOR USE B3600066PP CALL OPENFL ( DEQREQ, DDATA, ISTAT ) B3600067PP IF (ISTAT.GE.0) GO TO 100 B3600068PP CALL FILERR ( DDATA, 3, ISTAT, LU ) B3600069PP GO TO 900 B3600070PP 100 CALL CLEAR ( ASNREQ, ADATA, ISTAT ) B3600071PP IF (ISTAT.GE.0) GO TO 110 B3600072PP CALL FILERR ( ADATA, 1, ISTAT, LU ) B3600073PP GO TO 900 B3600074PP 110 CALL OPENFL ( ASNREQ, ADATA, ISTAT ) B3600075PP IF (ISTAT.GE.0) GO TO 200 B3600076PP CALL FILERR ( ADATA, 3, ISTAT, LU ) B3600077PP GO TO 900 B3600078PP. B3600079PPC READ RECORDS FROM THE DELQMST AND PROCESS B3600080PP 200 CALL GETS ( DEQREQ, DEQREC, I, ISTAT ) B3600081PPC EOF? B3600082PP IF (AND(ISTAT,$8100).EQ.$8100) GO TO 900 B3600083PP IF (AND(ISTAT,$100).EQ.$100) EFG = 1 B3600084PPC FILE ERROR? B3600085PP IF (ISTAT.GE.0) GO TO 210 B3600086PP CALL FILERR ( DDATA, 14, ISTAT, LU ) B3600087PP GO TO 900 B3600088PP 210 DO 300 I = 1 , NUMREC B3600089PP L = 40*M - 39 B3600090PP K = 1000*I-999 B3600091PP J = 2*K-1 B3600092PPC RECORD PRESENT? B3600093PP IF (DEQREC(K).EQ.$2020.OR. B3600094PP 1 DEQREC(K).EQ.FDEL) GO TO 300 B3600095PPC RECORD ACTIVE? B3600096PP IF (AND(DEQREC(K+152),$FF).NE.$20) GO TO 300 B3600097PP1 B3600098PPC GET THE MOST RECENT ACTIVITY B3600099PPC**************************************************************138*A023 B3600100PP IOSW=$3031 B3600101PPC**************************************************************138*A023 B3600102PP CALL GETACF ( STG, DEQREC(K+153), LTHACT, IOSW ) B3600103PP2 B3600104PPC REASSIGN QUEUE ALLOWED? B3600105PP IF (AND(DEQREC(K+146),$FF).NE.$20) GO TO 220 B3600106PP1 B3600107PP. B3600108PPC**** SET UP THE PARAMETERS FOR QUEUE ASSIGNMENT : B3600109PPC - THE MOST RECENT ACTION CODE IS IN : STG(4) B3600110PPC - RESULT CODE IS IN : STG(5) B3600111PPC - CONTACT DATE STARTS IN : STG(1) B3600112PPC - THE SYSTEM DATE STARTS IN : DT(1) B3600113PP3 B3600114PPC PARAMETER #1 B3600115PP CALL CCSMVA ( DEQREC, QUEP(1)+J-1, QUEL(1), QUE, 1, 6 ) B3600116PP1 B3600117PPC PARAMETER #2 B3600118PP CALL CCSMVA ( DEQREC, QUEP(2)+J-1, QUEL(2), QUE, 7, 6 ) B3600119PP1 B3600120PPC PARAMETER #3 B3600121PP CALL CCSMVA ( DEQREC, QUEP(3)+J-1, QUEL(3), QUE, 13, 6 ) B3600122PP1 B3600123PPC PARAMETER #4 B3600124PP CALL CCSMVA ( DEQREC, QUEP(4)+J-1, QUEL(4), QUE, 19, 6 ) B3600125PP1 B3600126PPC PARAMETER #5 B3600127PP CALL CCSMVA ( DEQREC, QUEP(5)+J-1, QUEL(5), QUE, 25, 6 ) B3600128PP1 B3600129PPC PARAMETER #6 B3600130PP CALL CCSMVA ( DEQREC, QUEP(6)+J-1, QUEL(6), QUE, 31, 6 ) B3600131PP1 B3600132PPC PARAMETER #7 B3600133PP CALL CCSMVA ( DEQREC, QUEP(7)+J-1, QUEL(7), QUE, 37, 6 ) B3600134PP1 B3600135PPC PARAMETER #8 B3600136PP CALL CCSMVA ( DEQREC, QUEP(8)+J-1, QUEL(8), QUE, 43, 6 ) B3600137PP1 B3600138PPC PARAMETER #9 B3600139PP CALL CCSMVA ( DEQREC, QUEP(9)+J-1, QUEL(9), QUE, 49, 6 ) B3600140PP. B3600141PPC GET THE NEW QUEUE B3600142PP CALL FTNDT1 ( QUE, NQUE ) B3600143PPC NEW QUEUE? B3600144PP IF (NQUE(1).EQ.DEQREC(K+135).AND. B3600145PP 1 NQUE(2).EQ.DEQREC(K+136)) GO TO 220 B3600146PPC QUEUE RETURN SUCCESSFUL? B3600147PP IF (NQUE(1).EQ.$3939.AND. B3600148PP 1 NQUE(2).EQ.$3939) GO TO 220 B3600149PPC SAVE OLD QUEUE , DATE , AND NEW QUEUE B3600150PP CALL CCSMVA ( DEQREC, J+270, 4, DEQREC, J+295, 4 ) B3600151PP CALL CCSMVA ( DT, 1, 6, DEQREC, J+299, 6 ) B3600152PP CALL CCSMVA ( NQUE, 1, 4, DEQREC, J+270, 4 ) B3600153PP2 B3600154PPC GET THE NEW PRIORITY B3600155PP 220 CONTINUE B3600156PP. B3600157PPC**** SET UP THE PARAMETERS FOR THE PRIORITY ASSIGNMENT - B3600158PPC - THE MOST RECENT ACTION CODE IS IN : STG(4) B3600159PPC - RESULT CODE IS IN : STG(5) B3600160PPC - CONTACT DATE STARTS IN : STG (1) B3600161PPC - THE SYSTEM DATE STARTS IN : DT(1) B3600162PP2 B3600163PPC PARAMETER #1 B3600164PP CALL CCSMVA ( DEQREC, PRIP(1)+J-1, PRIL(1), PRI, 1, 6 ) B3600165PP1 B3600166PPC PARAMETER #2 B3600167PP CALL CCSMVA ( DEQREC, PRIP(2)+J-1, PRIL(2), PRI, 7, 6 ) B3600168PP1 B3600169PPC PARAMETER #3 B3600170PP CALL CCSMVA ( DEQREC, PRIP(3)+J-1, PRIL(3), PRI, 13, 6 ) B3600171PP1 B3600172PPC PARAMETER #4 B3600173PP CALL CCSMVA ( DEQREC, PRIP(4)+J-1, PRIL(4), PRI, 19, 6 ) B3600174PP1 B3600175PPC PARAMETER #5 B3600176PP CALL CCSMVA ( DEQREC, PRIP(5)+J-1, PRIL(5), PRI, 25, 6 ) B3600177PP1 B3600178PPC PARAMETER #6 B3600179PP CALL CCSMVA ( DEQREC, PRIP(6)+J-1, PRIL(6), PRI, 31, 6 ) B3600180PP1 B3600181PPC PARAMETER #7 B3600182PP CALL CCSMVA ( DEQREC, PRIP(7)+J-1, PRIL(7), PRI, 37, 6 ) B3600183PP1 B3600184PPC PARAMETER #8 B3600185PP CALL CCSMVA ( DEQREC, PRIP(8)+J-1, PRIL(8), PRI, 43, 6 ) B3600186PP1 B3600187PPC PARAMETER #9 B3600188PP CALL CCSMVA ( DEQREC, PRIP(9)+J-1, PRIL(9), PRI, 49, 6 ) B3600189PP. B3600190PP CALL FTNDT1 ( PRI, NPRI ) B3600191PPC PRIORITY RETURN SUCCESSFUL? B3600192PP IF (NPRI(1).EQ.$3939.AND. B3600193PP 1 NPRI(2) .EQ. $3939 ) GO TO 225 B3600194PPC SAVE THE NEW PRIORITY B3600195PP CALL CCSMVA ( NPRI, 1, 4, DEQREC, J+280, 4 ) B3600196PP1 B3600197PPC IS THIS ACCOUNT A PROMISE TO PAY? B3600198PP 225 IF ( AND(DEQREC(K+142),$FF00) .NE. $5900 ) GO TO 230 B3600199PP1 B3600200PPC**************************************************************138*A018 B3600201PPC CHECK IF PROMISE DUE TO BE CHECKED (SYSTEM DATE EQUAL OR B3600202PPC PAST PROMISE TO PAY DATE). B3600203PP CALL CCSCST ( DT, 5, 2, DEQREC, J+1019, 2, ICOMP) B3600204PPC NOT DUE CHK FURTHER DUE B3600205PP IF(ICOMP) 230, 2251, 2252 B3600206PP1 B3600207PPC YEARS EQUAL CHECK MONTH AND DAY B3600208PP 2251 CALL CCSCST( DT, 1, 4, DEQREC, J+1015, 4, ICOMP) B3600209PPC TODAYS DATE MUST BE EQUAL OR PAST PROMISE TO BE DUE FOR B3600210PPC CHECK. B3600211PP IF (ICOMP .LT. 0) GO TO 230 B3600212PP1 B3600213PPC PROMISE DUE TO BE CHECKED. SEE IF LAST PAYMENT AMOUNT B3600214PPC CLEARS PROMISED AMOUNT. B3600215PP 2252 CALL CCSCST ( DEQREC, J+LAMT-1, 9, DEQREC, J+1021, 9, ICOMP) B3600216PP IF(ICOMP .LT. 0) GO TO 224 B3600217PP1 B3600218PPC LAST PAYMENT CLEARS PROMISE. VERIFY PAYMENT RECEIVED B3600219PPC AFTER COMMITMENT DATE. B3600220PPC ****************************************************** ???*A018********PP CALL CCSCST (DEQREC, J+LDATE+3, 2, DEQREC, J+1044, 2, ICOMP) ********PPC ****************************************************** ???*A018********PP DEL/282 ********PP CALL CCSBLK ( DEQREC(15001), 14000) ********PPC BEFORE CHK FURTHER AFTER B3600222PP IF(ICOMP) 224, 2253, 2254 B3600223PP1 B3600224PPC YEARS EQUAL, CHECK MONTH AND DAY B3600225PP 2253 CALL CCSCST ( DEQREC, J+LDATE-1, 4, DEQREC, J+1040, 4, ICOMP) B3600226PPC PAYMENT DATE MUST BE PAST COMMITTMENT DATE FOR KEPT PROMISE. B3600227PP IF( ICOMP .LT. 0 ) GO TO 224 B3600228PPC**************************************************************138*A018 B3600229PP2 B3600230PPC PROMISE KEPT, INCREMENT THE KEPT COUNT B3600231PPC**************************************************************138*A018 B3600232PP 2254 DEQREC(K+518) = AND(DEQREC(K+518),$FF0F) + $31 B3600233PPC**************************************************************138*A018 B3600234PP IF ( AND(DEQREC(K+518),$FF) .GT. $39 ) B3600235PP 1 DEQREC(K+518) = AND(DEQREC(K+518),$FFF) + $30F6 B3600236PPC INCREMENT THE NEXT CONTACT DATE 7 DAYS B3600237PP IK = ICALJL ( DEQREC, J+274 ) B3600238PP IK = IK + 7 B3600239PP IF ( IK .LE. 365 ) GO TO 222 B3600240PP DEQREC(K+139) = DEQREC(K+139) + 1 B3600241PP IF ( AND(DEQREC(K+139),$FF) .GT. $39 ) B3600242PP 1 DEQREC(K+139) = DEQREC(K+139) + $F6 B3600243PP 222 CALL JULCAL ( IK, DEQREC, J+274 ) B3600244PPC CLEAR THE PROMISED TO PAY FLAG B3600245PP CALL CCSPUT ( $4B, J+284, DEQREC ) B3600246PP GO TO 230 B3600247PP1 B3600248PP1 B3600249PPC PROMISE BROKEN, INCREMENT THE BROKEN COUNT B3600250PP 224 DEQREC(K+519) = AND(DEQREC(K+519),$FF0F) + $31 B3600251PP IF ( AND(DEQREC(K+519),$FF) .GT. $39 ) B3600252PP 1 DEQREC(K+519) = AND(DEQREC(K+519),$FFF) + $30F6 B3600253PPC SET THE PROMISED TO PAY FLAG TO BROKEN B3600254PP CALL CCSPUT ( $42, J+284, DEQREC ) B3600255PP. B3600256PPC BUILD THE DLYASSN RECORD - ACCT #, QUEUE, NEXTCD, PRIORITY B3600257PP 230 CALL CCSMVA ( DEQREC, J, 16, ASNREC, L, 16) B3600258PP CALL CCSMVA ( DEQREC, J+270, 14, ASNREC, L+16, 14 ) B3600259PP2 B3600260PPC**** IF ADDITIONAL FIELDS ARE REQUIRED IN THE DLYASSN RECORD, B3600261PPC THEY SHOULD BE MOVED IN AT THIS POINT B3600262PP2 B3600263PP M = M + 1 B3600264PP 300 CONTINUE B3600265PP1 B3600266PPC SAVE THE DLYASSN RECORD B3600267PP M = M - 1 B3600268PP IF ( M .EQ. 0 ) GO TO 310 B3600269PP CALL PUTS ( ASNREQ, ASNREC, M, ISTAT ) B3600270PP IF (ISTAT.GE.0) GO TO 305 B3600271PP CALL FILERR ( ADATA, 11, ISTAT, LU ) B3600272PP GO TO 900 B3600273PPC UPDATE THE RECORDS IN THE DELQMST FILE B3600274PP 305 CALL UPDREC ( DEQREQ, DEQREC, ISTAT ) B3600275PPC FILE ERROR? B3600276PP IF (ISTAT.GE.0) GO TO 310 B3600277PP CALL FILERR ( DDATA, 15, ISTAT, LU ) B3600278PP GO TO 900 B3600279PPC BLANK OUT THE DELQ BUFFER AND CONTINUE B3600280PP 310 CALL CCSBLK ( DEQREC, 30000 ) B3600281PP CALL CCSBLK ( DEQREC(15001), 16000 ) B3600282PP CALL CCSBLK ( ASNREC, 920 ) B3600283PP M = 1 B3600284PP IF (EFG.EQ.0) GO TO 200 B3600285PP1 B3600286PPC CLOSE THE FILES AND STOP B3600287PP 900 CALL CLOSFL ( DEQREQ, ISTAT ) B3600288PP CALL CLOSFL ( ASNREQ, ISTAT ) B3600289PP CALL PGMOUT B3600290PP END B3600291PP SUBROUTINE R9BASE C1200001PP 1 /C12 F CCS CCS 3.0 SL-149C1200002PPC C1200003PPC CYBERCREDIT SYSTEM VERSION 3 C1200004PPC DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1200005PPC COPYRIGHT CONTROL DATA CORPORATION, 1979 C1200006PPC C1200007PP RETURN C1200008PP END C1200009PP SUBROUTINE R9FLDL C1300001PP 1 /C13 F CCS CCS 3.0 SL-149C1300002PPC C1300003PPC CYBERCREDIT SYSTEM VERSION 3 C1300004PPC DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1300005PPC COPYRIGHT CONTROL DATA CORPORATION, 1979 C1300006PPC C1300007PP RETURN C1300008PP END C1300009PPINPUT=TAPE0 00001PPUTIL 00002PPDELETE,FN=UPDATE.B 00003PPDEFINE,FN=UPDATE.B,ED=999999,TY=S,LR=120,NR=1000 00004PPEX 00005PPLODDAT 00006PPUPDATE.BCCS20 00001P PUPDATE A21 A CCS CCS 3.0 SL-149@PPUPDATEPFUPDATP P WQ8QBDS C46 F CCS CCS 3.0 SL-149@P8 601@P0 70360@P8@P8 / @P0 000000000000@P0 000000000000@P8 @P0 - ACCOUNT ALREADY IN ACCAGE @P0  CO HOST @P8 5 @P8 @P0 TRAN ACCOUNT BORROWERS DELINQUENT DELINQUENT C@P0 URRENT @P0 @P0 CODE NUMBER NAME DATE AMOUNT P@P0 AYOFF ACTION @P0 " @P0  @P0 @P0  @P8@P8 @P8 @P8@P8 @P0 <-- HDR1 FROM UTILITY FILE GOES HERE -->  @P0  @P0  @P0 <-- HDR2 FROM UTILITY FILE GOES HERE --> DAILY MASTER FILE UPDATE REPORT @P0 H PAGE @P0 \ @P0 _<-- HDR3 FROM UTILITY FILE GOES HERE --> <-DATE->  @P0 @P0 @P0hADDACT  @P0ACCAGE  @P06COSIGNER  @P0 DELQMST  @P0INACCT  @P0UPDINPUT  @P0UPDPRINT  @P0RSWFIL  @P0TRANFL  @P0TRNBCK  @P0XUTIFIL  @P8 @P0 FHDR1@P0 HUPDY@P8 B@P8 w@P8 e@P8 @P8 @P8 @P8 @P8 @P8 2@P8 Y@P8 @P8 @P8 _@P0 00000000001@P0 000000000000@P0 000000000000@P0 000000000000@P0 000000000000000000000000000000000000@P0 000000000000@P8 9@P8 :@P8 ;@P8 <@P8 =@P8 >@P8 ?@P8 @@P8 A@P8 B @P8 C @P8 D @P8 E @P8 F @P8 G@P8 H@P8 I@P8 J@P8 K@P8 L@P8 M@P8 N@P8 O#@P8 P(@P8 Q7@P8 RB@P8 SP@P8 TR@P8 U`@P8 V@P0 000000000000@P8 ;@P8 #@P0 000000000000@P0 000000000000@P0  @P0  @P0J @P0^  @P0 @P0  @P0 @P0  @P0 @P0  @P0F @P0Z  @P0 @P0  @P0 @P0  @P0 @P0  @P0B @P0V  @P0 @P0  @P0 @P0  @P0 @P0  @P0> @P0R  @P0} @P0  @P0 @P0  @P0 @P0 @P0E@P0@P0g@P0@P0w@P0@P0@P0@P0%@P0@P0@P8 D@P8 &@P8 2@P8 @P8 )@P8 @P8 M@P0 n000000000000000000000000000000000000@P0 J000000000000000000000000000000000000@P0 \000000000000000000000000000000000000@P8 @P8 @P8@P8 @P8 @P8 w@P8 k@P8 @P8@P8 @P8 @P0 + @P8@P0 %301 @P0 '302 @P0 )303 @P8 @P8 @P0 000000000000@P8@P0 000000000000@P0 000000000000@P0 000000000000@P8 P P WFUPDAT B56 F CCS CCS 3.0 SL-149@PTTT0 TTTT33 : < ) :3 < . . \33 : < '30 : < .  \@P3+ : < %30 : < . 'T0 T300 13T H3 -\ lT 03; ; : @PV :T0 o\33 : < + :3 < .̶  T B3\ 0 ; 30 : :\0 W TTTTT@P33̻ 3'\ E3 -T \ 70 / T\\\3\̝ &\3; H -@P\\ T\\\T3= '3TG H3 -\\0 9H/PFUPDATPUPINITLABHANNXTRANTOTALP UPDENDGETMASCCSCSTRSWIT 6UPDRECFILERRCCSADDPPRTLINXFORMLNgUNCUPDyPCONUPD{ADDIT }COSUPDWRITERUPDIT REACITP P WUPINIT C49 F CCS CCS 3.0 SL-149@P@P T -d0 d 0d T3 : ~3 ; :T33 : ? 3 : ? 8"d @P4h h "p8n (h 1 T3 (T33 < - T @P_  \30 .\30 < -\  d 3\X &\33X < -3\\ 0 &@P3\ <3 -\\30g6̽ &\630 < -\3\Eh̰ &\33h < -3\\w0̣ &;\ <@P -\\30̖ &\30 < -\3TM00 (TV30 < -T0\ "0 5 #;\%@P &3\ <0 -\\3 .٤  \30 < -\0 d dT330 F8¤ @P ̽0 ̸ &\X30 F -\ B, hT'0; > P@P0% ; P0 G 1\300 H̖ 0  (T3X F0 -T03 H h/T2@P0P$ C)d T3 > I\30 >   &\30 F -\  8 d@P|HPUPINIT~PAMONTOADAYTOAYERTOPGMIN EDIT CCSMVA OPENFLFILERR@UPDENDFREADR ICCSADNCCSBLKVP P WLABHAN B67 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT   T3 < hT3 : Sz0 S 1\@P \3 < h3T lHPLABHANPNXTRANTAPMOTCCSMVACLOSFLP P WLNXTRAN B85 F CCS CCS 3.0 SL-149@P@P@P1h T300 1'0 T30 G -T dT 1 @P. T0T h  l @P0< T 9HPNXTRANHPSTATIT2GETS FILERRUPDEND"FREAD (DISP 0CCSE2AAP P WTOTALP C23 F CCS CCS 3.0 SL-149@P * TOTALS *  @P+ @P? @PD * P R E V I O U S@Po * @P @P ACCOUNTS NUMBER AMT DELQ PAYOFF AMT DELQ  PA@PYOFF @P @P ADDED  @P @P @P REACTIVATED  @P; @PO @PT UPDATED  @P @P @P RELEASED  @P @P @P SATISFIED  @P @P @P WRITTENOFF  @PK @P_ @Pd REJECTED  @P @P @P0 5 Bl dT31 @ ?3 : ?\ 3 @ ? :03 ?\ @13 ?b : ?3\ @ ?0 : ?\39 @ ?@P0 : ?\31 @ ?.3 : ?\ 3 @ ?r :0 ? h h D(hT@Pȵ  D(hT 5@Pا 1ء 1T1 =3 ; <\ 13 =" ; <1\ =f3 ; <\ 13 = ; <1\ =)3 ; <\ @P, =m ;03 <\ P =0 ; <\3 V = ;03 <\ J =09 ; <\3 =u :03 <\ t =0 : <\3 z = :0; <\ n =@P3WA : <1\ =|3 : <\ b13 = : <1\ h =3 : <\ \13 =H : < d D,hT@P} 1H"PTOTALPPCCSMVACCSGETCCSPUTEDIT  PRTLIN{P P WsUPDEND C47 F CCS CCS 3.0 SL-149@P? T00r 0\g0P 0\E0 0\w0 8\@P+ 3\0 3\%  3\쨷 3\Ũ ;\@P0V#  \00 T 0 =THPUPDENDoPCLOSFLTAPMOTgPGMOUTkP P WEGETMAS B58 F CCS CCS 3.0 SL-149@PT33 = I >3 : IT33 >   (T3 F0 -T @P0+   d0 l1THPGETMASAPCCSMVAREADR FILERRUPDEND%CCSBLK;P P WkRSWIT C16 F CCS CCS 3.0 SL-149@P@PWRS@P999 @P998 @P997 @P @P @P - ACCOUNT NOT IN ACCAGE @P0  d0T A0  /  l\ @0HhlT3; ?@P0E  ? 0(π h  (ʀ hT 0 ;@PV :@PX : ( Vh 0( Vh\ @Pg :@Pi : ( hh 0( hh\ @Px :@Pz : ( Dh 0( Dh\ @P :@P :\33 B 0 B\\33 I3 : I\31  : 03 ;\ 3 ? ?3Tw3 : (T@P3 D0 -TT3@ I30 > : IT3 >0  1ݤ0  \3; F -@P\\ 33 : K :0 KyT3 &\33 I -0\d00 \33  = 0; =\ @P3 < 03 <\ 33 B  B3\  B30  B\33  =3  = $h\@P3- : <3  @PA@PD@PG@PJ@PM(@PP@PS@PV@PY@P\@P_@PbT 33 : ? 0 ? h!( ( hʝ ʘ !hހhڀ hր@P h\@P@P0 1\ : :T0\ :1 :\1HPUNCUPDPCCSMVAcCCSPYTP P WCONUPD B32 F CCS CCS 3.0 PSrPD SL-149@PCm@PN@P- NO NON-FINANCIALS ACCEPTED@P@P03U@P @P@P!@P$@P'@P*@P- @P0@P3@P6 @P9@P<@P=@PB@PGT33  ? 93 9 . . 60 ژ(0T h\hȞ #Ț dhȗhT 0 :h\@Pr hȍ(Έh 1 )T :33 M : Mr hȵ!& ( h  @P!ȦhȢh ȞhT @P@P 9ؑ3\ N33 N .̓ 43TH 33 ? 9 900 . . &\33 ? 03 ?\ :3; I] : I@PT3 ]T33E] : (3Th D3 -T3\ N30 NHEPCONUPDPCCSCSTICCSAD[ICALJLlCCSMVACHNGNFCCSPUTPUTS FILERRUPDENDP P WCOSUPD B33 F CCS CCS 3.0 SL-149@P@P@P@P@PY@PT3 N 93 9 . . \13 N30 9 9 . \3 N 93 9 . YT3; : I@P00 : J\11 ;T33g  (T630 E -T 10/ *T@P3[g0  3&\6 F3 -\\11 ;T30g &\630 H -\@PH|PCOSUPDPCCSCSTCCSMVA+WRITER:FILERRIUPDENDOREADR ZUPDRECuP P W.UPDIT C48 F CCS CCS 3.0 SL-149@PT33  : 03 :\ 33 : :3\  30 : :\33  :3 :\ 033 ; : 0 :T >@P+HPUPDIT *PCCSADDFORMLN%P P WREACIT C14 F CCS CCS 3.0 PSrPD SL-149@P@P @P0 50l3T 33 =  =3\ : ?30 ?\33 9 9 H\31 9 90 CT ?;T 0 ;@P3- : 03 :\ 33 : :3\  30 : :\33 : I3 : TT33  (T@P3X E -T 1/T330  &3\ F0 -\T3 RT30 &\@P3 H -\T 33 : L :00 L "0 5 X 6lT3  703\ :33 I= : I3\ : =38= J =T@P0G00GdI00HdJdK\ 33 : EL :03 E\ " :33 QR : U3T%=3 : (TV3; D -@PT\0 \33= : &\33 D -\HPREACITPCCSMVAFORMLN'CCSADD*WRITERGFILERRUPDENDREADR bCCSBLKvUPDRECzPUTACFCCSTIMPUTS P P WPRTLIN C09 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T 0 ;33 : : d [@P05 d0 \ hT [ T 5 [ؿ 10 T1 V3 T;\  V@P3` \\ _13 V \T30 <0 (T3 D0 -T0 &̞ l \@P3 V0 \3\ V0 \3\ ;0 &3\ D0 -\̥ \13 V 8\\@P0 :̺ &\30 D -\T V H TThhh4PPRTLINPQ8PKUPQ8PREPCCSADD*CCSGETAYERTOBCCSCSTECCSMVAP PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP P*END 00022P._^1 200 IF(NEXT.LT.33) GO TO 210_^1C_(TABLE OVERFLOW. MORE THAN THE ALLOWED 32 ACTION CODES ENTERED._^1C_(REJECT THIS RECORD._^1_$GO TO 115_^11_]_^1C_(NO TABLE OVERFLOW. VERIFY UNIQUENESS OF THIS CODE._^1 210 K = BUF(J+1)_^1_$CALL AVMCKV(ACT,K)_^1_$IF(K.LT.0) GO TO 220_^1C_(CODE NOT UNIQUE, REJECT IT._^1_$GO TO 125_^11_]_^1C_(CODE UNIQUE. ACTION CODES CANNOT BE SCREEN FUNCTIONS. REJECT_^1C_(CODE IF IT IS._^1 220 K = BUF(J+1)_^1_$DO 225 L=1,NUMFUN_^1_$IF(K.NE.FUNCOD(L)) GO TO 225_^1C_(CODE IS A SCREEN FUNCTION CODE, REJECT IT._^1_$CALL FWRITE(LP,SCFMES,SCFMLN,COMPL2,FLAG,TEMP)_^1_$CALL DISP_^1 225 CONTINUE_^11_]_^1C_(CODE OK. EXTRACT FIFTH AND SIXTH CHARACTERS FROM RECORD_^1C_(WHICH CONTAIN ANY LETTER OR COMMENT REQUIREMENTS._^1_$CALL CCSGET(BUF(J),FIVE,K)_^1_$CALL CCSGET(BUF(J),SIX,L)_^1C_(ZERO REQUEST ACCUMULATOR._^1_$REQ = 0_^1C_(SAVE ANY LETTER AND COMMENT REQUEST._^1_$IF(K.EQ.$4C.OR.L.EQ.$4C) REQ = $80_^1_$IF(K.EQ.$43.OR.L.EQ.$43) REQ=REQ+$40_^1C_(EXTRACT NEXT CONTACT DATE._^1_$NCD = ICCSAD( BUF(J+3) )_^1C_(VERIFY NEXT CONTACT DATE IS WITHIN RANGE._^1_$IF(NCD.GE.0.AND.NCD.LT.64) GO TO 240_^1C_(NEXT CONTACT DATE OUT OF RANGE. SET IT TO ZERO AND REPORT ERRO_^1_$NCD = 0_^1_$GO TO 135_^11_]_^1C_(ADD NEXT CONTACT DATE TO ACCUMULATOR._^1 240 REQ = REQ + NCD_^11_]_^1C_(SAVE RESULT CODE AND ITS REQUIREMENTS._^1_$ACT(NEXT) = BUF(J+1)_^1_$REQS(NEXT) = REQS(NEXT) + REQ*$100_^1C_(CHECK FOR ADDITION YIELDING ZERO FOR $FFFF._^1_$IF(REQ.NE.0.AND.REQS(NEXT).EQ.0) REQS(NEXT)=NZERO_^12_]_^1C_(DETERMINE RESULT CODE BIT MASKS FOR THIS ACTION CODE._^1C_(ELIMINATE ANY DUPLICATE CODES. THE ROUITNE 'AVMCKD' WILL SET_^1C_(ANY DUPLICATE CODE TO BINARY ZERO, AND AS A RESULT WILL NOT_^1C_(HINDER BIT MASK CONSTRUCTION._^1_$CALL AVMCKD(BUF(J+4))_^1_$CALL AVMBIT(RES,BUF(J+4),BIT1(NEXT),BIT2(NEXT))_^1C_(REPORT ANY REJECTED RESULT CODES._^1_$J = J + 4_^1_$DO 260 K=1,32_^1_$L = J + K_^1_$IF(BUF(L).GE.0) GO TO 260_^1C_(THIS RESULT CODE REJECTED. CONVERT IT BACK TO ITS ORIGINAL FOR_^1C_(PLACE IT AND ITS HEXADECIMAL REPRESENTATION IN THE ERROR MESSA_^1C_(AND WRITE THE ERROR MESSAGE TO THE PRINTER._^1_$NRSMES(4) = -BUF(L)_^1_$CALL CCSHXA(NRSMES(4),NRSMES(7))_^1_$CALL FWRITE(LP,NRSMES,NRSMLN,COMPL4,FLAG,TEMP)_^1_$CALL DISP_^1 260 CONTINUE_^12_]_^1C_(INCREMENT CODE POINTER AND GET NEXT ACTION CODE RECORD._^1_$NEXT = NEXT + 1_^12_]_^1 300 CONTINUE_^1._]_^1C_(RETRIEVE OLD TABLE FROM FILE AND UPDATE WITH NEW TABLE._^1C_(ZERO REQUEST BUFFER._^1_$DO 405 I=1,24_^1 405 REQBUF(I) = 0_^11_]_^1C_(CLEAR THE FILE._^1_$CALL CLEAR(REQBUF,AMDATA,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 450_^1C_(NO ERROR, OPEN THE FILE._^1_$CALL OPENFL(REQBUF,AMDATA,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 460_^1C_(NO ERROR, SAVE THE NEW TABLE IN THE FILE._^1_$CALL PUTS(REQBUF,TABLE,ONE,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 470_^1C_(NO ERROR, UPDATE SUCCESSFUL. CLOSE FILE AND PROCEED TO UPDATE_^1C_(UTILITY FILE SECTION._^1_$CALL CLOSFL(REQBUF,ISTAT)_^1_$GO TO 500_^12_]_^1C_(FILE MANAGER ERRORS USING FILE 'ACTVERTB'._^11_]_^1C_(CLEAR FILE REQUEST._^1 450 J = 1_^1_$GO TO 480_^11_]_^1C_(OPEN FILE REQUEST._^1 460 J = 3_^1_$GO TO 480_^11_]_^1C_(PUTS REQUEST._^1 470 J = 11_^11_]_^1 480 CALL FILERR(AMDATA,J,ISTAT,LU)_^1_$GO TO 900_^1._]_^1C_(UPDATE UTILITY FILE RECORDS. SORT ACTION CODE AND RESULT CODE_^1C_(ARRAYS INTO ALPHABETICAL ORDER._^1 500 CALL AVMSRT(ACT)_^1_$CALL AVMSRT(RES)_^11_]_^1C_(OPEN UTILITY FILE AND UPDATE 'ACTC' AND 'RESC' RECORDS._^1C_(ZERO REQUEST BUFFER FIRST._^1_$DO 505 I=1,32_^1 505 REQBUF(I) = 0_^11_]_^1_$CALL OPENFL(REQBUF,UTDATA,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 550_^1C_(NO ERROR, RETRIEVE 'ACTC' RECORD._^1_$CALL READR(REQBUF,BUF,ACTC,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 560_^1C_(NO ERROR, MOVE IN NEW ACTION CODES._^1_$CALL CCSMVA(ACT,ONE,NUMBYT,BUF(3),ONE,NUMBYT)_^1C_(SAVE UPDATED RECORD._^1_$CALL UPDREC(REQBUF,BUF,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 570_^11_]_^1C_(UPDATE 'RESC' RECORD._^1_$CALL READR(REQBUF,BUF,RESC,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 560_^1C_(NO ERROR, MOVE IN NEW RESULT CODES._^1_$CALL CCSMVA(RES,ONE,NUMBYT,BUF(3),ONE,NUMBYT)_^1C_(SAVE UPDATED RECORD._^1_$CALL UPDREC(REQBUF,BUF,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 570_^1C_(NO ERROR, CLOSE FILE. MATRIX CONSTRUCTION COMPLETE._^1_$GO TO 900_^12_]_^1C_(FILE MANAGER ERRORS USING UTILITY FILE._^11_]_^1C_(OPEN FILE REQUEST._^1 550 J = 3_^1_$GO TO 580_^11_]_^1C_(READR REQUEST._^1 560 J = 13_^1_$GO TO 580_^11_]_^1C_(UPDREC REQUEST._^1 570 J = 15_^11_]_^1 580 CALL FILERR(UTDATA,J,ISTAT,LU)_^1_$GO TO 900_^1._]_^1C_(PRINT REPORT STYLE HEADINGS._^11_]_^1C_(GET TOP OF FORM._^1 600 ASSIGN 610 TO ICOMPL_^1_$CALL FWRITE(LP,TOF,TOFLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_(OUTPUT HEADINGS._^1 610 HDLEN = 40_^1_$ASSIGN 620 TO ICOMPL_^1_$DO 620 I=1,5_^1_$J = 20*(I-1) + 1_^1_$IF(I.EQ.4) HDLEN=60_^1_$IF(I.EQ.5) J=91_^1_$CALL FWRITE(LP,HEAD(J),HDLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1 620 CONTINUE_^1_$GO TO IRTN_^1._]_^1C_(CLOSE ANY FILES AND EXIT._^1 900 CALL CLOSFL(REQBUF,ISTAT)_^12_]_^1 950 CALL PGMOUT_^1_$END_]_^1_$SUBROUTINE AVMCKD(ARR)_^1_#1_2/CCS 2.0_;02-20-78_^1C_]_^1C_#SCAN ARRAY CHECKING EACH ELEMENT FOR UNIQUENESS._^1C_]_^1C_#ROUTINE TO SCAN ARRAY 'ARR' FOR A MAXIMUM OF 32 WORDS OR UNTIL AN_^1C_#'**' IS ENCOUNTERED, CHECKING FOR EACH ELEMENT TO BE UNIQUE WHEN_^1C_#COMPARED TO THE OTHER ELEMENTS. IF A DUPLICATE ENTRY IS FOUND, THE_^1C_#ENTRY IS FLAGGED BY SETTING IT TO ZERO. THIS WILL CAUSE BYPASS_^1C_#OF THIS CODE WHEN BIT MASK IS CONSTRUCTED._^1C_]_^1_$INTEGER ARR(1),ASTRKS_^1_$DATA ASTRKS/'**'/_^12_]_^1_$DO 20 I=1,32_^1_$IF(ARR(I).EQ.ASTRKS) GO TO 90_^1_$DO 10 J=1,32_^1_$IF(ARR(J).EQ.ASTRKS) GO TO 20_^1_$IF(I.EQ.J.OR.ARR(J).EQ.0) GO TO 10_^1_$IF(ARR(I).EQ.ARR(J)) ARR(J)=0_^1 10 CONTINUE_^1 20 CONTINUE_^11_]_^1 90 RETURN_^1_$END_]_^1_$SUBROUTINE AVMSRT(ARR)_^1_#1_2/CCS 2.0_;02-19-78_^1C_]_^1C_#SORT 32 WORD ARRAY 'ARR'._^1C_]_^1C_#ROUTINE TO PERFORM AN ALPHABETICAL SORT OF THE ELEMENTS OF THE ARR_^1C_#'ARR'. 'ARR' IS 32 WORDS LONG, BUT CAN CONTAIN FEWER ELEMENTS WHEN_^1C_#TERMINATED BY ONE ELEMENT CONTAINING '**'. THE DOUBLE ASTERISK_^1C_#SHOULD NOT BE SORTED, BUT LEFT AT THE END OF THE LIST._^1C_]_^1C_#SORT IS A BUBBLE SORT._^1_$INTEGER ARR(1),TEMP,ASTRKS_^11_]_^1_$DATA ASTRKS/'**'/_^11_]_^1_$K = 1_^1_$IF(ARR(2).EQ.ASTRKS) GO TO 90_^1_$IF(ARR(2).GT.ARR(1)) GO TO 10_^1_$TEMP = ARR(2)_^1_$ARR(2) = ARR(1)_^1_$ARR(1) = TEMP_^1 10 DO 30 I=2,31_^1_$IF(ARR(I+1).EQ.ASTRKS) GO TO 90_^1_$IF(ARR(I).LT.ARR(I+1)) GO TO 30_^1_$TEMP = ARR(I)_^1_$ARR(I) = ARR(I+1)_^1_$ARR(I+1) = TEMP_^1_$DO 20 J=I,2,-K_^1_$IF(ARR(J).GT.ARR(J-1)) GO TO 30_^1_$TEMP = ARR(J)_^1_$ARR(J) = ARR(J-1)_^1_$ARR(J-1) = TEMP_^1 20 CONTINUE_^1 30 CONTINUE_^11_]_^1C_#SORT COMPLETE._^1 90 RETURN_^1_$END_]_^1 MON_]_^1*ASSEM_]_^1 OPT LCX_]_^1_%NAM AVMBIT_%CCS 2.0_<06-08-78_^1*_]_^1*_$CONSTRUCT BIT MASKS._^1*_]_^1*_$ROUTINE TO REVIEW EACH CODE IN 'VRES' AND IF THE CODE IS IN 'RES'_^1*_$SET THE CORRESPONDING BIT IN EITHER 'BIT1' OR 'BIT2'. IF A CODE_^1*_$IN 'VRES' IS NOT FOUND IN 'RES', THE CODE IS FLAGGED FOR REPORTIN_^1*_$AS AN ERROR BY 'AVMCON'. 'BIT1' IS BIT MASK FOR RESULT CODES 1-16_^1*_$AND 'BIT2' IS FOR RESULTS 17-32 ._^1*_]_^1*_$CALLING SEQUENCE:_^1*_$CALL AVMBIT(RES,VRES,BIT1,BIT2)_^1*_$WHERE:_^1*_$RES_!- LIST OF ALL VALID RESULT CODES._^1*_$VRES - LIST OF RESULT CODES BIT MASKS ARE TO BE CONSTRUCTED FOR._^1*_$BIT1 - RETURNED BIT MASK FOR RESULT CODES 1 - 16._^1*_$BIT2 - RETURNED BIT MASK FOR RESULT CODES 17 - 32._^1*_]_^1_%SPC 2_^1_%ENT AVMBIT_^1_%SPC 2_^1*_$COMMUNICATIONS REGION USED._^1_%EQU LPMASK($2)_^1_%EQU NZERO($12)_^1_%EQU ZERO($22)_^1_%EQU ONEBIT($23)_^1_%SPC 2_^1_%EXT AVMCKV_'CHECKS FOR PARTICULAR ELEMENT IN AN ARRAY._^1_%EJT_]_^1AVMBIT 0_"0_^1_%LDQ* AVMBIT_'PICK UP ADDRESS OF CALLER._^1_%INQ 4_,INCREMENT RETURN VALUE TO NEXT EXECUTABLE_^1_%STQ* AVMBIT_'INSTRUCTION._^1_%RTJ* PARGET_'PICK UP PARAMETER ADDRESSES._^1_%LDA* RES_*PICK UP ADDRESS OF RES FOR SUBROUTINE CALL._^1_%STA* CON150_'STORE INTO PARAMETER LIST OF CALL._^1_%ENA 0_^1_%XFA 1_,ZERO BIT MASKS R1 AND R2._^1_%XFA 2_^1CON050 XFA I_,I IS POINTER INTO VRES._^1_%LDA* (VRES),I_$PICK UP NEXT CODE FROM VRES._^1_%SAN CON055_'SKIP IF CODE IS NON-ZERO._^1_%JMP* CON300_'CODE WAS ZERO FROM DUPLICATE ENTRY. BYPASS._^1CON055 STA* POS_*SAVE IN LOCAL VARIABLE._^1_%EOR* ASTRKS_'CHECK FOR TERMINATION - END OF CODES IN VRES._^1_%SAN CON100_'SKIP IF NOT THE END._^1CON060 SR1* (BIT1)_'CONSTRUCTION COMPLETE. SAVE BIT MASKS R1 AND R_^1_%SR2* (BIT2)_'IN BIT1 AND BIT2._^1_%JMP* CON500_'EXIT RETURN._^1CON100 RTJ AVMCKV_'CHECK IF VRES(I) IS IN RES._^1CON150 NUM 0_,ADDRESS OF RES._^1_%ADC POS_*ADDRESS OF VRES(I)._^1_%LDA* POS_*CHECK FOR VRES(I) NOT IN RES._^1_%SAP CON160_'SKIP IF VRES(I) IN RES._^1_%LDA* (VRES),I_$ILLEGAL CODE IN VRES, FLAG IT AS AN ERROR._^1_%TCA A_^1_%STA* (VRES),I_$SET TO ITS COMPLEMENT AS THE FLAG._^1_%JMP* CON300_'CONTINUE PROCESSING IGNORING THIS CODE._^1CON160 XFA Q_,SAVE RETURNED INDEX IN Q._^1_%AND- ONEBIT+4_$CHECK WHICH REGISTER TO SET BIT IN._^1_%ANQ- LPMASK+4_$INDEX ONLY BY FIRST FOUR BITS._^1_%TCQ Q_,COMPLEMENT TO GET INDEX FROM END OF MASK TABLE_^1_%SAN CON200_'SKIP IF BIT TO BE SET IS IN R2._^1_%AR1- ONEBIT+15,Q_!RESULT CODE WAS IN FIRST 16, SET APPROPRIATE B_^1_%S1N CON300-*-1_"SKIP IF ADDITION DID NOT YIELD ZERO._^1_%LR1- NZERO_(SET TO $FFFF IF ADDITION CAUSED MASK TO GO TO_^1_%JMP* CON300_^1CON200 AR2- ONEBIT+15,Q_!RESULT CODE WAS IN 2ND 16, SET APPROPRAITE BIT_^1_%S2N CON300-*-1_"SKIP IF ADDITION DID NOT YIELD ZERO._^1_%LR2- NZERO_(SET TO $FFFF IF ADDITION CAUSED MASK TO GO TO_^1CON300 XFI A_,BUMP POINTER TO GET NEXT CODE FROM VRES._^1_%INA -31_*CHECK IF MAXIMUM NUMBER OF CODES PROCESSED._^1_%SAM CON350_'SKIP IF MAXIMUM NUMBER NOT PROCESSED._^1_%JMP* CON060_'ALL CODES DONE, SAVE BIT MASKS AND EXIT._^1CON350 INA 32_+RESTORE POINTER TO GET NEXT CODE._^1_%JMP* CON050_'GO GET NEXT CODE._^1_%EJT_]_^1*_$VARIABLES AND CONSTANTS USED._^1*_]_^1RES_"NUM 0_,ABSOLUTE ADDRESS OF RESULT CODE ARRAY._^1VRES_!NUM 0_,ABSOLUTE ADDRESS OF VALID RESULT CODES ARRAY._^1BIT1_!NUM 0_,ABSOLUTE ADDRESS OF BIT MASK FOR RESULTS 1 - 1_^1BIT2_!NUM 0_,ABSOLUTE ADDRESS OF BIT MASK FOR RESULTS 17 -_^1ASTRKS NUM $2A2A_(LITERAL ASTERISKS._^1POS_"NUM 0_,LOCAL VARIABLE USED FOR SUBROUTINE CALL._^1_%EJT_]_^1*_$ROUTINE TO PICK UP PARAMETER ADDRESSES FROM CALLER._^1*_]_^1PARGET 0_"0_^1_%LDQ* AVMBIT_'CONTAINS THE STARTING ADDRESS + 4 OF PARAMETER_^1_%INQ -1_+LIST. MOVE TO END OF LIST._^1_%ENA 3_^1_%XFA I_,I IS INDEX INTO PARAMETER STORAGE._^1PAR100 LDA- (ZERO),Q_$PICK UP ABSOLUTE ADDRESS OF NEXT PARAMETER._^1_%STA* RES,IV_(STORE INTO PARAMETER STORAGE._^1_%INQ -1_+DECREMENT TO GET NEXT PARAMETER ADDRESS._^1_%DIP *-PAR100_$SKIP IF ALL PARAMETERS PICKED UP._^1_%JMP* (PARGET)_$RETURN._^1_%EJT_]_^1CON500 JMP* (AVMBIT)_$EXIT RETURN._^1_%END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,AVMCON,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__VPAVMDMP CSY/ AVM 0020P1*K,P2,L9,I7_^1*FTN_]_^1_$PROGRAM AVMDMP_^1_#1_2/CCS 2.0_;06-08-78_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^1C_]_^1C_#DUMP ACTIVITY VERIFICATION MATRIX._^1C_]_^1C_#THIS PROGRAM WILL PRINT AN INTELLIGIBLE DUMP OF THE ACTIVITY VERI-_^1C_#FICATION MATRIX STORED IN THE FILE 'ACTVERTB'. THE MATRIX CALLED_^1C_#'TBL' CONTAINS A LIST OF ALL VALID ACTION CODES, LIST OF ALL VALID_^1C_#RESULT CODES, MASKS FOR DETERMINING VALID ACTION/RESULT CODE PAIRS_^1C_#AND DEFAULT VALUES FOR NEXT CONTACT DATE AND LETTER AND COMMENT_^1C_#REQUIREMENTS FOR EACH PAIR THAT IS VALID. A MORE DETAILED DESCRIP-_^1C_#TION OF 'TBL' IS FOUND IN THE AVMVAC SUBROUTINE._^1C_]_^11_]_^1_$INTEGER REQBUF(24),IDATA(15),TBL(162),ACT(1),RES(1),OBUF(66)_^1_$INTEGER ASTRKS,LETREQ,COMREQ,NCD,BZ,RL,LREQD,CREQD,ONE,DP,NA,SR,PP_^1_$INTEGER HEAD1(21),HEAD2(10),HEAD3(3),HEAD4(6),HEAD5,HEAD6(7)_^1_$INTEGER FLAG,TEMP(8),LEN,TOF,LF_^1_$INTEGER BLANKS,NC,WRITE,STDHDR(20,3),DATE(3),HEAD7(5),HDRLEN_^1_$INTEGER ASCZER,LENHD1,LENHD2,HDRONE,HDRTWO,HDRTHR,ONE,TWO,DATFLD_^1_$INTEGER LENHD6,LENHD7,DATPOS,TILPOS,ZEROES,SIXTEN,ERRLEN,ASCNIN_^11_]_^1_$DATA ASTRKS/'**'/,BZ/'BZ'/,RL/'RL'/,LREQD/'L '/,CREQD/'C '/,_^1_#1_$ONE/'01'/,DP/'DP'/,NA/'NA'/,SR/'SR'/,PP/'PP'/,BLANKS/' '/_^1_$DATA NC/'NC'/_^1_$DATA HEAD1/'CCS 2 ACTIVITY VERIFICATION MATRIX_"PAGE'/_^1_$DATA HEAD2/'R E S U L T C O D E'/_^1_$DATA HEAD3/'ACT_!'/_^1_$DATA HEAD4/'ION_!L C CD'/_^1_$DATA HEAD5/'--'/_^1_$DATA HEAD6/'END OF MATRIX '/_^1_$DATA HEAD7/'RUN DATE: '/_^1_$DATA IDATA/'ACTVERTB',8*$2020,0,1,0/,FLAG/0/,LEN/132/,LF/$D20/,_^1_#1_$TOF/$C20/,REQBUF/24*0/,OBUF/66*$2020/_^1_$DATA ASCZER/$2030/,LENHD1/34/,LENHD2/20/,HDRONE/1/,HDRTWO/41/,_^1_#1_$HDRTHR/81/,ONE/1/,TWO/2/,LENHD6/14/,LENHD7/10/_^1_$DATA DATPOS/63/,TILPOS/45/,ZEROES/$3030/,SIXTEN/$3136/,ERRLEN/44/_^1_$DATA ASCNIN/$39/,HDRLEN/40/,DATFLD/1/,LP/9/_^12_]_^1_$EQUIVALENCE (TBL(1),ACT(1)),(TBL(33),RES(1))_^12_]_^1C_#LOGIN SECTION._^1_$CALL PGMIN(TEMP,LU,I,J)_^1C_#VERIFY MASTER CONSOLE ONLY. EXIT IF NOT._^1_$IF(J.NE.0) GO TO 900_^12_]_^1C_#RETRIEVE TBL FROM FILE._^1 100 CALL OPENFL(REQBUF,IDATA,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 810_^1C_#RETRIEVE TBL, THEN CLOSE FILE._^1_$CALL GETS(REQBUF,TBL,TEMP,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 820_^1_$CALL CLOSFL(REQBUF,ISTAT)_^11_]_^1C_#RETRIEVE STANDARD HEADINGS FOR OUTPUT._^1_$CALL UTHEAD(STDHDR,DATE)_^1._]_^1C_]_^1C_#DUMP MATRIX SHOWING FOR EACH ACTION/RESULT CODE PAIR WHETHER THE_^1C_#COMBINATION IS VALID. ALSO IF IT IS VALID, SHOW THE DEFAULT VALUE_^1C_#IN DAYS FOR NEXT CONTACT AND ANY LETTER OR COMMENT REQUIREMENTS._^1C_]_^1C_#INTIALIZE VARIABLES._^1 200 I = 1_^1_$J = 1_^1_$N = ASCZER_^1_$ASSIGN 450 TO WRITE_^1C_#CHECK IF ANY RESULTS TO PROCESS THIS ROUND._^1 210 IF(RES(J).EQ.ASTRKS) GO TO 355_^1C_]_^1C_#OUTPUT HEADINGS._^1C_]_^1C_#BLANK OUTPUT BUFFER._^1_$CALL CCSBLK(OBUF,LEN)_^1C_#SET TOP OF FORM._^1_$OBUF(1) = TOF_^1_$CALL CCSMVA(HEAD1,ONE,LENHD1,OBUF,TILPOS,LENHD1)_^1C_#SET PAGE NUMBER._^1_$N = N+1_^1_$OBUF(57) = HEAD1(20)_^1_$OBUF(58) = HEAD1(21)_^1_$OBUF(59) = N_^1C_#MOVE IN STANDARD HEADING._^1_$CALL CCSMVA(STDHDR,HDRONE,HDRLEN,OBUF,TWO,HDRLEN)_^1_$ASSIGN 215 TO ICOMPL_^1_$GO TO WRITE_^1C_#MOVE IN SECOND LINE OF HEADING BLANKING REMAINING BUFFER._^1 215 CALL CCSMVA(STDHDR,HDRTWO,HDRLEN,OBUF,ONE,LEN)_^1C_#MOVE IN DATE._^1_$TILPOS = TILPOS + 8_^1_$CALL CCSMVA(HEAD7,ONE,LENHD7,OBUF,TILPOS,LENHD7)_^1_$CALL EDIT(DATE,ONE,OBUF,DATPOS,DATFLD)_^1_$ASSIGN 220 TO ICOMPL_^1_$GO TO WRITE_^1C_#MOVE IN THIRD LINE OF HEADING BLANKING REMAINING BUFFER._^1 220 CALL CCSMVA(STDHDR,HDRTHR,HDRLEN,OBUF,ONE,LEN)_^1_$ASSIGN 225 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 225 CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$TILPOS = TILPOS + 3_^1_$CALL CCSMVA(HEAD2,ONE,LENHD2,OBUF,TILPOS,LENHD2)_^1_$ASSIGN 230 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1_$TILPOS = TILPOS - 11_^1 230 CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$OBUF(2) = $20_^1_$IF(J.NE.1) GO TO 235_^1_$L = ZEROES_^1_$GO TO 240_^1 235 L = SIXTEN_^1 240 DO 245 K=1,16_^1_$L = L+1_^1_$IF(AND(L,$FF).GT.ASCNIN) L=L+$F6_^1 245 OBUF(4*K+2) = L_^1 250 ASSIGN 255 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 255 CALL CCSBLK(OBUF,LEN)_^1_$DO 260 K=1,3_^1 260 OBUF(K) = HEAD3(K)_^1_$L = J + 15_^1_$DO 265 K=J,L_^1_$IF(RES(K).EQ.ASTRKS) GO TO 270_^1_$M = AND(K-1,$F) + 1_^1 265 OBUF(4*M+1) = RES(K)_^1 270 ASSIGN 275 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 275 CALL CCSBLK(OBUF,LEN)_^1_$DO 280 K=1,3_^1 280 OBUF(K) = HEAD4(K)_^1_$DO 285 K=1,16_^1_$OBUF(4*K+0) = HEAD4(4)_^1_$OBUF(4*K+1) = HEAD4(5)_^1 285 OBUF(4*K+2) = HEAD4(6)_^1_$ASSIGN 290 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 290 CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = HEAD5_^1_$OBUF(2) = AND($FF20,HEAD5)_^1_$DO 300 K=1,16_^1_$OBUF(4*K+0) = HEAD5_^1_$OBUF(4*K+1) = HEAD5_^1 300 OBUF(4*K+2) = HEAD5_^1_$ASSIGN 305 TO ICOMPL_^1_$GO TO WRITE_^1._]_^1C_#HEADINGS COMPLETE. PROCESS ACTION/RESULT CODE PAIRS FILLING THE_^1C_#OUTPUT BUFFER WITH THE INFORMATION PERTAINING TO EACH PAIR._^1 305 L = I+15_^1C_#LOOP THRU ALL ACTION CODES CHECKING ALL POSSIBLE RESULTS WITH IT._^1_$DO 350 K=I,L_^1C_#CHECK IF ALL ACTION CODES DONE._^1_$IF(ACT(K).EQ.ASTRKS) GO TO 355_^1C_#BLANK OUTPUT BUFFER AND OUTPUT TWO BLANK LINES FOR TRIPLE SPACING._^1_$CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$ASSIGN 310 TO ICOMPL_^1_$GO TO WRITE_^1 310 OBUF(1) = ACT(K)_^1_$II = J + 15_^1C_#LOOP THRU ALL RESULT CODES._^1_$DO 340 M=J,II_^1C_#CHECK IF ALL RESULT CODES CHECK WITH THIS ACTION CODE._^1_$IF(RES(M).EQ.ASTRKS) GO TO 345_^1C_#CHECK THIS ACTION/RESULT CODE PAIR._^1_$CALL AVMVAC(TBL,ACT(K),RES(M),LETREQ,COMREQ,NCD)_^1_$JJ = 4 * (AND(M-1,$F) + 1) - 2_^1C_#CHECK IF THIS ACTION/RESULT CODE PAIR ALLOWED (NCD > OR = 0)._^1_$IF(NCD.LT.0) GO TO 330_^1C_#PAIR VALID. SET LETTER AND COMMENT REQUIREMENTS IF ANY._^1 320 IF(LETREQ.NE.0) OBUF(JJ+2)=LREQD_^1_$IF(COMREQ.NE.0) OBUF(JJ+3)=CREQD_^1C_#CHECK FOR ACTION = SR, RESULT = PP OR BZ, OR NCD = 0 INDICATING_^1C_#SPECIAL VALUE FOR NEXT CONTACT._^1_$IF(ACT(K).EQ.SR) OBUF(JJ+4)=ONE_^1_$IF(RES(M).EQ.PP) OBUF(JJ+4)=DP_^1_$IF(RES(M).EQ.BZ) OBUF(JJ+4)=RL_^1_$IF(OBUF(JJ+4).NE.BLANKS) GO TO 340_^1_$IF(NCD.EQ.0)_#OBUF(JJ+4)=NC_^1_$IF(OBUF(JJ+4).NE.BLANKS) GO TO 340_^1C_#CONVERT NEXT CONTACT DATE._^1_$OBUF(JJ+4) = (NCD/10 * $100) + AND(NCD-(NCD/10)*10,$F) + ZEROES_^1_$GO TO 340_^1 330 OBUF(JJ+4) = NA_^1 340 CONTINUE_^11_]_^1C_#OUTPUT BUFFER._^1 345 ASSIGN 350 TO ICOMPL_^1_$GO TO WRITE_^1 350 CONTINUE_^11_]_^1C_#CHECK IF MORE ACTION/RESULT CODES TO CHECK._^1 355 IF((I.EQ.17.AND.J.EQ.17).OR.(I.EQ.17.AND.M.LT.17).OR.(J.EQ.17.AND._^1_#1_$K.LT.17).OR.(M.LT.17.AND.K.LT.17)) GO TO 400_^1_$IF(J.EQ.17) GO TO 370_^11_]_^1_$J = 17_^1_$GO TO 210_^11_]_^1 370 I = 17_^1_$J = 1_^1_$GO TO 210_^1._]_^1C_]_^1C_#MATRIX OUTPUT COMPLETE. OUTPUT END OF MATRIX MESSAGE AND EXIT._^1C_]_^1 400 CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$ASSIGN 405 TO ICOMPL_^1_$GO TO WRITE_^1 405 TILPOS = TILPOS + 4_^1_$CALL CCSMVA(HEAD6,ONE,LENHD6,OBUF,TILPOS,LENHD6)_^1_$ASSIGN 900 TO ICOMPL_^12_]_^1C_#WRITE FILLED OUTPUT BUFFER._^1 450 CALL FWRITE(LP,OBUF,LEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1._]_^1C_]_^1C_#FILE ERRORS._^1C_]_^1C_#OPENFL ERROR._^1 810 I = 3_^1_$GO TO 830_^11_]_^1C_#GETS ERROR._^1 820 I = 14_^11_]_^1C_#REPORT ERROR TO USER._^1 830 CALL FILERR(IDATA,I,ISTAT,LU)_^11_]_^1C_#FORCE FILE CLOSURE, BYPASS ANY ERROR._^1 850 CALL CLOSFL(REQBUF,ISTAT)_^13_]_^1C_#NORMAL TERMINATION._^1 900 CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*>N,AVMDMP,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ >PBLDSRN CSY/ BLD 0020P1*K,P2,L9,I7_^1*FTN_]_^1_%PROGRAM BLDSRN_^1_#1_2/CCS 2.0_;04-11-78_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^1C_]_^1C_#GENERATE SCREEN FILE FOR DISPLAY._^1C_]_^1C_#GENERATES A SCREEN FILE FROM 80 COLUMN INPUT RECORDS. INPUT IS FRO_^1C_#THE FILE 'SCRNDESC'. THIS FILE IS LOADED ONTO THE SYSTEM VIA A PRO_^1C_#CEDURE STREAM, MODIFIED WITH THE EDITIOR, USED FOR INPUT TO THIS_^1C_#PROGRAM, AND FINALLY SAVED ON TAPE. EACH RECORD IN THE SCREEN FILE_^1C_#'SCRNFILE' CONTAINS A SCREEN DEFINITION WITH ENOUGH INFORMATION TO_^1C_#TO CONSTRUCT A SCREEN. THE FORMAT FOR THE INPUT RECORDS FROM_^1C_#'SCRNDESC' IS:_^1C_7COLS_)DESCRIPTION_^1C_*FIRST CARD_!1 - 2_(SCREEN NUMBER._^1C_73 - 80_'COMMENTS._^1C_*NEXT N RECS 1 - 2_(LINE NUMBER FOR ITEM (01-24)_^1C_73 - 4_(COLUMN NUMBER FOR ITEM (01-80)._^1C_75 - 6_(LENGTH OF FIELD IN BYTES._^1C_77 - 10_'STARTING POSITION IN FILE IF_^1C_FAPPLICABLE._^1C_711_+FIELD TYPE FOR EDITING (SEE BELOW_^1C_712 - 80_%CONSTANT SCREEN FIELD._^1C_741 - 80_%COMMENTS IF NOT CONSTANT FIELD._^1C_*LAST RECORD 1 - 3_(CONSTANT 'END'._^1C_74 - 80_'COMMENTS._^1C_#THE LAST RECORD TO TERMINATE THE SCREEN FILE BUILD IS AN 'END'_^1C_#RECORD WITH THE 'END' STARTING IN COLUMN ONE._^1C_]_^1C_#FIELD TYPES USED ARE:_^1C_*0 = CONSTANT SCREEN FIELD._^1C_*1 = DATE IN FORM MM/DD/YY._^1C_*2 = ALPHA/NUMERIC IN FILE._^1C_*3 = NINE DIGIT DOLLAR AMOUNT IN FORM 9999999.99 ._^1C_*4 = TEN DIGIT PHONE NUMBER IN FORM 999/999-9999 ._^1C_*5 = RESTRICTED USAGE TO REPORT COLLECTION ACTIVITY._^1C_*6 = SOCIAL SECURITY NUMBER IN FORM 999-99-9999 ._^1C_*7 = TIME OF DAY IN 24 HOUR TIME, HHMM ._^1C_*8 = CONSTANT SCREEN FIELD LABELLING CHANGE SCREEN ITEM._^1C_*9 = MOST RECENT COLLECTION ACTIVITY._^1C_]_^1C_#DESCRIPTION OF THE OUTPUT SCREEN DEFINITION RECORD GIVEN IN THE_^1C_#DISPLY SUBROUTINE._^11_]_^1_$INTEGER X,Y,TEMP(8),INBUF(42),OBUF(902),NXTWRD,FLDTYP,_^1_#1_$LENGTH,KEY,FILPOS(2),FLAG,ENDMSG(15),ZERO,CSF(1)_^1_$INTEGER REQBF1(24),REQBF2(24),IDATA1(15),IDATA2(15)_^1_$INTEGER END,LP,ONE,SIX,TWO_^1_$INTEGER EIGHT,ENDLEN,OBFLEN,TC,XYN_^1_$INTEGER TOF,LF,TITLE1(13),TITLE2(5),POSTI1_^1_$INTEGER POSTI2,LENTI1,LENTI2,STDHDR(60),DATE(3),DATPOS,HDRONE_^1_$INTEGER HDRTWO,HDRLEN,FOUR,ASCTEN_^11_]_^1_$EQUIVALENCE (INBUF(1),KEY),(INBUF(1),Y),(INBUF(2),X),_^1_#1_#(INBUF(3),LENGTH),(INBUF(4),FILPOS(1)),(INBUF(6),CSF(1))_^11_]_^1_$DATA REQBF1/24*0/,REQBF2/24*0/,IDATA1/'SCRNFILE',8*$2020,0,1,-1/,_^1_#1_$IDATA2/'SCRNDESC',8*$2020,0,1,-1/,OBUF/902*$2020/_^1_$DATA END/'EN'/,TWO/2/,LP/9/,ONE/1/,INPLEN/80/,FLAG/0/,ZERO/0/_^1_$DATA ENDLEN/30/,OBFLEN/1804/,XYN/-1/_^1_$DATA ENDMSG/$D0A,'SCREEN FILE BUILD COMPLETE '/_^1_$DATA TOF/$C00/,LF/$D20/,HDRLEN/40/_^1_$DATA TITLE1/'SCREEN FILE BUILD CCS 2.0 '/,TITLE2/'RUN DATE: '/_^1_$DATA POSTI1/45/,POSTI2/47/,LENTI1/25/,LENTI2/9/,DATPOS/57/_^1_$DATA HDRONE/1/,HDRTWO/41/,ASCTEN/$30/_^14_]_^1C_]_^1C_#PROGRAM LOGIN. MASTER CONSOLE USAGE ONLY ALLOWED._^1C_]_^1_$CALL PGMIN(TEMP,LU,I,J)_^1C_#EXIT IF NOT MASTER CONSOLE._^1_$IF(J.NE.0) GO TO 950_^11_]_^1C_#CLEAR SCREEN DECRIPTION FILE._^1_$CALL CLEAR(REQBF1,IDATA1,ISTAT)_^1C_#CHECK IF FILE OPEN OR OTHER ERROR._^1_$IF(ISTAT.LT.0) GO TO 810_^1C_#NO ERRORS, OPEN BOTH FILES. LOCK FILE UPON ACCESS._^1C_#ZERO OUT REQBF1 FIRST._^1_$DO 50 I=1,24_^1 50 REQBF1(I) = 0_^1_$CALL OPENFL(REQBF1,IDATA1,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 820_^1C_#NO ERROR._^1_$CALL OPENFL(REQBF2,IDATA2,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 830_^1C_#NO ERRORS. RETRIEVE STANDARD HEADERS FOR OUTPUT._^1_$CALL UTHEAD(STDHDR,DATE)_^1C_#START SCREEN FILE CONSTRUCTION._^1._]_^1C_]_^1C_#OUTPUT HEADER INFORMATION ON FRESH PAGE._^1C_]_^1C_#SET TOP OF FORM._^1 100 INBUF(1) = TOF_^1C_#MOVE IN FIRST LINE OF STANDARD HEADER BLANKING REMAINING BUFFER._^1_$CALL CCSMVA(STDHDR,HDRONE,HDRLEN,INBUF,TWO,INPLEN)_^1C_#MOVE IN FIRST LINE OF TITLE._^1_$CALL CCSMVA(TITLE1,ONE,LENTI1,INBUF,POSTI1,LENTI1)_^1C_#WRITE FIRST LINE._^1_$ASSIGN 110 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_#MOVE IN SECOND LINE OF STANDARD HEADER BLANKING REMAINING BUFFER._^1 110 CALL CCSMVA(STDHDR,HDRTWO,HDRLEN,INBUF,ONE,INPLEN)_^1C_#MOVE IN SECOND LINE OF TITLE._^1_$CALL CCSMVA(TITLE2,ONE,LENTI2,INBUF,POSTI2,LENTI2)_^1C_#MOVE IN RUN DATE._^1_$CALL EDIT(DATE,ONE,INBUF,DATPOS,ONE)_^1C_#WRITE SECOND LINE._^1_$ASSIGN 120 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_#WRITE THIRD LINE OF STANDARD HEADER WITH LINE FEED AT END._^1 120 STDHDR(60) = LF_^1_$ASSIGN 130 TO ICOMPL_^1_$CALL FWRITE(LP,STDHDR(41),HDRLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^12_]_^1C_]_^1C_#RETRIEVE DESIRED SCREEN DEFINITION._^1C_]_^1 130 CALL GETS(REQBF2,INBUF,TEMP,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 840_^1C_#CHECK FOR END OF SCREENS - TERMINATE IF YES._^1_$IF(KEY.EQ.END) GO TO 900_^11_]_^1C_#START NEW SCREEN. SET KEY INTO FIRST TWO BYTES OF OUTPUT RECORD._^1_$OBUF(1) = ICCSAD(KEY)_^1C_#OUTPUT SCREEN NUMBER AND TITLE._^1_$ASSIGN 150 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1 150 NXTWRD = 2_^11_]_^1C_#READ SCREEN DEFINITIONS._^1 200 CALL GETS(REQBF2,INBUF,TEMP,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 840_^1C_#LIST SCREEN DESCRIPTION RECORD INPUT._^1_$ASSIGN 205 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1C_#CHECK FOR END OF SCREEN DEFINITION._^1 205 IF(Y.EQ.END) GO TO 300_^11_]_^1C_#CONSTRUCT SCREEN DEFINITION FROM INPUT. CONSTRUCT FIRST WORD, X-Y_^1C_#POSITIONING. SAVE INDEX FOR SECOND WORD._^1_$ISAVE = NXTWRD + 1_^1_$OBUF(NXTWRD) = (ICCSAD(X)-1)*$100 + ICCSAD(Y)-1_^11_]_^1C_#SET SECOND WORD, THE LOCATION OF THE NEXT FIELD DESCRIPTION._^1C_#CONVERT FIELD TYPE AND LENGTH TO NUMBERS._^1_$FLDTYP = AND(INBUF(6)/$100,$F)_^1_$LENGTH = ICCSAD(LENGTH)_^1C_#CHECK IF FIELD TYPE = 0 OR 8, CONSTANT SCREEN FIELD._^1_$IF(FLDTYP.EQ.0.OR.FLDTYP.EQ.8) GO TO 210_^1_$OBUF(NXTWRD+1) = NXTWRD + 5_^1_$GO TO 220_^1C_#CONSTANT SCREEN FIELD. START OF NEXT FIELD DESCRIPTION MUST INCLUD_^1C_#ANY CHARACTERS SAVED._^1 210 OBUF(NXTWRD+1) = NXTWRD + 5 + (LENGTH+1)/2_^11_]_^1C_#GET THIRD WORD, LENGTH OF SCREEN ITEM._^1 220 OBUF(NXTWRD+2) = LENGTH_^11_]_^1C_#GET FOURTH AND FIFTH WORDS, FILE POSITION AND FIELD TYPE._^1_$IF(FLDTYP.EQ.0.OR.FLDTYP.EQ.8) GO TO 250_^1_$OBUF(NXTWRD+3) = ICCSAD(FILPOS(1))*100 + ICCSAD(FILPOS(2))_^1_$OBUF(NXTWRD+4) = FLDTYP_^1_$GO TO 260_^11_]_^1C_#CONSTANT SCREEN FIELD - SET STARTING POSITION IN FILE FIELD TO ONE_^1C_#AND SAVE THE FIELD TYPE AND CONSTANT SCREEN FIELD._^1 250 OBUF(NXTWRD+3) = 1_^1_$OBUF(NXTWRD+4) = FLDTYP_^1C_#SET STARTING BYTE INTO OBUF WHERE FIELD IS TO BE MOVED._^1_$J = (NXTWRD + 5) * 2 - 1_^1_$CALL CCSMVA(CSF,TWO,LENGTH,OBUF,J,LENGTH)_^1 260 NXTWRD = OBUF(NXTWRD+1)_^1_$GO TO 200_^12_]_^1C_#SCREEN COMPLETE. TERMINATE SCREEN DESCRIPTION AND SAVE RECORD._^1C_]_^1 300 OBUF(ISAVE) = 0_^1_$CALL WRITER(REQBF1,OBUF,OBUF(1),ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 850_^1C_#NO ERROR, BLANK OUTPUT BUFFER AND PROCESS NEXT SCREEN._^1_$CALL CCSBLK(OBUF,OBFLEN)_^1_$GO TO 100_^1._]_^1C_]_^1C_#FILE ERRORS._^1C_]_^1C_#CLEAR REQUEST, SCRNFILE._^1 810 I = 1_^1_$GO TO 825_^1C_#OPEN REQUEST, SCRNFILE._^1 820 I = 3_^1 825 CALL FILERR(IDATA1,I,ISTAT,LU)_^1_$GO TO 910_^1C_#OPEN REQUEST, SCRNDESC._^1 830 I = 3_^1_$GO TO 845_^1C_#GETS REQUEST, SCRNDESC._^1 840 I = 14_^1 845 CALL FILERR(IDATA2,I,ISTAT,LU)_^1_$GO TO 910_^1C_#WRITER REQUEST, SCRNFILE._^1 850 I = 12_^1_$GO TO 825_^11_]_^1C_#NORMAL TERMINATION. OUTPUT BUILD COMPLETE MESSAGE._^1 900 ASSIGN 905 TO ICOMPL_^1_$CALL FWRITE(LP,ENDMSG,ENDLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1 905 CALL WTREAD(LU,XYN,ENDMSG,ENDLEN,ZERO,ZERO,ZERO,TC)_^11_]_^1C_#FORCE FILE CLOSURES. IGNORE ANY ERRORS._^1 910 CALL CLOSFL(REQBF1,ISTAT)_^1_$CALL CLOSFL(REQBF2,ISTAT)_^1C_#EXIT._^1 950 CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,BLDSRN,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ PCCSDMP CSY/ CCS P1*K,I7,P2,L9_^1*FTN_]_^1_$PROGRAM CCSGDP_^1_#*_2/ GENERAL DUMP PGM_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^1C_#PROGRAM DUMPS SPECIFIC RECORDS FROM FM2.0 FILES, EITHER BY RECORD_^1C_'NUMBER OR KEY. ALSO DUMPS TAPE FILES._^1_$INTEGER BUFFER(2000), REQBUF(24), VOLNAM(4), FCBBFR(96)_^1_$INTEGER INBF(30), EXACT, Y, RECSPC(16), LEXT(3), LIT3(3),_^1_#* IDUSER(4), IDATA(15), LIT1(2), LIT2(2), SEQ(2), INDX(2),_^1_#* OVER(2), KEY(16), KEYSTP(16) , TAPE0(3)_^1_]_^1_$DATA Y/$5900/, LEXT/'EXACT '/, LU/12/, SEQ/'SEQ '/, INDX/'INDX'/_^1_$DATA OVER/'OVER'/_^1_$DATA IDATA/15*$2020/, VOLNAM/4*0/, REQBUF/24*0/_^1_$DATA TAPE0/'TAPE0 '/_^12_]_^1_]_^1_]_^1_$CALL PGMIN ( IDUSER, LUNIT, MDE, NOPRT)_^1_$WRITE (LUNIT, 9000)_^19000 FORMAT ( 'GENERAL DUMP PGM IN ')_^1100_!WRITE (LUNIT, 9001)_^19001 FORMAT ( ' ENTER FILE NAME(CR) TO BE DUMPED, (CR) TO TERMINATE' )_^1_$CALL INPUT (LUNIT, INBF, NCH)_^1_$IF (NCH .LE. 1) GO TO 8000_^1C_#CHECK IF TAPE OR FILE DUMPING_^1_$CALL CCSCST (INBF, 1, 5, TAPE0, 1, 5, IND)_^1_$IF (IND .NE. 0) GO TO 120_^1C_#TAPE DUMP_^1_$CALL TAPE ( LU, BUFFER, LUNIT)_^1_$GO TO 100_^1C_#CLOSE THE FILE (WHAT FILE) FOR GOOD LUCK_^1120_!CALL CLOSFL (REQBUF, MSTAT)_^1C_#OPEN FILE_^1_$CALL CCSMVA (INBF,1, NCH, IDATA, 1, 8)_^1_$IDATA(13) = 0_^1_$IDATA(14) = 1_^1_$IDATA(15) = 0_^1_$DO 130 I = 1, 24_^1130_!REQBUF(I) = 0_^1_$CALL OPENFL (REQBUF, IDATA, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 150_^1C_#ERROR IN OPEN_^1_$CALL FILERR (IDATA, 3, ISTAT, LUNIT)_^1_$GO TO 100_^1C_#GET FILE FCB TO DETERMINE RECORD LENGTH AND FILE TYPE_^1150_!CALL GETFCB (REQBUF, VOLNAM, INDEX, FCBBFR, JSTAT)_^1_$IF (JSTAT .GE. 0) GO TO 200_^1C_#ERROR IN GET FCB_^1_$CALL FILERR (IDATA, 7, JSTAT, LUNIT)_^1_$GO TO 100_^1200_!LREC = FCBBFR(1)_^1_$NRECM = FCBBFR(7)_^1_$NRECL = FCBBFR(8)_^1_$IDX = AND(FCBBFR(6), $0001)_^1C_#LREC = NUMBER OF BYTES IN RECORD_^1C_#NREC = NUMBER OF RECORDS IN FILE, ONLY SINGLE PRECSION NOW._^1C_#IDX = 1 IF INDEXED, 0 IF SEQUENTIAL_^1_$CALL CCSMVA (SEQ, 1, 4, LIT1, 1, 4)_^1_$IF (IDX .NE. 0) CALL CCSMVA (INDX, 1, 4, LIT1, 1 , 4)_^1_$CALL CCSMVA ($2020, 1, 1, LIT2, 1, 4)_^1_$IF (NRECM .NE. 0) CALL CCSMVA (OVER, 1, 4, LIT2, 1, 4)_^1_$WRITE (LUNIT, 9002) LIT1, LIT2, NRECL_^19002 FORMAT ( 'FILE IS ', 2A2,' AND CONTAINS ',2A2,I5,_^1_#* ' RECORDS.' )_^11_]_^1C_#FILE OPENED OKAY CONTINUE PROMPTING FOR WHAT RECORDS_^1_$IF (IDX .EQ. 0) GO TO 300_^1C_#PROMPT FOR WHICH INDEX_^1250_!WRITE (LUNIT, 9003)_^19003 FORMAT ( ' ENTER 0/1/2/3/4 (CR) FOR ACCESS BY RRN OR KEYS 1-4.')_^1_$CALL INPUT (LUNIT, INBF, NCH)_^1_$IF (NCH .EQ. 0) GO TO 100_^1C_#CONVERT CHARACTER TO INTEGER_^1_$CALL INTGR (INBF, 1, JRTYP)_^1C_#SAVE ACCESS TYPE IN REQUEST BUFFER_^1_$REQBUF(14) = JRTYP_^1_$IF (JRTYP .EQ. 0) IDX = 0_^1_$IF ( JRTYP.EQ.0) GO TO 300_^1C_#ASK OPERATOR FOR HORSESHOES (CLOSE COUNTS)_^1_$WRITE (LUNIT, 9004)_^19004 FORMAT ( ' ENTER Y(CR) IF AN EXACT KEY TO BE DUMPED, OTHERWISE DUM_^1_#*P WILL USE 1ST CLOSE KEY ')_^1_$CALL INPUT (LUNIT, INBF, NCH)_^1_$EXACT = 0_^1_$IF ( AND(INBF(1), $FF00) .EQ. Y) EXACT = 1_^11_]_^1300_!WRITE (LUNIT, 9005)_^19005 FORMAT ( ' ENTER STARTING RECORD NUMBER OR KEY VALUE ')_^1_$CALL INPUT (LUNIT, INBF, NCH)_^1_$IF (NCH .LT. 1) GO TO 100_^1_$IF (IDX .EQ. 1) GO TO 350_^1C_#CONVERT RECORD NUMBER TO INTEGER - ONLY SINGLE PRECISION_^1_$IF (NCH .GT. 5) GO TO 300_^1_$CALL INTGR (INBF, NCH, ISTR)_^1_$GO TO 400_^1C_#KEY ENTERED - SAVE_^1350_!CALL CCSMVA (INBF, 1, NCH, KEY, 1, 32)_^1_$IF ( EXACT .EQ. 1) GO TO 1000_^1400_!WRITE(LUNIT, 9006)_^19006 FORMAT ( ' ENTER ENDING RECORD NUMBER OR KEY VALUE ')_^1_$CALL INPUT ( LUNIT, INBF, NCH)_^1_$IF ( NCH .LT. 1) GO TO 500_^1_$IF ( IDX .EQ. 1) GO TO 450_^1C_#CONVERT RECORD NUMBER_^1_$IF (NCH .GT. 5) GO TO 400_^1_$CALL INTGR ( INBF, NCH, ISTP)_^1_$GO TO 1000_^1450_!CALL CCSMVA ( INBF, 1, NCH, KEYSTP, 1, 32)_^1_$GO TO 1000_^1C_#NO STOP ENTERED, ASSUME STOP EQUALS START_^1500_!ISTP = ISTR_^1_$IF (IDX .EQ. 1) CALL CCSMVA (KEY,1,32,KEYSTP,1,32)_^1._]_^1C_#INITIAL GO AT RETRIEVING A RECORD_^11000 DO 1010 I = 1,16_^11010 RECSPC(I) = 0_^1_$RECSPC(2) = ISTR_^1_$IF ( IDX .EQ. 1) CALL CCSMVA ( KEY, 1, 32, RECSPC, 1, 32)_^1_$CALL READR (REQBUF, BUFFER, RECSPC, KSTAT)_^1C_#CHECK 1ST FOR GOOD READ RIGHT ON RECORD_^1_$IF ( KSTAT .GE. 0 .AND. AND(KSTAT,$0200) .EQ. 0) GO TO 1100_^1C_#CHECK FOR CLOSE WHEN CLOSE IS GOOD ENOUGH_^1_$IF (KSTAT .GE. 0 .AND. EXACT .EQ. 0) GO TO 1100_^1C_#WE ARE LEFT WITH EITHER NO RETRIEVE OR A CLOSE WHEN WE WANTED TO_^1C_%EXACT RECORD_^1_$CALL FILERR ( IDATA, 13, KSTAT, LUNIT)_^1_$GO TO 100_^12_]_^1C_#GOOD INITIAL RETRIEVE, SET UP DUMP HEADINGS_^11100 WRITE (LU,9007)_^19007 FORMAT ( '1 FILE NAME TYPE RETRIEVAL_"KEY LIMITS')_^1_$IF (IDX .EQ. 1) GO TO 1150_^1C_#RECORD NUMBER HEADINGS_^1_$WRITE (LU,9008) (IDATA(I), I=1,4), LIT1, JRTYP, ISTR_^19008 FORMAT ( 4X, 4A2, 2X, 2A2, 5X, I1, 10X, I5)_^1_$WRITE (LU, 9009) ISTP_^19009 FORMAT (34X, I5, //)_^1_$GO TO 1200_^11_]_^1C_#KEY VALUE HEADINGS_^11150 CALL CCSMVA ($2020, 1, 1, LIT3, 1, 6)_^1_$IF (EXACT .EQ. 1) CALL CCSMVA(LEXT, 1, 6, LIT3, 1, 6)_^1_$WRITE (LU, 9010) (IDATA(I),I=1,4), LIT1, JRTYP, LIT3, KEY_^19010 FORMAT (4X, 4A2, 2X, 2A2, 5X, I1, 1X, 3A2, 3X, 16A2)_^1_$IF (EXACT .EQ. 1) GO TO 1200_^1_$WRITE (LU,9011) KEYSTP_^19011 FORMAT ( 34X, 16A2, //)_^1C_#CHECK IF KEY VALUE PAST LIMIT_^11175 CALL CCSCST ( RECSPC, 1, 32, KEYSTP, 1, 32, IND)_^1_$IF (IND .GT. 0) GO TO 100_^12_]_^1C_#PRINT THE RECORD_^11200 CALL SEEIT (LU,BUFFER, LREC, 0)_^1_$IF (EXACT .EQ. 1) GO TO 100_^1_$WRITE (LU, 9012)_^19012 FORMAT (1H0)_^11_]_^1C_#CHECK IF MORE RECORDS WANTED_^1_$IF (IDX .EQ. 1) GO TO 2000_^1C_#CHECK IF PAST RECORD NUMBER LIMIT_^1_$IF ( REQBUF(17) .GE. ISTP) GO TO 100_^11_]_^1C_#GET ADDITIONAL RECORDS_^12000 CALL GETS (REQBUF, BUFFER, RECSPC, LSTAT)_^1_$IF (LSTAT .GE. 0 .AND. IDX .NE. 1) GO TO 1200_^1_$IF ( LSTAT .GE. 0 .AND. IDX .EQ. 1 ) GO TO 1175_^1_$CALL FILERR (IDATA, 14, LSTAT, LUNIT)_^1_$GO TO 100_^1_]_^1_]_^13_]_^1C_#NORMAL TERMINATION, CLOSE FILE AND REPORT TO USER._^18000 CALL CLOSFL (REQBUF, MSTAT)_^1_$WRITE (LUNIT, 9100)_^19100 FORMAT ( 'GENERAL DUMP PROGRAM OUT. ')_^1_$CALL PGMOUT_^1_]_^1_]_^1_]_^1_]_^1_$END_]_^1_$SUBROUTINE SEEIT (LU, BUFFER, BLEN, MODE)_^1_#*_2/ PRINT BUFFER_^1_$INTEGER BUFFER(1), BLEN, VIEW(40), LINE(65), IWORK(3)_^1_$DATA LINE(1)/'0 '/_^1_]_^11_]_^1C_#BUFFER LENGTH TO WORDS AND POSSIBLE BLANK FILL_^1_$IWD = BLEN_^11_]_^1100_!WRITE ( LU, 9000)_^19000 FORMAT( '0_>1_^1_#*2_73_41_(2_^1_#* 3 ' )_^1_$WRITE (LU, 9001)_^19001 FORMAT( ' OFFSET_!1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9_^1_#*0 1 2 3 4 5 6 7 8 9 0_!OFFSET_!1234567890123456789012345678_^1_#*90 ' )_^1_$DO 1000 I = 1, IWD, 15_^1_$J = I + 14_^1_$IF ( J .GT. IWD) J = IWD_^1_$K = (I - 1) * 2_^1_$CALL XLAT ( BUFFER(I), VIEW, 30, MODE)_^1C_#BUILD DETAIL LINE_^1_$CALL CCSMVA ($2020, 1, 1, LINE, 3, 128)_^1_$CALL HEXDEC (K,IWORK)_^1_$CALL CCSMVA (IWORK, 3, 4, LINE, 3, 4)_^1_$CALL CCSMVA (IWORK, 3, 4, LINE, 87, 4)_^1_$IPOS = 10_^1_$JPOS = 96_^1_$II = 1_^1_$DO 200 L = I, J_^1_$CALL HEXASC (BUFFER(L), IWORK)_^1_$CALL CCSMVA ( IWORK, 1, 4, LINE, IPOS, 5)_^1_$CALL CCSMVA (VIEW, II, 2, LINE, JPOS, 2)_^1_$IPOS = IPOS + 5_^1_$JPOS = JPOS + 2_^1_$II = II + 2_^1200_!CONTINUE_^1_$CALL CCSPUT ($28, 95, LINE)_^1_$CALL CCSPUT ($29, 126, LINE)_^1_$WRITE ( LU, 9002) LINE_^19002 FORMAT (65A2)_^11000 CONTINUE_^1_$RETURN_^1_$END_]_^1_$SUBROUTINE INTGR ( INBF, NCH, IOUT)_^1_#*_2/ ASCII TO INTEGER_^1_$INTEGER INBF(1)_^1_$J = 0_^1_$IOUT = 0_^1_$DO 100 I = NCH, 1, -1_^1_$CALL CCSGET (INBF, I, IWK)_^1_$IWK = AND (IWK, $F)_^1_$IOUT = (IWK*10**J) + IOUT_^1_$J = J + 1_^1100_!CONTINUE_^1_$RETURN_^1_$END_]_^1_$SUBROUTINE INPUT (LU, BUF, NCH)_^1_#*_2/ TERMINAL INPUT_^1_$INTEGER BUF(30), TEMP(8)_^1_$IFLG = 0_^1_$ASSIGN 105 TO ICOMPL_^1_$CALL FREAD (LU, BUF, 58, ICOMPL, IFLG, TEMP)_^1_$CALL DISP_^1105_!NCH = BUF(30)_^1_$RETURN_^1_$END_]_^1_$SUBROUTINE TAPE ( PLU, BUFFER, LUNIT)_^1_#*_2/ HANDLE TAPE DUMPS_^1_$INTEGER PLU, BUFFER(2000), TEMP(8), C, R, E, TLU_^1_$DATA C/$43/, R/$52/, E/$45/, TLU/6/, IFLG/0/_^12_]_^1_]_^11_#WRITE (LUNIT, 9000)_^19000 FORMAT ( ' MOUNT TAPE TO BE DUMPED ON UNIT 0.',/,_^1_#*_(' ENTER C/R/E (CR) TO CONTINUE, REWIND AND CONTINUE, OR E_^1_#*XIT TAPE DUMPING.',/,_^1_#* ' IF EBCDIC TAPE FOLLOW C/R WITH E, SUCH AS RE (CR).' )_^1_$IRWD = 0_^1_$BUFFER(1) = 0_^1_$MODE = 0_^1_$CALL INPUT (LUNIT, BUFFER, NCH)_^1_$IF (NCH .EQ. 0) GO TO 8000_^1_$CALL CCSGET ( BUFFER, 2, I)_^1_$IF ( I .EQ. E) MODE = 1_^1_$CALL CCSGET (BUFFER, 1, I)_^1_$IF ( I .EQ. C) GO TO 200_^1_$IF ( I .EQ. R) GO TO 100_^1_$IF ( I .EQ. E) GO TO 8000_^1100_!CALL TAPMOT (TLU, 3)_^1_$IRWD = 1_^1_$WRITE ( PLU, 9101)_^19101 FORMAT ('1_!TAPE REWOUND ')_^11_]_^1C_#PROMPT FOR FILE SKIPPING_^1200_!WRITE (LUNIT, 9001)_^19001 FORMAT ( ' ENTER NUMBER OF FILES TO SKIP.' )_^1_$NF = 0_^1_$CALL INPUT (LUNIT, BUFFER, NCH)_^1_$IF (NCH .GT. 3) GO TO 200_^1_$IF ( NCH .EQ. 0) GO TO 300_^1_$CALL INTGR (BUFFER, NCH, NF)_^1_$IF (NF .EQ. 0) GO TO 300_^1_$WRITE (LUNIT,9002) NF_^19002 FORMAT ( I5, ' FILES BEING SKIPPED.' )_^1_$DO 250 I = 1, NF_^1 250 CALL TAPMOT (TLU, 5)_^1_$WRITE (LUNIT, 9003)_^19003 FORMAT ( ' FILE SKIPPING COMPLETE.' )_^1_$WRITE (PLU, 9102) NF_^19102 FORMAT ('0', I4, ' FILES SKIPPED' )_^11_]_^1300_!NF = NF +1_^1C_#PROMPT FOR NUMBER OF RECORDS TO SKIP_^1301_!WRITE (LUNIT, 9004)_^19004 FORMAT ( ' ENTER NUMBER OF RECORDS TO SKIP.' )_^1_$NR = 0_^1_$CALL INPUT ( LUNIT, BUFFER, NCH)_^1_$IF (NCH .GT. 4) GO TO 301_^1_$IF (NCH .EQ. 0) GO TO 500_^1_$CALL INTGR ( BUFFER, NCH, NR)_^1_$IF (NR .EQ. 0) GO TO 500_^1_$WRITE (LUNIT, 9005) NR_^19005 FORMAT ( I5, ' RECORDS BEING SKIPPED. ' )_^1_$ASSIGN 350 TO ICMP_^1_$DO 400 I = 1, NR_^1_$CALL FREAD (TLU, BUFFER, 2000, ICMP, IFLG, TEMP)_^1_$CALL DISP_^1350_!IF (LINK(0) .LT. 0) GO TO 450_^1400_!CONTINUE_^1_$WRITE (LUNIT, 9006)_^19006 FORMAT ( ' RECORD SKIPPING COMPLETE.' )_^1_$WRITE (PLU, 9103) NR_^19103 FORMAT('0', I4, ' RECORDS SKIPPED' )_^1_$GO TO 500_^1C_#ERROR OR EOF IN SKIPPING RECORDS, ASSUME EOF_^1450_!WRITE (LUNIT, 9007) I_^19007 FORMAT ( ' EOF DETECTED WHILE SKIPPING THE ',I4,'TH RECORD',/,_^1_#*_(' ACTION IDENTICAL TO SKIPPING 1 FILE. ' )_^1_$INF = 1_^1_$WRITE (PLU, 9102) INF_^1_$NF = NF + 1_^1_$NR = 0_^12_]_^1500_!NR = NR +1_^1C_#PROMPT FOR NUMBER OF RECORDS TO DUMP_^1501_!WRITE ( LUNIT, 9008)_^19008 FORMAT ( ' ENTER NUMBER OF RECORDS TO DUMP.')_^1_$CALL INPUT (LUNIT, BUFFER, NCH)_^1_$IF ( NCH .EQ. 0) GO TO 1_^1_$IF ( NCH .GT. 3) GO TO 501_^1_$CALL INTGR ( BUFFER, NCH, ND)_^1_$IF ( ND .EQ. 0) GO TO 1_^12_]_^1C_#FINALLY, WE ARE DUMPING RECORDS_^1_$ASSIGN 600 TO ICMP_^1_$DO 1000 I = 1, ND_^1_$CALL FREAD (TLU, BUFFER, 3000, ICMP, IFLG, TEMP)_^1_$CALL DISP_^1600_!IF ( LINK (0) .LT. 0) GO TO 1200_^1C_#CALCULATE NUMBER OF WORDS READ_^1_$NWDS = BUFFER(1501)/2_^1_$WRITE (PLU, 9009) I_^19009 FORMAT (//,'0 RELATIVE TAPE RECORD NUMBER =' , I5 )_^13_]_^1_$CALL SEEIT (PLU, BUFFER, NWDS, MODE)_^11000 CONTINUE_^1_$GO TO 1_^12_]_^1C_#EOF OR ERROR WHILE DUMPING RECORDS_^11200 WRITE (LUNIT, 9010) I_^19010 FORMAT ( ' EOF OR ERROR DETECTED DURING ACCESS OF RELATIVE RECOR_^1_#*D NUMBER', I5_!)_^1_$GO TO 1_^1_]_^1_]_^1_]_^1_]_^18000 RETURN_^1_$END_]_^1_$SUBROUTINE XLAT (EBC, ASC, EALNG, MD)_^1_#*_2/ EDIT FOR PRINT_^1_$INTEGER EBC(1), ASC(1), EALNG, ASCTAB(29), EBCTAB(29)_^1_$INTEGER PERIOD_^1_$DATA PERIOD /$2E/_^1_$DATA ASCTAB/' <.(+&$*)>-/,%?: ',$4027,'="ABCDEFGHIJKLMNOPQRSTUVWXY_^1_#*Z0123456789'/_^1_$DATA EBCTAB/$404A,$4B4D,$4E50,$5B5C,$5D5E,$6061,$6B6C,$6D6F,$7A7B,_^1_#*$7C7D,$7E7F,$C1C2,$C3C4,$C5C6,$C7C8,$C9D1,$D2D3,$D4D5,$D6D7,$D8D9,_^1_#* $E2E3,$E4E5,$E6E7,$E8E9,$F0F1,$F2F3,$F4F5,$F6F7,$F8F9/_^12_]_^1C_#TRANSLATE EBCDIC IF REQUIRED_^1_$IF (MD .EQ. 0) GO TO 100_^1C_#EBCDIC TRANSLATION_^1_$K = 0_^1_$ITEMP = 0_^1_$IEA = 0_^1_]_^110_"IEA = IEA + 1_^1_$CALL CCSGET (EBC, IEA, ITEMP)_^1_$DO 20 J = 1,58_^1_$CALL CCSGET ( EBCTAB,J,K)_^1_$IF ( K - ITEMP) 20,30,20_^120_"CONTINUE_^1_$J = 3_^130_"CALL CCSGET ( ASCTAB, J, K)_^1_$CALL CCSPUT (K, IEA, ASC)_^1_$IF (IEA .LT. EALNG) GO TO 10_^1C_#DONE WITH EBCDIC CONVERSION, NOW EDIT_^1100_!DO 110 I = 1, EALNG_^1_$CALL CCSGET ( EBC,I, K)_^1_$IF (MD .NE. 0) CALL CCSGET (ASC, I, K)_^1_$IF ( K .LT. $20) K = PERIOD_^1_$IF ( K .GT. $5D) K = PERIOD_^1_$CALL CCSPUT ( K, I, ASC)_^1110_!CONTINUE_^1_$RETURN_^1_$END_]_^1_$SUBROUTINE TAPMOT ( LU, ACTION)_^1_#*_2/ TAPE MOTION PROCESSOR_^1_$INTEGER ACTION, SFUNC_^1C_#CHECK FOR LEGIT ACTION_^1C_#1 - BSR_^1C_#2 - EOF_^1C_#3 - REW_^1C_#4 - REW/UNL_^1C_#5 - AVF_^1C_#6 - BSF_^1C_#7 - ADR_^1_$IF ( ACTION .LE. 0 .OR. ACTION .GT. 7) RETURN_^1_$ILU = LU_^1_$SFUNC = ACTION * 4096_^1_$ASSEM $C800,ILU,$6800,65_^1_$ASSEM $C800,SFUNC,$6800,66_^1_$ASSIGN 70 TO ICONT_^1_$ASSEM $C800,ICONT,$6400,+64_^1C_#ACTUAL REQUEST_^1_$ASSEM $54F4,$5C00_^164_"ASSEM $0,$0_^165_"ASSEM $0_^166_"ASSEM $0_^1_$CALL DISP_^170_"RETURN_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,CCSDMP,,,B_^1*Z_]_^1*CTO, CCSDMP INSTALLED COMPLETE...._^1*K,I10_]_^1*V,10_]_^__ PCCSPAS CSY/ CCS 0020P1*K,P2,L9,I7_^1*FTN_]_^1_$PROGRAM CCSPAS_^1_#1_2/CCS 2.0_;04-06-78_^1_$INTEGER USER(4),INP(2),OUTP(5),MSGO(4)_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^1_$DATA OUTP / $D0A, 'READY? ' /_^1_$DATA MSGO / 'MNUPRO ' /_^1_$DATA INP / '_"' /_^1_$CALL PGMIN ( USER, LU, M ODE, NPORT )_^1_$CALL WTREAD ( LU, -1, OUTP, 10, -1, INP , 1, L )_^1_$IF (AND(INP(1),$FF00).NE.$2000) CALL CHAIN ( MSGO )_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,CCSPAS,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ PCCSSPC CSY/ CCS 0020P1*K,P2,L9,I7_^1*FTN_]_^1_$PROGRAM CCSSPC_^1_#1_2/CCS 2.0_;04-13-78_^1C_]_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION,1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^1C---------------------------------------------------------------------_^1C_]_^1C_#AUDIT PRODUCES THE FILE SPACE REPORT. THE REPORT DISPLAYS FILE_^1C_#NAMES AND AVAILABLE SPACE INFORMATION IN THE FORM OF (1) MAXIMUM_^1C_#RECORDS ALLOWED, (2) NUMBER OF RECORDS CURRENTLY IN THE FILE,_^1C_#(3) NUMBER OF RECORDS REMAINING, AND (4) PERCENTAGE OF TOTAL FILE_^1C_#SPACE AVAILABLE. THIS INFORMATION IS GIVEN FOR SEVEN FILES :_^1C_#DELQMST, COSIGNER, ACCAGE, ACTFIL, SUMHIST, TAPEARC, AND INACCT._^1C_]_^1C---------------------------------------------------------------------_^1C_]_^1C ---- PROGRAM DECLARATIONS ----_^1C_]_^1_$EXTERNAL AMONTO,ADAYTO,AYERTO_^1C_]_^1_$RELATIVE GETFCB_^1C_]_^1_$INTEGER LU,LST,OD_^1_$INTEGER REQBUF(24),VOLNAM(4),INDEX,FCBBFR(96),ISTAT,ERR(13)_^1_$INTEGER FILES(4,5),EOFILE,STATOK,MAXFCB,REC_^1_$INTEGER MXRECS,CURECS,AVRECS,NAME(4)_^1_$INTEGER IDATA(15,7)_^1_$INTEGER MO,DA,YR_^1_$INTEGER RPTHDR(9),HDR1(40),HDR2(40),MSGMU(40),MSGWN(40)_^1C_]_^1_$REAL HIRECS,NMRECS,RMRECS,PCTREM,TDATRM,TDATRL,NEDATM,NEDATL_^1_$REAL COMPM,COMPW_^1C_]_^1_$DATA COMPM/05.0/,COMPW/15.0/_^1_$DATA IDATA / 'DELQMST ',8*$2020,0,1,0, 'COSIGNER',8*$2020,0,1,0,_^1_#1_,'ACCAGE ',8*$2020,0,1,0, 'ACTFIL ',8*$2020,0,1,0,_^1_#2_,'SUMHIST ',8*$2020,0,1,0, 'TAPEARC ',8*$2020,0,1,0,_^1_#3_,'INACCT ',8*$2020,0,1,0/_^1_$DATA EOFILE/$9000/,STATOK/0/,MAXFCB/2047/,REC/0/,NOVOL/$A000/_^1_$DATA LST/12/,LU/4/_^1_$DATA RPTHDR/' FILE SPACE REPORT'/_^1_$DATA HDR1/'_%FILE_(MAXIMUM_#CURRENT_#AVAILABLE_^1_#2_"PCT SPACE_+'/_^1_$DATA HDR2/'_%NAME_(RECORDS_#RECORDS_$RECORDS_^1_#2_"AVAILABLE_+'/_^1_$DATA MSGMU/'_#THIS FILE MUST BE COMPRESSED AND HISTORY MUST BE_^1_#2RUN_"*****_,'/_^1_$DATA MSGWN/'_#WARNING_"-_"THIS FILE SHOULD BE COMPRESSED_^1_#2_%*****_,'/_^1_$DATA ERR/' *** CDD01 NOT MOUNTED ***'/_^1C_]_^1_$EQUIVALENCE (FCBBFR(25),NAME(1))_^1_$BYTE (ISIGN1,TDATRL(15=15)),(ISIGN2,NEDATL(15=15))_^1C_]_^1C ---- GET DATE ----_^1C_]_^1_$MO = AND(AMONTO,$FFFF)_^1_$DA = AND(ADAYTO,$FFFF)_^1_$YR = AND(AYERTO,$FFFF)_^1C_]_^1C ---- GET APPROPRIATE FCBS ----_^1C_]_^1_$DO 199 K = 1, 7_^1C_(ZERO THE REQUEST BUFFER FOR THE NEXT FILE_^1_$DO 250 J = 1, 24_^1 250 REQBUF(J) = 0_^1C_(OPEN THE FILE FOR USE_^1_$CALL OPENFL ( REQBUF, IDATA(1,K), ISTAT )_^1C_(ERROR ?_^1_$IF ( ISTAT .GE. 0 ) GO TO 260_^1_$CALL FILERR ( IDATA(1,K), 3, ISTAT, LU )_^1_$GO TO 199_^1C_(GET THE FCB_^1 260 VOLNAM(1) = 0_^1_$CALL GETFCB ( REQBUF, VOLNAM, INDEX, FCBBFR, ISTAT )_^1C_(ERROR ?_^1_$IF ( ISTAT .GE. 0 ) GO TO 300_^1_$CALL FILERR ( IDATA(1,K), 7, ISTAT, LU )_^1_$GO TO 280_^1C_]_^1C ---- HIT ----_^1C_]_^1 300 REC = REC + 1_^1C_]_^1C ---- CONVERT TWO-WORD BINARY NUMBER TO REAL ----_^1C_]_^1_$TDATRM = FCBBFR(2) * 65536._^1_$TDATRL = FCBBFR(3)_^1_$IF (ISIGN1 .EQ. 1) TDATRL = TDATRL + 65536._^1_$HIRECS = TDATRM + TDATRL_^1C_]_^1_$NEDATM = FCBBFR(7) * 65536._^1_$NEDATL = FCBBFR(8)_^1_$IF (ISIGN2 .EQ. 1) NEDATL = NEDATL + 65536._^1_$NMRECS = NEDATM + NEDATL_^1C_]_^1C ---- FIND REMAINING NUMBER OF RECORDS AND PREPARE FOR OUTPUT ----_^1C_]_^1_$RMRECS = HIRECS - NMRECS_^1_$CURECS = NMRECS_^1_$MXRECS = HIRECS_^1_$AVRECS = RMRECS_^1_$PCTREM = 0_^1_$IF ( HIRECS .EQ. 0 ) GO TO 310_^1_$PCTREM = (RMRECS / HIRECS) * 100._^1 310 IF ( REC .GT. 1 ) GO TO 350_^1C_]_^1C ---- OUTPUT HEADERS ----_^1C_]_^1_$OD = LU_^1_$WRITE (OD,3002)_^1_$WRITE (OD,3005) (HDR1(I),I=1,35)_^1_$WRITE (OD,3005) (HDR2(I),I=1,35)_^1_$WRITE (OD,3001)_^1C_]_^1_$OD = LST_^1_$WRITE (OD,3000) (RPTHDR(I),I=1,9),MO,DA,YR_^1_$WRITE (OD,3006) (HDR1(I),I=1,40)_^1_$WRITE (OD,3006) (HDR2(I),I=1,40)_^1_$WRITE (OD,3002)_^1C_]_^1C ---- OUTPUT FILE INFORMATION ----_^1C_]_^1 350 OD = LU_^1_$WRITE (OD,3020) (NAME(I),I=1,4),MXRECS,CURECS,AVRECS,PCTREM_^1_$IF (PCTREM .GT. COMPW) GO TO 370_^1_$IF (PCTREM .GT. COMPM) GO TO 360_^1_$WRITE (OD,3005) (MSGMU(I),I=1,35)_^1_$GO TO 370_^1 360 WRITE (OD,3005) (MSGWN(I),I=1,35)_^1 370 WRITE (OD,3888)_^1C_]_^1_$OD = LST_^1_$WRITE (OD,3030) (NAME(I),I=1,4),MXRECS,CURECS,AVRECS,PCTREM_^1_$IF (PCTREM .GT. COMPW) GO TO 390_^1_$IF (PCTREM .GT. COMPM) GO TO 380_^1_$WRITE (OD,3006) (MSGMU(I),I=1,40)_^1_$GO TO 390_^1 380 WRITE (OD,3006) (MSGWN(I),I=1,40)_^1 390 WRITE (OD,3001)_^1C_]_^1C ---- GET NEXT FCB ----_^1C_]_^1C_(CLOSE THE FILE AND CONTINUE_^1 280 CALL CLOSFL ( REQBUF, ISTAT )_^1 199 CONTINUE_^1C_]_^1C ---- END OF JOB PROCESSING ----_^1C_]_^1 900 WRITE (LU,3002)_^1_$WRITE (LST,3999)_^1 999 CALL PGMOUT_^1C_]_^1C ---- END ----_^1C_]_^1 3000 FORMAT (1H1,////,52X,9A2,2X,1H-,2X,2(1A2,1H/),1A2,////)_^1 3001 FORMAT (/)_^1 3002 FORMAT (//)_^1 3005 FORMAT (40A2)_^1 3006 FORMAT (31X,40A2)_^1 3020 FORMAT (5X,4A2,X,2(4X,I8),5X,I8,10X,F4.1,1H%)_^1 3030 FORMAT (36X,4A2,X,2(4X,I8),5X,I8,10X,F4.1,1H%)_^1 3888 FORMAT (X)_^1 3999 FORMAT (1H1)_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,^I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,CCSSPC,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ ^PCHEKID CSY/ CHE 0020P1*K,P2,L9,I7_^1*FTN_]_^1_$PROGRAM CHEKID_^1C_]_^1C_8CCS 2.0_;02-14-78_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION,1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^1C---------------------------------------------------------------------_^1C_]_^1C_$CHEKID CALLS THE ITOS EXECUTIVE TO VALIDATE THE USER._^1C_-A VALID USER IS DEFINED AS THE CONSOLE OPERATOR_^1C_-WITH A BLANK ID (I.E. NOT $$). AN INVALID USER IS_^1C_-ANY USER OF A TERMINAL WHICH IS NOT TERMINAL ZERO._^1C_-VALID USERS PROCEED TO THE NEXT REQUEST; INVALID_^1C_-USERS ARE REMOVED FROM THE PROCEDURE._^1C_]_^1C---------------------------------------------------------------------_^1C_]_^1_%INTEGER USID,USPN_^1_%DIMENSION USID(4),IOUT(4)_^>1_%DATA IOUT/'MNUPRO '/_^1C_]_^1_%CALL PGMIN(USID,I1,I2,USPN)_^1_%IF (USPN .EQ. 0) CALL PGMOUT_^1_%CALL SYSMSG(76,0)_^1C ---- TAKE USER OUT OF PROCEDURE (EXIT) ---- *_^1_%CALL CHAIN(IOUT)_^1_%END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,CHEKID,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__>PCHUPD2 CSY/ 00020P1*K,I7,L9,P2_^1*FTN_]_^1_%PROGRAM CHUPD2_^1_#1_2/CCS 2.0_;04-20-78_^11_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^11_]_^1C_(THIS PROGRAM WILL REQUEST THAT A HISTORY TAPE BE MOUNTED,_^1C_(IT WILL VERIFY THAT THE CORRECT TAPE IS MOUNTED, IT WILL_^1C_(THEN LOCATE THE CORRECT ACCOUNT AND VERIFY IT'S ON THE_^1C_(DELQMST FILE; THEN ADD THE ACTFIL FILE WITH THE ACTIVITY_^1C_(BLOCK FROM THE TAPE. WHEN COMPLETE IT WILL THEN PROCESS_^1C_(ALL REMAINING TAPES, AS DETERMINED BY THE UPREQ FILE._^11_]_^11_]_^1_$INTEGER FP,REQBUF(72),IDATA(15),USER(4),RECBUF(1000),TREC(1001),_^1_#2_'AREC(252),HD(20,3),DT(3),FNAME(4,3),RTYPE,ZERO,ACT(9),_^1_#2_'COMMD(2),OK,EX,RD,TEMP(8),ERMSG(13),NFMSG(26),DATE(3),_^1_#2_'OLDTP(3),MTMSG(52),TFL(4),RESLT(2),PRYES(2),PRNO(2),_^1_#2_'RQACT(8),TPACT(8),SUF(3),BOROW(15),SW,SKP_^1_$INTEGER BLK(8)_^11_]_^1_$EQUIVALENCE ( TREC(8),TPACT(8) )_^11_]_^1C_(INITIALIZE THE REQUEST BUFFERS_^1_$DATA REQBUF / 72*0 /_^11_]_^1C_(SET UP THE DATA FOR OPENING THE FILES_^1_$DATA IDATA / 12*$2020, 1, 1, -1 /_^11_]_^1C_(SET UP THE BUFFER WITH THE FILE NAMES TO BE USED_^1_$DATA FNAME / 'DELQMST ACTFIL UPREQ_!' /_^11_]_^1C_(MESSAGE BUFFERS CONTAINING DIRECTIONS AND INSTRUCTIONS_^1_$DATA MTMSG / $D0A,'MOUNT TAPE LABELED:_!/_!/_!',_^1_#2_,$D0A,'ENTER "OK" FOR READY',_^1_#2_,$D0A,'ENTER "NX" FOR NEXT RECORD',_^1_#2_,$D0A,'ENTER "EX" TO END ',$D0A /_^1_$DATA OK/'OK'/,EX/'EX'/,NX/'NX'/,ZERO/0/,RD/0/_^1_$DATA ERMSG / $D0A,'INCORRECT TAPE MOUNTED',$D0A /_^1_$DATA NFMSG / $D0A,'ACCOUNT=# ',8*$2020,' NOT FOUND ON ',_^1_#2_,4*$2020,$D0A /_^1_$DATA TFL / 'TAPE_"' /_^1_$DATA PRYES,PRNO / ' YES',' NO' /_^1_$DATA BLK / 8*$2020 /_^11_]_^1_$EXTERNAL MONTO,YERTO_^11_]_^1C_(ACCEPT LOG ON FROM ITOS_^1_$CALL PGMIN (USER,LU,MODE,NPORT)_^11_]_^1C_(PICK UP SYSTEM DATE AND CONVERT_^1_$IMTH=AND(MONTO,$FFFF)_^1_$IYR=AND(YERTO,$FFFF)_^11_]_^1C_(LOCATE THE REPORT HEADING INFORMATION_^1_$CALL UTHEAD (HD,DT)_^1C_(PRINT THE REPORT HEADING_^1_$WRITE (12,1000)(HD(I,1),I=1,20),(HD(I,2),I=1,20),DT,(HD(I,3),_^1_#1_"I=1,20)_^11_]_^1C_(OPEN ALL FILES FOR USE, IF ERROR - PRINT MESSAGE AND EXIT_^1_$DO 50 FP=1,2_^1_$DO 40 I=1,4_^1_!40 IDATA(I)=FNAME(I,FP)_^1_$CALL OPENFL (REQBUF(24*FP+1),IDATA,ISTAT)_^1_$RTYPE=3_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$DO 45 I=5,12_^1_!45 IDATA (I)=$2020_^1_!50 CONTINUE_^1_$DO 70 I=1,4_^1_!70 IDATA(I)=FNAME(I,3)_^1_$IDATA(13)=0_^1_$CALL OPENFL (REQBUF(1),IDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 900_^11_]_^1C_(SEQUENTIALLY RETRIEVE RECORDS FROM THE UPREQ FILE_^1 100 CALL GETS ( REQBUF(1),RECBUF,KEY,ISTAT )_^1_$RTYPE=14_^11_]_^1C_(CHECK IF AT END-OF-FILE_^1_$IF (AND(ISTAT,$100).EQ.$100) GO TO 950_^1_$IF (ISTAT.LT.0) GO TO 900_^1C_(SET UP ACCOUNT NUMBER FOR MESSAGE_^1_$CALL CCSMVA (RECBUF,1,16,RQACT,1,16)_^1_$CALL CCSMVA (RQACT,1,16,NFMSG,13,16)_^11_]_^1C_(CHECK IF SAME TAPE TO BE PROCESSED ?_^1_$CALL CCSCST (RECBUF,17,6,OLDTP,1,6,ICOMP)_^1_$IF (ICOMP.EQ.0) GO TO 200_^11_]_^1C_(NEW TAPE TO PROCESS, SAVE DATE AND PROMPT OPERATOR_^1_$SW=0_]_^1_$CALL CCSMVA (RECBUF,17,6,OLDTP,1,6)_^1_$MTMSG(12)=RECBUF(9)_^1_$MTMSG(14)=RECBUF(10)_^1_$MTMSG(16)=RECBUF(11)_^1C_(OUTPUT INSTRUCTIONS AND INPUT COMMANDS_^1 150 CALL WTREAD (LU,-1,MTMSG,104,-1,COMMD,2,IC)_^1C_(CHECK FOR TAPE READY_^1_$IF (COMMD.EQ.OK) GO TO 210_^1C_(CHECK FOR EXIT_^1_$IF (COMMD.EQ.EX) GO TO 950_^1C_(CHECK FOR NEXT RECORD_^1_$IF (COMMD.EQ.NX) GO TO 100_^1_$GO TO 150_^11_]_^1C_(CHECK IF IT IS NECESSARY TO READ TAPE_^1 200 IF (RD.EQ.0) GO TO 210_^1_$RD=0_]_^1_$GO TO 300_^11_]_^1C_(GET NEXT RECORD FROM TAPE_^1 210 ASSIGN 220 TO IRTN_^1_$CALL FREAD (6,TREC,2000,IRTN,0,TEMP)_^1_$CALL DISP_^1C_(SET UP MESSAGE FOR TAPE_^1 220 CALL CCSMVA (TFL,1,8,NFMSG,43,8)_^11_]_^1C_(CHECK IF AT ROUTINE TO WRITE ACTFIL RECORD_^1_$IF (SW.EQ.2) GO TO 400_^11_]_^1C_(CHECK IF AT END-OF-FILE_^1_$IF (LINK(0).LT.0) GO TO 500_^11_]_^1C_(CHECK WHICH WAY TO RUN_^1_$IF (SW.EQ.1) GO TO 300_^11_]_^1C_(TAPE READY VERIFY TAPE DATE_^1_$CALL CCSMVA (TREC,1,6,DATE,1,6)_^1_$CALL CCSCST (DATE,1,6,OLDTP,1,6,ICOMP)_^1_$IF (ICOMP.EQ.0) GO TO 240_^1C_(OUTPUT ERROR MESSAGE_^1_$CALL WTREAD (LU,-1,ERMSG,26,ZERO,ZERO,ZERO,IC)_^1_$GO TO 150_^1C_(TAPE CORRECT - PROCESS ACCOUNT_^1 240 SW=1_]_^1_$GO TO 210_^11_]_^1C_(PROCESS THE SAME TAPE REQUESTED_^1C_(FIRST, SEARCH THE REQUESTED ACCOUNT ON THE TAPE_^1 300 CALL CCSCST (TPACT,1,16,RQACT,1,16,ICOMP)_^1_$IF (ICOMP.LT.0) GO TO 210_^1_$IF (ICOMP.EQ.0) GO TO 310_^1_$RD=1_]_^1_$GO TO 500_^11_]_^1C_(RETRIEVE THE DELQMST RECORD TO CHECK IF IT EXIT_^1 310 CALL READR (REQBUF(25),RECBUF,RQACT,ISTAT)_^1_$RTYPE=13_^1C_(SET UP MESSAGE FOR DELQMST FILE_^1_$CALL CCSMVA (FNAME,1,8,NFMSG,43,8)_^11_]_^1C_(END-OF-FILE ?_^1_$IF (AND(ISTAT,$100).EQ.$100) GO TO 320_^1_$IF (ISTAT.LT.0) GO TO 900_^11_]_^1C_(CHECK IF THE DELQMST RECORD IS THE CORRECT ACCOUNT_^1 320 CALL CCSCST (RECBUF,1,16,RQACT,1,16,ICOMP)_^1_$IF (ICOMP.NE.0) GO TO 500_^11_]_^1C_(SWITCH IS SET FOR THE ROUTINE TO WRITE THE ACTFIL RECORD_^1_$SW=2_]_^1_$SKP=0_^1_$CALL CCSMVA (PRNO,1,4,RESLT,1,4)_^1_$CALL CCSMVA (RECBUF,18,30,BOROW,1,30)_^1_$GO TO 210_^11_]_^1C_(ROUTINE - TRY TO WRITE THE ACTFIL RECORD_^1C_(FIRST, CHECK IF IT IS EOF ?_^1 400 IF (LINK(0).LT.0) GO TO 480_^1C_(CHECK IF THE ACCOUNT IS THE SAME_^1_$CALL CCSCST (TPACT,1,16,RQACT,1,16,ICOMP)_^1_$IF (ICOMP.EQ.0) GO TO 410_^1_$IF (SKP.EQ.1) GO TO 405_^1_$CALL CCSCST (TPACT,1,16,BLK,1,16,ICOMP)_^1_$IF (ICOMP.EQ.0) GO TO 410_^1 405 RD=1_]_^1_$GO TO 480_^11_]_^1C_(ACTFIL MANIPULATION_^1C_(SET UP SUFFIX = 50 AND SKIP FIRST BLOCK (COSIGNER)_^1 410 IF (SKP.EQ.1) GO TO 420_^1_$SUF(3)=$3530_^1_$I=1_]_^1_$GO TO 430_^1 420 I=0_]_^11_]_^1C_(THIS IS THE ACTIVITY BLOCK_^1C_(CHECK IF THIS BLOCK IS THE GOOD ACCOUNT_^1 430 CALL CCSCST ( TREC(250*I+1),1,16,RQACT,1,16,ICOMP)_^1_$IF (ICOMP.NE.0) GO TO 480_^1C_(CONVERT SUFFIX INTO A DECIMAL NUMBER, THEN INCREMENT 1_^1_$K=ICCSAD( SUF(3) )_^1_$K=K+1_^1_$CALL HEXDEC (K,SUF)_^1C_(CHECK IF THE SUFFIX EXCEED OVER 99_^1_$IF (K.GT.99) GO TO 480_^1C_(CREATE THE KEY AND PLACE ACTIVITY BLOCK IN THE RECORD_^1_$CALL CCSMVA (RQACT,1,16,AREC,1,16)_^1_$AREC(9)=SUF(3)_^1_$CALL CCSMVA (AREC,1,18,ACT,1,18)_^1_$CALL CCSMVA (TREC(250*I+1),19,482,AREC,19,482)_^1C_(PLACE THE RECORD IN THE ACTFIL_^1_$CALL WRITER (REQBUF(49),AREC,ACT,ISTAT)_^1_$RTYPE=12_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$CALL CCSMVA (PRYES,1,4,RESLT,1,4)_^1C_(CHECK IF THE RECORD HAS FINISHED TO BE PLACED IN THE ACTFIL_^1_$I=I+1_^1_$IF (I.LT.4) GO TO 430_^1_$SKP=1_^1_$GO TO 210_^11_]_^1C_(PRINT THE DETAIL_^1 480 WRITE (12,1100) RQACT,BOROW,DATE,RESLT_^1_$CALL CCSBLK (BOROW,30)_^1_$GO TO 510_^11_]_^1C_(OUTPUT NO-FOUND MESSAGE_^1 500 CALL WTREAD (LU,-1,NFMSG,52,ZERO,ZERO,ZERO,IC)_^1 510 SW=1_]_^1_$GO TO 100_^11_]_^1C_(A FILE ERROR HAS OCCURRED - REPORT AND TERMINATE JOB_^1 900 CALL FILERR (IDATA,RTYPE,ISTAT,LU)_^11_]_^1C_(REPORT END AND CLOSE ALL FILES, THEN EXIT_^1 950 WRITE (12,1200)_^1_$CALL CLOSFL (REQBUF(1),ISTAT)_^1_$CALL CLOSFL (REQBUF(25),ISTAT)_^1_$CALL CLOSFL (REQBUF(49),ISTAT)_^1_$CALL PGMOUT_^11_]_^1C_(OUTPUT FORMATS_^1 1000 FORMAT (1H1,20A2,9X,'TAPE HISTORY UPDATE REPORT',/,1X,20A2,14X,_^1_#1 'RUN DATE:',A2,'/',A2,'/',A2,/,1X,20A2,//,20X,'ACCOUNT NUMBER',_^1_#1 8X,'BORROWERS NAME',17X,'DATE OF TAPE',5X,'RECORDS ADDED TO ',_^1_#1 'ACTIVITY FILE',/)_^1 1100 FORMAT (19X,8A2,5X,15A2,5X,A2,'/',A2,'/',A2,19X,2A2)_^1 1200 FORMAT (//,50X,'*** END OF REPORT ***')_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,CHUPD2,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ PCMPDLQ CSY/ P1*K,I7,P2,L9_^1*FTN_]_^1_$PROGRAM CMPDLQ_^1_#1_2/CCS 2.0_;04-21-78_^11_]_^1C_$COPYRIGTH CONTROL DATA CORPORATION, 1978_^1C_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_$CREDIT COLLECTION SYSTEM VERSION 2.0_^11_]_^1C_(THIS PROGRAM PERFORMS A FILE COMPRESSION ON THE_^1C_(DELQMST FILE. THIS REMOVES ALL DELETED RECORDS_^1C_(THEREBY FREEING FILE SPACE._^11_]_^1_$INTEGER USER(4),IDATA(15),REQBUF(24),RECBUF(1004)_^11_]_^1_$DATA REQBUF / 24*0 /_^1_$DATA IDATA / 'DELQMST ', 8*$2020, -1, 1, 0 /_^11_]_^1C_(ITOS LOGON_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^11_]_^1C_(OPEN DELQMST_^1_$CALL OPENFL ( REQBUF, IDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1C_(ERROR ON OPEN_^1_$CALL FILERR ( IDATA, 3, ISTAT, LU )_^1_$CALL PGMOUT_^11_]_^1C_(PERFORM THE COMPRESSION_^1 100 CALL COMFIL ( REQBUF, RECBUF, ISTAT )_^1_$IF ( AND($100,ISTAT) .EQ. $100 ) GO TO 200_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1C_(ERROR ON COMPRESS_^1_$CALL FILERR ( IDATA, 17, ISTAT, LU )_^1C_(CLOSE DELQMST AND EXIT_^1 200 CALL CLOSFL ( REQBUF, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,CMPDLQ,,,B_^1*Z_]_^1*CTO, CMPDL$Q INSTALLED_^1*K,I10_]_^1*V,10_]_^__$PCMPSUM CSY/ P1*K,I7,L9,P2_^1*FTN_]_^1_$PROGRAM CMPSUM_^1_#1_2/CCS 2.0_;06-02-78_^11_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^11_]_^1C_(THIS PROGRAM PERFORMS A FILE COMPRESSION ON THE_^1C_(SUMHIST FILE._^11_]_^1_$INTEGER USER(4),IDATA(15),REQBUF(24),RECBUF(1000)_^1_$DATA REQBUF / 24*0 /_^1_$DATA IDATA / 'SUMHIST ',8*$2020,-1,1,0 /_^11_]_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^1_$CALL OPENFL ( REQBUF, IDATA, ISTAT )_^0_$IF ( ISTST .GE. 0 ) GO TO 100_^1_$CALL FILERR ( IDATA, 3, ISTAT, LU )_^1_$CALL PGMOUT_^1 100 CALL COMFIL ( REQBUF, RECBUF, ISTAT )_^1_$IF ( AND(ISTAT,$100) .EQ. $100 ) GO TO 200_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1_$CALL FILERR ( IDATA, 17, ISTAT, LU )_^1 200 CALL CLOSFL ( REQBUF, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,CMPSUM,,,B_^1*Z_]_^1*CTO, CMPSUM INSTALLED_^1*K,I10_]_^1*V,10_]_^__ PDAQUEL CSY/ DAQ 0020P1*K,P2,L9,I7_^1*FTN_]_^1_$PROGRAM DAQUEL_^1_#1_2/CCS 2.0_;04-06-78_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^11_]_^1C_(THIS PROGRAM LOCATES THE STARTING ACCOUNT FOR REVIEW FOR_^1C_(EACH QUEUE WITHIN THE DAILY ASSIGNMENT FILE. IT SAVES THE_^1C_(RELATIVE RECORD POINTER ALONG WITH THE QUEUE IDENTIFIER_^1C_(SO THAT COLECT CAN LOCATE THE START FOR EACH QUEUE'S_^1C_(AUTOMATIC FUNCTION_^11_ _]_^1_$INTEGER DLYREC(20),DLYREQ(24),QREQ(24),QREC(6),DDATA(15),_^1_#1_"QDATA(15),USER(4),QUEUE(2)_^11_]_^1_$DATA DDATA / 'DLYASSN ', 8*$2020, 0, 1, 0 /_^1_$DATA QDATA / 'DAQUE_!', 8*$2020, 0, 1, 0 /_^11_]_^1_$DATA DLYREQ, QREQ / 48*0 /_^11_]_^1_$DATA QUEUE / 0,0 /_^11_]_^1C_(ACCEPT LOG ON FROM ITOS, VERIFY MASTER CONSOLE_^1_$CALL PGMIN (USER,LU,MODE,NPORT)_^1_$IF (NPORT.NE.0) CALL PGMOUT_^11_]_^1C_(OPEN FILES FOR USE_^1_$CALL OPENFL (DLYREQ,DDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$CALL OPENFL (QREQ,QDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 905_^11_]_^1C_(GET NEXT RECORD FROM THE ASSIGNMENT FIEL_^1 100 CALL GETS (DLYREQ,DLYREC,I,ISTAT)_^1_$IF (AND(ISTAT,$100).EQ.$100) GO TO 950_^1_$IF (ISTAT.LT.0) GO TO 910_^1C_(CHECK IF ON SAME QUEUE_^1_$IF (QUEUE(1).EQ.DLYREC( 9).AND._^1_#2_"QUEUE(2).EQ.DLYREC(10)) GO TO 100_^1C_(NEW QUEUE, SAVE IN DAQUE_^1_$QREC(1)=DLYREC( 9)_^1_$QREC(2)=DLYREC(10)_^1_$QREC(3)=DLYREQ(16)_^1_$QREC(4)=DLYREQ(17)_^1_$CALL WRITER (QREQ,QREC,QREC,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 915_^1_$QUEUE(1)=DLYREC( 9)_^1_$QUEUE(2)=DLYREC(10)_^1_$GO TO 100_^1 900 CALL FILERR ( DDATA, 3, ISTAT, LU )_^1_$GO TO 950_^1 905 CALL FILERR ( QDATA, 3, ISTAT, LU )_^1_$GO TO 950_^1 910 CALL FILERR ( DDATA, 14, ISTAT, LU )_^1_$GO TO 950_^1 915 CALL FILERR ( QDATA, 12, ISTAT, LU )_^11_]_^1 950 CALL CLOSFL(DLYREQ,ISTAT)_^1_$CALL CLOSFL(QREQ,ISTAT)_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_b^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,DAQUEL,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__bPDECMTN CSY/ DEC 0020P1*K,P2,L9,I7_^1*FTN_]_^1_$PROGRAM DECMTN_^1_#1_2/CCS 2.0_;03-22-78_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^1C_#PROGRM MAINTAINS DECISION TABLE FILE_^1_$INTEGER TABLE(500),CRT,TBTY(2),IDATA(15),REQBUF(24),USER(4)_^1_$DATA REQBUF / 24*0 /_^1_$DATA IDATA / 'DECTBL',9*$2020,0,1,0 /_^1_$INTEGER TEMP(8)_^1_$INTEGER CMDTB(8)_^1_$DATA CMDTB / 'CRDEADDSPTDUEXDB'/_^1_$INTEGER Y, MSG(3), LN(3), ICMD(2), IU(2), IST(2)_^1_$DATA Y/'Y '/, MSG / 'INPUT=' /_^1_$DATA CRT / 4 /, TBTY / 'COPR' /_^1C_#TABLE LENGTH_^1_$INTEGER COMTLN_^1_$DATA COMTLN/500/_^1C_#DEBUG DUMP INDICATOR_^1_$INTEGER DB_^1_$DATA DB/0/_^12_]_^1C_(ACCEPT LOG ON FROM ITOS_^1_$CALL PGMIN(USER,CRT,MODE,NPORT)_^1C_(VERIFY THIS IS THE MASTER CONSOLE - IF NOT EXIT_^1_$IF ( NPORT .NE. 0 ) CALL PGMOUT_^11_]_^1C_#GET THE FILE FOR PROCESSING, IF FILE NOT DEFINED REPORT AS_^1C_(ERROR AND LEAVE._^11_]_^1_$CALL OPENFL(REQBUF,IDATA,ISTAT)_^1C_#CHECK IF FILE PRESENT_^1_$IF (ISTAT.LT.0) GO TO 8010_^1_$CALL CLOSFL(REQBUF,ISTAT)_^12_]_^1C_#ASK USER WHICH TABLE TO USE, COLLECTOR OR PRIORITY_^1_$WRITE (CRT,9000)_^1 9000 FORMAT ( ' DECISION TABLE MAINTENANCE PROGRAM IN ')_^12_]_^1C_#USING ONLY 1 TABLE_^1_$ITP = 1_^1 150 WRITE (CRT, 9011)_^1 9011 FORMAT ( ' INPUT CR/DE/AD/DS/PT/DU/EX TO EITHER',/,_^1_#1 ' CREATE A COMPLETE TABLE, DELETE A TEST, ADD A TEST',/,_^1_#2 ' DISPLAY A TEST, PRINT THE TABLE, DUMP THE TABLE,',/,_^1_#3 ' END PROCESSING',/)_^1_$IF ( DB .EQ. 1) CALL DEBDT1 (99,TABLE,500)_^1 200 CALL WTREAD ( CRT,-1, MSG, 6,-1, ICMD, 2, K )_^1C_#DECODE COMMAND_^1C_(CREATE_^1_$IF (ICMD .EQ. CMDTB(1) ) GO TO 1000_^1C_(END_^1_$IF (ICMD .EQ. CMDTB(7) ) GO TO 7000_^12_]_^1C_#GET THE TABLE_^1_$TABLE(2) = COMTLN_^1_$CALL RTVDT1(ITP,TABLE,IND)_^1_$IF (IND .NE. 0) GO TO 8050_^1C_#DELETE TEST_^1_$IF ( ICMD .EQ. CMDTB(2)) GO TO 2000_^1C_#ADD TEST_^1_$IF ( ICMD .EQ. CMDTB(3)) GO TO 3000_^1C_#DISPLAY_^1_$IF ( ICMD .EQ. CMDTB(4)) GO TO 4000_^1C_#PRINT_^1_$IF (ICMD .EQ. CMDTB(5)) GO TO 5000_^1C_#DUMP_]_^1_$IF ( ICMD .EQ. CMDTB(6)) GO TO 6000_^1C_#DEBUG_^1_$IF ( ICMD .NE. CMDTB(8)) GO TO 900_^1C_#TOGGLE DEBUG BIT_^1_$DB = AND($1,DB+1)_^1_$GO TO 150_^1C_#ILLEGAL COMMAND_^1 900 WRITE (CRT,9012) ICMD_^1 9012 FORMAT ( 'COMMAND ', A2, ' NOT IN TABLE, REENTER.')_^1_$GO TO 200_^13_]_^1C_#CREATE NEW TABLE_^1C_]_^1 1000 WRITE (CRT, 9023)_^1 9023 FORMAT ( ' CREATE FUNCTION WILL CLEAR YOUR CURRENT TABLE FILE',/,_^1_#1 ' TYPE Y IF YOU WISH TO DO THAT',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, ICMD, 1, K )_^1_$IF (AND(ICMD,$FF00).NE.$5900) GO TO 150_^1C_#GET RID OF OLD TABLE IF PRESENT_^1_$CALL CLEAR(REQBUF,IDATA,ISTAT)_^1C_(VERIFY CLEAR WAS SUCESSFUL_^1_$IF (ISTAT.LT.0) GO TO 8020_^1C_#ASK IF INPUT FROM NON-CRT LU_^1_$WRITE (CRT,9020)_^1 9020 FORMAT ( ' CREATE TABLE IN PROCESS, INPUT LU OF INPUT STREAM AS',_^1_#1_'/,'_!2 NUMERIC DIGITS' )_^1_$WRITE ( CRT, 9022)_^1 9022 FORMAT ( ' IF LU 04 ENTERED, CREATION WILL BE VIA ADD TEST DIALOG_^1_#1 ',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, IST, 2, K )_^1 9024 ILU = (AND(IST,$F00)/$100)*10 + AND(IST,$F)_^1C_#PASS CONTROL TO SUBROUTINE TO LOAD TABLE_^1_$DO 1100 I = 1, COMTLN_^1 1100 TABLE(I) = 0_^1C_#INITIALIZE TABLE LENGTH AND TYPE_^1_$TABLE(2) = 10_^1_$TABLE(9) = COMTLN_^1_$TABLE(4) = ITP_^1C_#BRANCH TO ADD IF LU = 04_^1_$IF (ILU .EQ. 4) GO TO 3000_^1_$CALL LDTDT1 ( TABLE, ILU, IND3)_^1C_(CHECK FOR ERROR_^1_$IF ( IND3 .NE. 0) GO TO 8030_^1C_#WRITE TABLE TO FILE_^1_$DO 300 ISTAT = 1,24_^1 300 REQBUF(ISTAT) = 0_^1_$CALL OPENFL(REQBUF,IDATA,ISTAT)_^1_$CALL PUTS ( REQBUF, TABLE, 1, ISTAT )_^1_$IF ( ISTAT .LT. 0) GO TO 8040_^1_$CALL CLOSFL(REQBUF,ISTAT)_^1C_#TELL OPERATOR TABLE HAS BEEN LOADED_^1_$WRITE (CRT, 9030) TBTY(ITP)_^1 9030 FORMAT ( 3X, A2, ' TABLE HAS BEEN FRESHLY LOADED')_^1_$GO TO 150_^12_]_^1C_#DELETE TEST_^1 2000 CALL DELDT1 ( TABLE, CRT, IND)_^1_$IF ( IND .LT. 0) GO TO 8060_^1C_#UPDATE FILE_^1_$GO TO 3100_^12_]_^1C_#ADD A TEST_^1C_]_^1 3000 CALL ADDDT1 (TABLE,CRT,IND)_^1_$IF (IND .LT. 0) GO TO 150_^1C_#CORE TABLE HAS BEEN UPDATED_^1C_'UPDATE DISK TABLE_^1C_(1ST REMOVE OLD IMAGE_^1 3100 CALL CLEAR(REQBUF,IDATA,ISTAT)_^1_$IF ( ISTAT .LT. 0) GO TO 8020_^1_$DO 310 ISTAT = 1,24_^1 310 REQBUF(ISTAT) = 0_^1_$CALL OPENFL(REQBUF,IDATA,ISTAT)_^1_$CALL PUTS ( REQBUF, TABLE, 1, ISTAT )_^1_$IF (ISTAT.LT.0) GO TO 8040_^1_$CALL CLOSFL(REQBUF,ISTAT)_^1_$GO TO 150_^12_]_^1C_#DISPLAY TEST ON CRT_^1 4000 WRITE ( CRT, 9040)_^1 9040 FORMAT ( ' DISPLAY TEST IN PROCESS. ENTER 3 DIGIT TEST NUMBER FOR_^1_#1DISPLAY',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, LN, 3, K )_^1_$LIN_!= AND(LN(1),$F00)/$100*100+AND(LN(1),$F)*10+_^1_#1_"AND(LN(2),$F00)/$100_^1_$CALL DSPDT1 ( TABLE,LIN ,CRT,IND)_^1_$IF (IND .EQ. 0) GO TO 150_^1C_#ERROR IN DISPLAY MODULE, LINE NUM OUT OF RANGE_^1_$WRITE (CRT, 9042) LIN_^1 9042 FORMAT (' ERROR IN LINE NUMBER', I4, ' NOT IN TABLE')_^1_$GO TO 150_^12_]_^1C_#PRINT TABLE ON LP_^1 5000 CALL PRTDT1 (TABLE, 12)_^1_$WRITE (CRT, 9500)_^1 9500 FORMAT ( ' TABLE WAS PRINTED ON LINE PRINTER. ')_^1_$GO TO 150_^12_]_^1C_#DUMP TABLE IN RELOADABLE FORMAT_^1 6000 WRITE ( CRT, 9060)_^1 9060 FORMAT ( ' DUMP TABLE IN PROCESS. TABLE WILL BE DUMPED IN FORM COM_^1_#1PATIBLE' ,/, '_!WITH CREATE FUNCTION. INPUT LU OF OUTPUT STREAM_^1_#2AS 2 NUMERIC DIGITS ',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, IU, 2, K )_^1_$LU = AND(IU,$F00)/$100*10+AND(IU,$F)_^1_$CALL DPTDT1 ( TABLE, LU, IND)_^1_$IF ( IND .NE. 0) GO TO 8070_^1_$WRITE ( CRT, 9061) LU_^1 9061 FORMAT ( ' TABLE DUMPED TO LU ', I3 )_^1_$GO TO 150_^1 7000 CALL PGMOUT_^14_]_^1C_#ERROR PROCESSING SECTION_^1C_]_^1 8010 WRITE (CRT,9801)_^1 9801 FORMAT ( ' FILE DECTBL NOT DEFINED. USE UTIL AND TRY AGAIN.')_^1_$GO TO 8999_^1 8020 WRITE (CRT,9802) ISTAT_^1 9802 FORMAT ( 'FILE DECTBL ERROR IN REMOVING ERROR-', Z4)_^1_$GO TO 8999_^1 8030 WRITE (CRT,9803) IND3_^1 9803 FORMAT ( 'SUBROUTINE LDTABL ERROR-', Z4)_^1_$GO TO 8999_^1 8040 WRITE (CRT,9804) ISTAT_^1 9804 FORMAT ( 'FILE DECTBL ERROR IN STORING RECORD, ERROR-',Z4)_^1_$GO TO 8999_^1 8050 WRITE (CRT, 9805) IND_^1 9805 FORMAT ( ' NO DECISION TABLE IN SYSTEM, ERROR-', Z4)_^1_$GO TO 8999_^1 8060 WRITE ( CRT, 9806) IND_^1 9806 FORMAT ( 'SUBROUTINE DELDT1 ERROR-', Z4)_^1_$GO TO 8999_^1 8070 WRITE ( CRT, 9807) IND_^1 9807 FORMAT ( ' SUBROUTINE DPTDT1 ERROR-', Z4)_^1_$GO TO 8999_^1 8999 IF ( DB .EQ. 1) CALL DEBDT1 (8999, DECMTN, 12000)_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,DECMTN,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__PDHDELE CSY/ 00020P1*K,I7,L9,P2_^1*FTN_]_^1_%PROGRAM DHDELE_^1_#1_2/CCS 2.0_;02-21-78_^12_]_^1C_#COPYRIGTH CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^12_]_^11_]_^1C_(THIS PROGRAM PERFORMS THE RECORD REMOVAL FOR ALL ACCOUNTS_^1C_(THAT WERE UDATED FROM THE HISTORY SYSTEM. THE RECORDS UPDATED_^1C_(FROM THE SUMHIST FILE CONTAIN A 'B' OR 'S' IN COLUMN 17 OF_^1C_(THE UPDACCT RECORD. WHEN THIS IS FOUND THE SUMHIST RECORD IS_^1C_(DELETED._^11_]_^1_$INTEGER FP,ISTAT,REQBUF(144),KEY(9),USER(4),RECBUF(1000),_^1_#2_"IDATA(15),KEYSVE(9),FNAME(8),ETYPE(12)_^11_]_^1C_(INITIALIZE THE REQUEST BUFFERS_^1_$DATA REQBUF / 144*0 /_^11_]_^1C_(SET UP ERROR TYPE MESSAGES_^1_$DATA ETYPE / 'OPENING READING DELETING' /_^11_]_^1C_(SET UP THE BUFFER FOR OPENING THE FILES_^1_$DATA IDATA / 12*$2020, 1, 1, -1 /_^11_]_^1C_(SET UP THE BUFFER WITH THE FILE NAMES TO BE USED_^1_$DATA FNAME / 'SUMHIST ADDACT ' /_^12_]_^1C_(ACCEPT SIGN ON FROM ITOS_^1_$CALL PGMIN(USER,LU,MODE,NPORT)_^11_]_^1C_(OPEN ALL FILES FOR USE, IF ERROR - PRINT MESSAGE AND STOP_^11_ _]_^1_$DO 40 I=1,4_^1_!40 IDATA(I)=FNAME(I)_^1_$FP=1_]_^1_$CALL OPENFL(REQBUF(25),IDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$DO 45 I=5,12_^1_!45 IDATA (I)=$2020_^1_$DO 70 I=1,4_^1_!70 IDATA(I)=FNAME(I+4)_^1_$IDATA(13)=0_^1_$FP=$2_^1_$CALL OPENFL(REQBUF(1),IDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 900_^11_]_^1C_(SEQUENTIALLY RETREIVE RECORDS FROM THE WRKFIL_^1 100 CALL GETS(REQBUF(1),RECBUF,KEY,ISTAT)_^1C_(CHECK IF AT END-OF-FILE_^1_$IF (AND(ISTAT,$0100).EQ.$100) GO TO 950_^1_$FP=$14_^1_$IF (ISTAT.LT.0) GO TO 900_^11_]_^1C_(RECORD RETREIVED - CHECK IF CHAR 18 = D_^1_$IF (AND(RECBUF(9),$FF00).NE.$42.AND._^1_#1_"AND(RECBUF(9),$FF00).NE.$53) GO TO 100_^1C_(RECORD HAS BEEN MOVED TO HISTORY - DELETE ACCT FROM FILES_^1_$DO 110 I=1,8_^1_$KEYSVE(I)=RECBUF(I)_^1 110 KEY(I)=RECBUF(I)_^1_$FP=$11_^1_$CALL READR(REQBUF(25),RECBUF,KEY,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$CALL DELREC(REQBUF(25),RECBUF,ISTAT)_^1_$FP=$21_^1_$IF (ISTAT.LT.0) GO TO 900_^12_]_^1C_(A FILE ERROR HAS OCCURRED - REPORT AND TERMINATE JOB_^1 900 I=AND(FP,$F)_^1_$J=AND(FP,$F0)/$10_^1_$L=4*J+1_^1_$L1=L+3_^1_$I1=I+3_^1_$WRITE (4,1100)(ETYPE(K),K=L,L1),(FNAME(K),K=I,I1),ISTAT_^1 1100 FORMAT (/,' FILE ERROR WHEN ',4A2,2<X,4A2,'; STATUS = ',$4,/,_^1_#1_"' **** JOB TERMINATED ',/)_^1C_(CLOSE ALL FILES AND TERMINATE JOB_^1 950 CALL CLOSFL(REQBUF(25),ISTAT)_^1_$CALL CLOSFL(REQBUF(1),ISTAT)_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,DHDELE,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ <PMHDELE CSY/ 00020P1*K,I7,L9,P2_^1*FTN_]_^1_%PROGRAM MHDELE_^1_#1_2/CCS 2.0_;02-09-78_^12_]_^1C_#COPYRIGTH CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^12_]_^1C_(THIS PROGRAM PERFORMS THE RECORD REMOVAL FOR ALL ACCOUNTS_^1C_(THAT WERE MOVED TO THE HISTORY SYSTEM BY THE PROGRAM MHUPDT._^1C_(THE RECORDS THAT WERE MOVED CONTAIN A 'D' IN COLUMN 18 OF_^1C_(THE WRKFIL RECORD, WHEN THIS IS FOUND ALL ACTIVE FILES HAVE_^1C_(THE DATA FOR THAT ACCOUNT REMOVED._^11_]_^1_$INTEGER IDATA(15),ADATA(15),DDATA(15),CDATA(15),AREQ(24),_^1_#2_"DREQ(24),IREQ(24),CREQ(24),RECBUF(1004),KEY(9),IP,KSV(9)_^12_]_^1_$DATA IREQ,DREQ,AREQ,CREQ / 96*0 / , IP / 0 /_^1_$DATA IDATA / 'INACCT ',8*$2020, 0,1,1 /_^1_$DATA ADATA / 'ACTFIL ',8*$2020, 1,1,1 /_^1_$DATA DDATA / 'DELQMST ',8*$2020, 1,1,1 /_^1_$DATA CDATA / 'COSIGNER',8*$2020, 1,1,1 /_^12_]_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^12_]_^1C_(OPEN FILES_^1_$CALL OPENFL ( IREQ, IDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1_$CALL FILERR ( IDATA, 3, ISTAT, LU )_^1_$GO TO 900_^1 100 CALL OPENFL ( AREQ, ADATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 110_^1_$CALL FILERR ( ADATA, 3, ISTAT, LU )_^1_$GO TO 900_^1_]_^1 110 CALL OPENFL ( DREQ, DDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 120_^1_$CALL FILERR ( DDATA, 3, ISTAT, LU )_^1_$GO TO 900_^1 120 CALL OPENFL ( CREQ, CDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 200_^1_$CALL FILERR ( CDATA, 3, ISTAT, LU )_^1_$GO TO 900_^12_]_^1C_(SEQUENTIALLY PROCESS INACCT_^1 200 CALL GETS ( IREQ, RECBUF, IP, ISTAT )_^1C_(EOF ?_^1_$IF ( AND(ISTAT,$100) .EQ. $100 ) GO TO 900_^1C_(ERROR ?_^1_$IF ( ISTAT .GE. 0 ) GO TO 250_^1_$CALL FILERR ( IDATA, 14, ISTAT, LU )_^1_$GO TO 900_^1C_(RECORD TO DELETE ? (CHAR 18 = D)_^1 250 IF ( AND(RECBUF(9),$FF) .NE. $44 ) GO TO 200_^1C_(SAVE ACCT NUMBER_^1_$CALL CCSMVA ( RECBUF, 1, 16, KEY, 1, 16 )_^1_$CALL CCSMVA ( RECBUF, 1, 16, KSV, 1, 16 )_^1C_(PERFORM THE DELETES_^1_$CALL DELREC ( IREQ, RECBUF, ISTAT )_^1_$IF (ISTAT .GE. 0 ) GO TO 300_^1_$CALL FILERR ( IDATA, 15, ISTAT, LU )_^1_$GO TO 900_^1C_(DELQMST FILE_^1 300 CALL READR ( DREQ, RECBUF, KEY, ISTAT )_^1_$IF ( ISTAT.GE.0.AND.AND(ISTAT,$200).NE.$200) GO TO 305_^1_$I=13_]_^1_$GO TO 308_^1 305 CALL DELREC ( DREQ, RECBUF, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 310_^1_$I=15_]_^1 308 CALL FILERR ( DDATA, I, ISTAT, LU )_^1_$GO TO 900_^1C_(COSIGNER FILE_^1 310 CALL CCSMVA ( KSV,1,16,KEY,1,16)_^1_$CALL READR ( CREQ, RECBUF, KEY, ISTAT )_^1_$IF (AND(ISTAT,$100).EQ.$100.OR.AND(ISTAT,$200).EQ.$200) GO TO 320_^1_$IF ( ISTAT .GE. 0 ) GO TO 315_^1_$I=13_]_^1_$GO TO 318_^1 315 CALL DELREC ( CREQ, RECBUF, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 320_^1_$I=15_]_^1 318 CALL FILERR ( CDATA, I, ISTAT, LU )_^1_$GO TO 900_^1C_(ACTFIL FILE_^1 320 CALL CCSMVA ( KSV,1,16,KEY,1,18 )_^1 321 CALL READR ( AREQ, RECBUF, KEY, ISTAT )_^1_$CALL CCSCST ( RECBUF,1,16,KSV,1,16,I )_^1_$IF (AND(ISTAT,$100).EQ.$100.OR.I.NE.0) GO TO 200_^1_$IF (ISTAT.GE.0) GO TO 325_^1_$I=13_]_^1_$GO TO 328_^1 325 CALL DELREC ( AREQ, RECBUF, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 321_^1_$I=15_]_^1 328 CALL FILERR ( ADATA, I, ISTAT, LU )_^1C_(CLOSE ALL FILES_^1 900 CALL CLOSFL ( AREQ , ISTAT )_^1_$CALL CLOSFL ( CREQ , ISTAT )_^1_$CALL CLOSFL ( DREQ , ISTAT )_^1_$CALL CLOSFL ( IREQ , ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,MHDELE,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ PNMCHNG CSY/ NMC 0020P1*K,P2,L9,I7_^1*FTN_]_^1_$PROGRAM NMCHNG_^1_#1_2/CCS 2.0_;05-08-78_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^11_]_^1C_(THIS PROGRAM TAKES ALL ACCOUNTS THAT HAVE A NAME CHANGE_^1C_(FROM EITHER THE UPDATE PROGRAM OR FROM COLECT, DETERMINED_^1C_(BY A RECORD IN THE ADDACT ACCOUNT FILE WITH A 'N' IN COLUMN_^1C_(17, AND EXECUTES A DELREC REQUEST ON THE ORIGINAL RECORD_^1C_(FOLLOWED BY A WRITER REQUEST WITH THE NEW RECORD._^11_]_^1_$INTEGER DEQREC(1000),DEQTMP(1002),DEQREQ(24),DDATA(15),_^1_#2_'ADATA(15),ADDREQ(24),ADDREC(10),STAT,N,HD(20,3),_^1_#3_'DT(3),USER(4),ACTSVE(8)_^11_]_^1_$DATA DDATA / 'DELQMST ', 8*$2020, 1, 1, 1 /_^1_$DATA ADATA / 'ADDACT ', 8*$2020, 0, 1, 0 /_^1_$DATA DEQREQ, ADDREQ / 48*0 /_^12_]_^1C_(ACCEPT ITOS LOG IN_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^12_]_^1C_(OPEN THE FILES FOR USE_^1_$CALL OPENFL ( ADDREQ, ADATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1C_(REPORT THE ERROR AND EXIT_^1_$CALL FILERR ( ADATA, 3, ISTAT, LU )_^1_$GO TO 300_^11_]_^1 100 CALL OPENFL ( DEQREQ, DDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 200_^1C_(REPORT THE ERROR AND EXIT_^1_$CALL FILERR ( DDATA, 3, ISTAT, LU )_^1_$GO TO 300_^1._]_^1C_(GET THE NEXT RECORD FROM THE ADDACT FILE_^1 200 CALL GETS ( ADDREQ, ADDREC, I, ISTAT )_^1C_(EOF ?_^1_$IF ( AND(ISTAT,$100) .EQ. $100 ) GO TO 300_^1C_(FILE ERROR ?_^1_$IF ( ISTAT .GE. 0 ) GO TO 210_^1C_(REPORT AND EXIT_^1_$CALL FILERR ( ADATA, 14, ISTAT, LU )_^1_$GO TO 300_^11_]_^1C_(IS THIS A NAME CHANGE ?_^1 210 CALL CCSGET ( ADDREC, 17, STAT )_^1_$IF ( STAT .NE. $4E ) GO TO 200_^11_]_^1C_(THIS IS A NAME CHANGE, GET THE DELQMST RECORD_^1_$CALL CCSMVA ( ADDREC, 1, 16, ACTSVE, 1, 16 )_^1_$CALL READR ( DEQREQ, DEQREC, ACTSVE, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 220_^1C_(REPORT THE ERROR AND EXIT_^1_$CALL FILERR ( DDATA, 13, ISTAT, LU )_^1_$GO TO 300_^11_]_^1C_(VERIFY THIS IS THE CORRECT ACCOUNT, THEN SAVE THE ACCOUNT_^1 220 CALL CCSCST ( DEQREC, 1, 16, ADDREC, 1, 16, ICOMP )_^1_$IF ( ICOMP .NE. 0 ) GO TO 200_^1_$CALL CCSMVA ( DEQREC, 1, 2000, DEQTMP, 1, 2000 )_^1_$CALL CCSMVA ( DEQREC, 1047,6,DEQREC,18,6 )_^11_]_^1C_(DELETE THE ORIGINAL RECORD_^1_$CALL DELREC ( DEQREQ, DEQREC, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 230_^1C_(REPORT THE ERROR AND EXIT_^0_$CALL FILERR ( DDATA, 16, ISTAT, LU )_^1_$GO TO 300_^11_]_^1C_(STORE THE NEW RECORD_^0 230 CALL CCSBLK ( DEQTMP(524), 6 )_^0_$CALL WRITER ( DEQREQ, DEQTMP, ACTSVE, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 200_^1C_(REPORT THE ERROR AND EXIT_^1_$CALL FILERR ( DDATA, 12, ISTAT, LU )_^12_]_^1C_(CLOSE THE FILES AND TERMINATE THE JOB_^1 300 CALL CLOSFL ( DEQREQ, ISTAT )_^1_$CALL CLOSFL ( ADDREQ, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,NMCHNG,,,B_^1*Z_]_^1*CTO,INSTALLED_^1*K,I10_]_^1*V,10_]_^__ PPGCNT1 CSY/ PGC P1*K,I7,P2,L9_^1*FTN_]_^1_$PROGRAM PGCNT1_^1_#1_2/CCS 2.0_;06-12-78_^12_]_^1C_(COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_(DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_(CREDIT COLECTION SYSTEM VERSION 2.0_^12_]_^1C_(THIS PROGRAM CONTROLS THE FLOW OF THE MINI-RPG EXECUTION._^1C_(. REMOVE THE ENTRIES FROM THE $$PGMNAM FILE_^0C_(. SET UP LINKAGE FOR SELECTION L ON RP MENU_^1C_(. DETERMINES WHEN THE TWO RPG PROGRAMS HAVE BEEN INSTALLED_^0C_(. PASS CONTROL CONTROL TO THE OPERATOR_^1C_]_^1C_(THIS PROGRAM IS CALLED FROM THE PROCEDURE FILE 'PRFRPTCNT'_^0C_(AND THEN PASS TO OPERATOR TO EXECUTE REPORT XX_^1C_(WHERE XX IS THE JOB IN PROGRESS WHICH IS CONTAINED IN THE_^1C_(UTILITY FILE RECORD 'RPTG'._^12_]_^1_$INTEGER RDATA(24),RREQ(24),UDATA(15),HDATA(15),HREQ(24),UREQ(24),_^1_#1_"UREC(40),HREC(20),PDATA(15),PREQ(24),PREC(40),USER(4),HOST,_^0_#2_"JOBNO,NREQ(24),KTEMP(4),MENU(4),ASCZER,NNAME(12),NDATA(12)_^1_$INTEGER LDATA(15),LREQ(24),LREC(10),LNAME1(3),LNAME2(3),LNAME(3)_^1_$INTEGER RRN(2),MDATA(15),MREQ(24),MREC(40)_^12_]_^1_$DATA UDATA / 'UTIFIL_1',1,1,0 /_^1_$DATA MDATA / '$$RGMENU$$', 7*$2020, 0, 1, 1 /_^1_$DATA PDATA / 'RPTPGM_1',1,1,0 /_^1_$DATA HDATA / '$$HOST $$_-',0,1,0 /_^0_$DATA RDATA / '$$RPMENU$$', 7*$2020, 0, 1, 1,9*0 /_^11_]_^1_$DATA RREQ,UREQ,PREQ,HREQ,NREQ,LREQ,MREQ / 168*0 /_^1_$DATA MENU / 'MNUPRO ' / , RRN / 0, 0 /_^1_$DATA KTEMP / 'RPTG_"' / , ASCZER / '00' / , HOST / 0 /_^1_$DATA NDATA / 'PRCWRK_1' /_^0_$DATA NNAME / 'PRFPG000CCS20 ' , 5*$2020 /_^1_$DATA LDATA / '$$PGMNAM$$_-',1,1,1 /_^1_$DATA LNAME1 / 'RPTE00' / , LNAME2 / 'RPTP00' /, LNAME /'RPT000'/_^1._]_^1C_(ACCEPT THE ITOS LOG IN_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^12_]_^1C_(OPEN THE UTILITY FILE AND GET THE 'RPTG' RECORD TO_^1C_(WHICH NUMBER IS BEING PROCESSED_^1 100 CALL OPENFL ( UREQ, UDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 150_^1C_(FILE ERROR, REPORT AND EXIT_^1_$CALL FILERR ( UDATA, 3, ISTAT, LU )_^1_$CALL CHAIN ( MENU )_^1 150 CALL READR ( UREQ, UREC, KTEMP, ISTAT )_^1_$IF ( ISTAT .GE. 0 .AND. AND(ISTAT,$200) .NE. $200 ) GO TO 200_^1C_(FILE ERROR OR WRONG RECORD, REPORT AND EXIT_^1_$CALL FILERR ( UDATA, 13, ISTAT, LU )_^1_$CALL CLOSFL ( UREQ, ISTAT )_^1_$CALL CHAIN ( MENU )_^1 200 JOBNO = UREC(9)_^1_$CALL CLOSFL ( UREQ, ISTAT )_^02_]_^0C_(DELETE PRFPG000, NO CHECK ISTAT (MAY NOT BE PRESENT)_^0_$DO 160 I=1,24_^0 160 UREQ(I) = 0_^0_$CALL DELETE ( UREQ, NNAME, ISTAT )_^1._]_^1C_(IF THE JOB NUMBER IS '00' THEN THE ENTRY IN THE MENU_^1C_(IS NOT UPDATED._^1_$IF ( JOBNO .EQ. ASCZER ) GO TO 300_^1C_(SET UP THE PROGRAM NAME IN THE MENU (SAVED REPORT)_^11_]_^1_$CALL OPENFL ( PREQ, PDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 201_^1_$CALL FILERR ( PDATA, 3, ISTAT, LU )_^1_$CALL CHAIN ( MENU )_^0 201 LNAME(3) = JOBNO_^1_$CALL READR ( PREQ, PREC, LNAME, ISTAT )_^1_$IF ( ISTAT .GE. 0 .AND. AND(ISTAT,$200) .NE. $200 ) GO TO 202_^1_$CALL FILERR ( PDATA, 13, ISTAT, LU )_^1_$CALL CLOSFL ( PREQ, ISTAT )_^1_$CALL CHAIN ( MENU )_^1 202 CALL CLOSFL ( PREQ, ISTAT )_^1_$CALL OPENFL ( MREQ, MDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 203_^1_$CALL FILERR ( MDATA, 3, ISTAT, LU )_^1_$CALL CHAIN ( MENU )_^1 203 RRN(2) = AND(JOBNO,$F00)/$100 + AND(JOBNO,$F) + 2_^1_$CALL READR ( MREQ, MREC, RRN, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 204_^1_$CALL FILERR ( MDATA, 13, ISTAT, LU )_^1_$CALL CLOSFL ( MREQ, ISTAT )_^1_$CALL CHAIN ( MENU )_^1 204 CALL CCSMVA ( PREC, 13, 30, MREC, 15, 58 )_^1_$CALL CCSMVA ( PREC, 7, 6, MREC, 67, 6 )_^1_$CALL UPDREC ( MREQ, MREC, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 205_^1_$CALL FILERR ( MDATA, 15, ISTAT, LU )_^1_$CALL CLOSFL ( MDATA, ISTAT )_^1_$CALL CHAIN ( MENU )_^1 205 CALL CLOSFL ( MREQ, ISTAT )_^1._]_^1C_(REMOVE THE ENTRIES 'RPTEXX' AND 'RPTPXX' FROM THE_^1C_($$PGMNAM FILE TO ALLOW CORRECT LINKAGE ON EXECUTION_^1 300 LNAME1(3) = JOBNO_^1_$LNAME2(3) = JOBNO_^1_$CALL OPENFL ( LREQ, LDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 250_^1_$I = 3_^1_$GO TO 299_^1 250 CALL READR ( LREQ, LREC, LNAME1, ISTAT )_^1_$IF (AND(ISTAT,$100).EQ.$100.OR.AND(ISTAT,$200).EQ.$200) GO TO 270_^1_$IF ( ISTAT .GE. 0 ) GO TO 260_^1_$I = 13_^1_$GO TO 299_^1 260 CALL DELREC ( LREQ, LREC, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 270_^1_$I = 15_^1_$GO TO 299_^1 270 CALL READR ( LREQ, LREC, LNAME2, ISTAT )_^1_$IF (AND(ISTAT,$100).EQ.$100.OR.AND(ISTAT,$200).EQ.$200) GO TO 290_^1_$IF ( ISTAT .GE. 0 ) GO TO 280_^1_$I = 13_^1_$GO TO 299_^1 280 CALL DELREC ( LREQ, LREC, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 290_^1_$I = 15_^1 299 CALL FILERR ( LDATA, I, ISTAT, LU )_^1_$CALL CLOSFL ( LREQ, ISTAT )_^1_$CALL CHAIN ( MENU )_^1 290 CALL CLOSFL ( LREQ, ISTAT )_^0._]_^0C_(SET UP SELECTION L LINKAGE ON THE RP MENU_^0_$RRN(1) = 0_^0_$RRN(2) = 0_^0_$CALL OPENFL ( RREQ, RDATA, ISTAT )_^0_$IF ( ISTAT .GE. 0 ) GO TO 330_^0_$CALL FILERR ( RDATA, 3, ISTAT, LU )_^0_$CALL CHAIN (MENU)_^0 330 CALL GETS ( RREQ, PREC,RRN,ISTAT)_^0_$IF ( ISTAT .GE. 0 ) GO TO 340_^0_$CALL FILERR ( RDATA, 14, ISTAT , LU )_^0_$CALL CLOSFL ( RREQ, ISTAT )_^0_$CALL CHAIN (MENU)_^0 340 IF ( PREC(6) .NE. $4C20 ) GO TO 330_^0_$PREC(4) = JOBNO_^0_$CALL UPDREC ( RREQ, PREC, ISTAT)_^0_$CALL CLOSFL ( RREQ, ISTAT )_^12_]_^1C_(RENAME THE PROCEDURE WORK FILE TO THE CORRECT NAME_^1C_(FOR LINKAGE IN THE $$PROCED FILE_^1 320 NNAME(4) = JOBNO_^1_$CALL RENAME ( NREQ, NDATA, NNAME, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 350_^1C_(FILE ERROR, REPORT AND EXIT_^1_$CALL FILERR ( NDATA, 9, ISTAT, LU )_^1_$CALL CHAIN ( MENU )_^1._]_^1C_(CHECK IF THE TWO BATCHED RPG PROGRAMS HAVE BEEN INSTALLED,_^1C_(WHEN THEY ARE PASS CONTROL TO THE PROCEDURE FOR EXECUTION_^1C_(OF THE PROCEDURE STREAM. THE COMPLETION OF THE INSTALLS_^1C_(IS DETERMINED BY CHECKING THE ENTRIES OF THE $$HOST FILE_^1C_(FOR THE HOST=LOCL, FOR ALL STATUS'S COMPLETE :_^12_]_^1********************* CAUTION ! ***************************************_^1**_]_#**_^1**_'THERE SHOULD BE NO OTHER BATCH FILE PROCESSING BEING DONE **_^1**_'AT THE SAME TIME AS MINI-RPG; AS THIS SECTION WILL BE_$**_^1**_'LOCKED INTO EXECUTION FOR A LONG, LONG TIME; AND AT THE_"**_^1**_'COMPLETION OF THIS STREAM ALL JOB FILES ARE FLUSHED FROM_!**_^1**_'THE HOST SYSTEM._J**_^1**_]_#**_^1***********************************************************************_^12_]_^1 350 CALL OPENFL ( HREQ, HDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 400_^1C_(FILE ERROR, REPORT AND EXIT_^1_$CALL FILERR ( HDATA, 3, ISTAT, LU )_^1_$CALL CHAIN ( MENU )_^1C_(GET THE 'LOCL' HOST RECORD_^1 400 CALL GETS ( HREQ, HREC, HOST, ISTAT )_^1_$IF ( AND(ISTAT,$80) .EQ. $80 ) GO TO 400_^1_$IF ( ISTAT .GE. 0 ) GO TO 450_^1C_(FILE ERROR, REPORT AND EXIT_^1_$CALL FILERR ( HDATA, 14, ISTAT, LU )_^1_$CALL CLOSFL ( HREQ, ISTAT )_^1_$CALL CHAIN ( MENU )_^1C_(CLOSE THE FILE, THEN SEARCH TO VERIFY ALL JOBS COMPLETE_^1 450 CALL CLOSFL ( HREQ, ISTAT )_^1_$DO 500 I = 4, 18_^1_$IF ( HREC(I) .EQ. 0 ) GO TO 500_^1C_(LOCATED A ACTIVE JOB, CHECK IF COMPLETE_^1_$I1 = AND(HREC(I),$F000) / $1000_^1_$I2 = AND(HREC(I),$0F00) / $100_^1_$I3 = AND(HREC(I),$00F0) / $10_^1_$I4 = AND(HREC(I),$000F)_^1_$IF ( I1 .EQ. 0 .OR. I1 .GT. 3 .AND._^1_#1_#I2 .EQ. 0 .OR. I2 .GT. 3 .AND._^1_#2_#I3 .EQ. 0 .OR. I3 .GT. 3 .AND._^1_#3_#I4 .EQ. 0 .OR. I4 .GT. 3 ) GO TO 500_^1_$GO TO 550_^1 500 CONTINUE_^1C_(ALL JOBS ARE INACTIVE OR ARE COMPLETE, PASS CONTROL_^0C_(TO THE OPERATOR_^0_$DCALL PGMOUT_^12_]_^1C_(NOT ALL JOBS ARE DONE, PAUSE THEN CHECK AGAIN_^1 550 DO 600 I = 1, 24_^1 600 HREQ(I) = 0_^1_$HOST = 0_^1_$GO TO 350_^12_]_^1_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^0*K,P8,I8_]_^0*P,F,2_]_^0*K,I8_]_^0*N,PGCNT1,,,B_^1*Z_]_^1*CTO, PGCNT1 INSTALLED..._^0*K,I10_]_^0*V,10_]_^1*K,I10_]_^1*V,10_]_^__DPPGCNT2 CSY/ PGC P1*K,I7,P2,L9_^1*FTN_]_^1_$PROGRAM PGCNT2_^1_#1_2/CCS 2.0_;06-12-78_^1C_]_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1978_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#CREDIT COLLECTION SYSTEM VERSION 2.0_^1C_]_^12_]_^0_$INTEGER USER(4),MENU(4),UDATA(15),UREQ(24),UREC(42),RPTG(2)_^0_$DATA RPTG / 'RPTG' /, MENU / 'MNUPRO ' /, UREQ / 24*0 /_^0_$DATA UDATA / 'UTIFIL ', 8*$2020, 1, 1, 1 /_^02_]_^0_$CALL PGMIN ( USER, LU, MODE, NPORT )_^02_]_^0_$I = 0_^0_$CALL OPENFL ( UREQ, UDATA, ISTAT )_^0_$IF ( ISTAT .GE. 0 ) GO TO 100_^0_$CALL FILERR ( UDATA, 3, ISTAT, LU )_^0_$CALL CHAIN ( MENU )_^02_]_^0 100 CALL READR ( UREQ, UREC, RPTG, ISTAT )_^0_$IF ( ISTAT.GE.0.AND.AND(ISTAT,$200).NE.$200) GO TO 200_^0_$CALL FILERR ( UDATA, 13, ISTAT, LU )_^0_$CALL CLOSFL ( UREQ, ISTAT )_^0_$CALL CHAIN ( MENU )_^02_]_^0 200 IF ( UREC(12) .EQ. $2020 ) GO TO 300_^0_$UREC(12) = $2020_^0_$CALL UPDREC ( UREQ, UREC, ISTAT )_^0_$I = 1_^02_]_^0 300 CALL CLOSFL ( UREQ, ISTAT )_^0_$IF ( I .EQ. 0 ) CALL CHAIN ( MENU )_^0_$CALL PGMOUT_^1_$END_]_^1 MON_]_^1*LIBEDT_]_^1*K,I8,P8_]_^1*P,F,2_]_^1*K,I8_]_^1*N,PGCNT2,,,B_^1*Z_]_^1*CTO, PGCNT2 INSTALLED_^1*K,I10_]_^1*V,10_]_^__ PPGGEN CSY/ PGG P1*K,I7,P2,L9_^1*ASSEM_]_^1_%NAM PGGEN_(CCS 2.0_104-18-78_^1*_]_^1*_$COPYRIGHT CONTROL DATA CORPORATION, 1978_^1*_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1*_$CREDIT COLLECTION SYSTEM VERSION 2.0_^1*_]_^1*_]_^1*_$DUMMY PROGRAM TO JUMP AROUND LABELED COMMON_^1*_]_^1_%ENT PGGEN_^1_%EXT PGGEN0_^1PGGEN JMP PGGEN0_'JUMP TO FORTRAN MAIN MODULE_^1_%END_]_^1 MON_]_^1*FTN_]_^1_$BLOCK DATA_^1_$COMMON /CBLK1/UTIFIL,DELQM,RPTTBL,RPTPGM,RPTWKE,UTIRQB,DLQRQB,_^1_#2TBLRQB,PGMRQB,WKERQB,OPBUF,Q2SAVE,Q3SORT,Q4LVLB,Q5SLCT,Q6NAME,_^1_#3Q6TOT,Q6EPOS,Q7RPT,Q5ANS,FILERR,TBL,HPGMN,UTREC,PGMKEY,TBLKEY,BIN,_^1_#4HPKEY,RADDR,TBLREC,OPHLD,D1TYPE,D1LNG,LRPGWK,IHOLD2,PGMREC,IND,_^1_#5PRCREC,ERRMSG,UTEMSG,ABTMSG,XYN,TC,CS,PRCWRK,PRCRQB,LU_^1_$COMMON /CBLK1/IMAXC,NLKEY,NNAME,NSKEY,NSLCT,NTFLDS,RPTWKP,WKPRQB_^1C_]_^1C_]_^1_$INTEGER UTIFIL(15),DELQM(15),RPTTBL(15),RPTPGM(15),RPTWKE(15),_^1_#2_%UTIRQB(24),DLQRQB(24),TBLRQB(24),PGMRQB(24),WKERQB(24),_^1_#3_%PRCWRK(15),PRCRQB(24),RPTWKP(15),WKPRQB(24)_^1_$INTEGER OPBUF(32),Q2SAVE(1),Q3SORT(60),Q4LVLB(9),Q5SLCT(170),_^1_#2_%Q6NAME(51),Q6TOT(77),Q6EPOS(102),Q7RPT(15),Q5ANS_^1_$INTEGER FILERR(1),XYN(1),TC(1),CS(2),TBL(4),UTREC(42),PGMKEY(3),_^1_#2_%TBLKEY(3),HPGMN(3),BIN(1),HPKEY(3),RADDR(1),TBLREC(42),_^1_#3_%D1LNG(2),LRPGWK(42),IHOLD2(2),PGMREC(42),IND(3),_^1_#4_%PRCREC(42),ERRMSG(23),UTEMSG(26),ABTMSG(7),OPHLD(1),_^1_#5_%D1TYPE(1)_^1_$INTEGER IMAXC(1),NLKEY(1),NNAME(1),NSKEY(1),NSLCT(1),NTFLDS(1)_^1C_]_^1C_"FILE NAME,OWNER,NAME,VOLUME NAME,ACCESS INDIC,REC RTV,LOCK INDIC_^1_$DATA UTIFIL_!/'UTIFIL_)CDD01_!',1,1,1/_^1_$DATA DELQM_"/'DELQMST_(CDD01_!',0,1,0/_^1_$DATA RPTTBL_!/'RPTTBL_1',1,1,0/_^1_$DATA RPTPGM_!/'RPTPGM_1',1,1,0/_^1_$DATA RPTWKE_!/'RPTWKE_1',0,1,-1/_^1_$DATA RPTWKP_!/'RPTWKP_1',0,1,-1/_^1_$DATA PRCWRK_!/'PRCWRK_1',0,1,-1/_^1C_]_^1C_"FILE BUFFERS--INITIALIZED TO BINARY 0_^1_$DATA UTIRQB_!/24*$0000/_^1_$DATA DLQRQB_!/24*$0000/_^1_$DATA TBLRQB_!/24*$0000/_^1_$DATA PGMRQB_!/24*$0000/_^1_$DATA WKERQB_!/24*$0000/_^1_$DATA WKPRQB_!/24*$0000/_^1_$DATA PRCRQB_!/24*$0000/_^1C_]_^1_$DATA ERRMSG/' ERROR IN_'FILE REQUEST, ISTAT = $_"',$D0A/_^1_$DATA UTEMSG/' ERROR IN UTIFIL--RPTG RECORD NOT FOUND OR INVALID',_^1_#2$D0A/_^1_$DATA ABTMSG/' JOB ABORTED',$D0A/_^1C_]_^1C_"MISCELLANEOUS_^1_$DATA HPGMN/'RPT000'/,LRPGWK/42*$2020/,PRCREC/42*$2020/,XYN/-1/,_^1_#2_"CS/$18,$D0A/_^1_$DATA Q3SORT/60*$2020/,Q4LVLB/9*$2020/,Q5SLCT/170*$2020/,_^1_#2_#Q6NAME/51*$2020/,Q7RPT/15*$2020/,Q6TOT/77*$2020/,_^1_#3_#Q6EPOS/102*$2020/_^1_$END_]_^1_$SUBROUTINE PGGEN0_^1_#1_2/CCS 2.0_;03/01/78_^1C_]_^1C_"COPYRIGHT CONTROL DATA CORPORATION 1978_^1C_"DATA SYSTEMS LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_"CYBERCOLL VERSION 2.0_^1C_]_^1C_"THIS PROGRAM FUNCTIONS AS A GENERAL REPORT PROGRAM GENERATOR._^1C_"THERE ARE 4 BASIC STEPS:_^1C_(1. OPERATOR COMMUNICATION - THE OPERATOR ENTERS THE REPORT_^1C_,REQUIREMENTS. THE PROGRAM PROMPTS THE OPERATOR AND_^1C_,EDITS THE RESPONSES._^1C_(2. GENERATES RPG SOURCE CODE - BASED ON THE OPERATOR'S_^1C_,RESPONSES, A RPG PROGRAM IS GENERATED TO PRODUCE THE_^1C_,REQUIRED REPORT._^1C_(3. GENERATES A PROCEDURE STREAM TO BE USED IN EXECUTING_^1C_,THE RPG PROGRAM PRODUCED_^1C_]_^1C_"THE FOLLOWING SUBPROGRAMS/ROUTINES ARE CALLED:_^1C_(1. ASCBIN--CONVERTS 1 WORD ASCII TO 1 WORD BINARY_^1C_(2. CCSHXA--CONVERTS 1 WORD BINARY TO 2 WORD ASCII_^1C_(3. PGSEDT--EDITS OPERATOR RESPONSE FOR:_^1C_3C_'-CONTINUE TO NEXT QUESTION_^1C_3A_'-ABORT JOB_^1C_3REPEAT_!-REPEAT THIS QUESTION_^1C_3XXXXXX_!-DATA RESPONSE, DOES NOT EDIT DATA AS_^1C_=THE VALIDITY VARIES_^1C_(4. PGSJR --RIGHT JUSTIFIES DATA WITH LEADING ZEROS_^1C_(5. PGSJL --LEFT JUSTIFIES DATA WITH TRAILING BLANKS_^1C_(6. PGSLST --PRINTS A REPORT BASED ON THE CONTENTS OF THE_^1C_3RPTIBL FILE (DATA ELEMENT FILE)_^1C_(7. CCSGET--GET 1 CHARACTER FROM AN ARRAY & STORE IN RIGHTMOST_^1C_3BYTE OF A 1 WORD WORK AREA_^1C_(8. CCSPUT--PUT RIGHTMOST BYTE OF A 1 WORD WORK AREA INTO GIVEN_^1C_3POSITION OF AN ARRAY_^1C_(9. PGGEN1--OPERATOR COMMUNICATION_^1C_'10. PGGN2E--GENERATES RPG SOURCE CODE FOR EXTRACTION PGM_^1C_'11. PGGN2P--GENERATES RPG SOURCE CODE FOR PRINT PGM_^1C_'12. PGGEN3--GENERATES PROCEDURE STREAM FOR RPG PGMS & SORT_^1C_'13. CCSCST--COMPARE 2 ASCII CHARACTER STRINGS_^1C_]_^1C_]_^1C_]_^1C****_.COMMON BLOCK_!CBLK1_^1C_]_^1_$COMMON /CBLK1/UTIFIL,DELQM,RPTTBL,RPTPGM,RPTWKE,UTIRQB,DLQRQB,_^1_#2TBLRQB,PGMRQB,WKERQB,OPBUF,Q2SAVE,Q3SORT,Q4LVLB,Q5SLCT,Q6NAME,_^1_#3Q6TOT,Q6EPOS,Q7RPT,Q5ANS,FILERR,TBL,HPGMN,UTREC,PGMKEY,TBLKEY,BIN,_^1_#4HPKEY,RADDR,TBLREC,OPHLD,D1TYPE,D1LNG,LRPGWK,IHOLD2,PGMREC,IND,_^1_#5PRCREC,ERRMSG,UTEMSG,ABTMSG,XYN,TC,CS,PRCWRK,PRCRQB,LU_^1_$COMMON /CBLK1/IMAXC,NLKEY,NNAME,NSKEY,NSLCT,NTFLDS,RPTWKP,WKPRQB_^1C_]_^1C_"FILE RETRIEVAL_^1_$INTEGER UTIFIL(15),DELQM(15),RPTTBL(15),RPTPGM(15),RPTWKE(15),_^1_#2_"UTIRQB(24),DLQRQB(24),TBLRQB(24),PGMRQB(24),WKERQB(24),_^1_#3_"PRCWRK(15),PRCRQB(24),RPTWKP(15),WKPRQB(24)_^1C_]_^1C_"OPERATOR RESPONSES_^1_$INTEGER OPBUF(32),Q2SAVE,Q3SORT(60),Q4LVLB(9),Q5SLCT(170),_^1_#2_"Q6NAME(51),Q6TOT(77),Q6EPOS(102),Q7RPT(15),Q5ANS_^1C_]_^1C_"MISCELLANEOUS_^1_$INTEGER FILERR,XYN,TC,CS(2),TBL(4), HPGMN(3),RPTG(2),UTREC(42),_^1_#2_"ZERO,PGMKEY(3),TBLKEY(3),COMMA,BIN,HPKEY(3),RADDR,TBLREC(42),_^1_#3_"OPHLD,D1TYPE,D1LNG(2),LRPGWK(42),IHOLD2(2),PGMREC(42),IND(3),_^1_#4_"PRCREC(42),ERRMSG(23),UTEMSG(26),ABTMSG(7),FILREQ(24),MENU(4)_^1C_]_^1C_]_^1C_]_^1C_]_^1C_]_^1C****_#DATA STATEMENTS_^1C_]_^1_$DATA RPTG/'RPTG'/,ZERO/0/,COMMA/$002C/_^1_$DATA FILREQ/'OPENFLGETS PUTS CLOSFLLOKFILUPDRECCLOSFLUTIFIL'/_^0_$DATA MENU / 'MNUPRO ' /_^1C_]_^1C_"EXTERNALS_^1_$EXTERNAL AVMHXA,AMONTO,ADAYTO,AYERTO_^1_$EXTERNAL PGGEN1,PGGN2E,PGGN2P,PGGEN3_^1C_]_^1C*********_]_^1C****_#BEGIN PROCESSING_^1C*********_]_^1C_]_^1C_#LOGIN_^1C_]_^1_$CALL PGMIN(TBL,LU,I,J)_^1C_#VERIFY MASTER CONSOLE ONLY, EXIT IF NOT_^1_$IF (J.NE.0) GO TO 8900_^1C_]_^1C_]_^1C_]_^1C_#OPEN FILES_^1C_(UTILITY FILE_^1_$CALL OPENFL(UTIRQB,UTIFIL,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 8000_^1C_(DELINQUENT MASTER_^1_$CALL OPENFL(DLQRQB,DELQM,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 8000_^1C_(REPORT GENERATOR TABLE-OF-DATA-NAMES FILE_^1_$CALL OPENFL(TBLRQB,RPTTBL,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 8000_^1C_(PROCEDURE STREAM WORK FILE_^1_$CALL OPENFL(PRCRQB,PRCWRK,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 8000_^1C_(REPORT GENERATOR PROGRAM NAME FILE_^1_$CALL OPENFL(PGMRQB,RPTPGM,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 8000_^1C_(RPG EXTRACTION SOURCE CODE FILE_^1_$CALL OPENFL(WKERQB,RPTWKE,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 8000_^1C_(RPG PRINT SOURCE CODE FILE_^1_$CALL OPENFL(WKPRQB,RPTWKP,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 8000_^1C_]_^1C_]_^1C_2OPERATOR COMMUNICATION TO GET PARAMETERS_^1C_]_^1_$CALL PGGEN1_^1_$IF (RADDR.EQ.$8010) GO TO 8010_^1_$IF (RADDR.EQ.$8100) GO TO 8100_^1_$IF (RADDR.EQ.$8900) GO TO 8900_^1C_]_^1C_2GENERATE RPG SOURCE CODE--EXTRACTION PGM_^1C_]_^1_$CALL PGGN2E_^1_$IF (RADDR.EQ.$8010) GO TO 8010_^1_$IF (RADDR.EQ.$8020) GO TO 8020_^1C_]_^1C_8GENERATE RPG SOURCE CODE--PRINT PGM_^1C_]_^1_$CALL PGGN2P_^1_$IF (RADDR.EQ.$8010) GO TO 8010_^1_$IF (RADDR.EQ.$8020) GO TO 8020_^1C_]_^1C_2GENERATE PROCEDURE STREAM_^1C_]_^1_$CALL PGGEN3_^1_$IF (RADDR.EQ.$8020) GO TO 8020_^1C_]_^1C_]_^1C*********_)UPDATE UTIFIL, RPTPGM WITH_^1C*********_)NEW REPORT PROGRAM IF PROGRAM IS SAVED_^1C_]_^1C_2CURRENT RPT NAME_^1_$UTREC(7)=HPGMN(1)_^1_$UTREC(8)=HPGMN(2)_^1_$UTREC(9)=HPGMN(3)_^0_$UTREC(12) = $8010_^1C_  @P0  @P0  @P0 <-- HDR2 FROM UTILITY FILE GOES HERE --> DAILY MASTER FILE UPDATE REPORT @P0 H PAGE @P0 \ @P0 _<-- HDR3 FROM UTILITY FILE GOES HERE --> <-DATE->  @P0 @P0 @P0hADDACT  @P0ACCAGE  @P06COSIGNER  @P0 DELQMST  @P0INACCT  @P0UPDINPUT  @P0UPDPRINT  @P0RSWFIL  @P0TRANFL  @P0TRNBCK  @P0XUTIFIL  @P8 @P0 FHDR1@P0 HUPDY@P8 B@P8 w@P8 e@P8 @P8 @P8 @P8 @P8 @P8 2@P8 Y@P8 @P8 @P8 _@P0 00000000001@P0 000000000000@P0 000000000000@P0 000000000000@P0 000000000000000000000000000000000000@P0 000000000000@P8 9@P8 :@P8 ;@P8 <@P8 =@P8 >@P8 ?@P8 @@P8 A@P8 B @P8 C @P8 D @P8 E @P8 F @P8 G@P8 H@P8 I@P8 J@P8 K@P8 L@P8 M@P8 N@P8 O#@P8 P(@P8 Q7@P8 RB@P8 SP@P8 TR@P8 U`@P8 V@P0 000000000000@P8 ;@P8 #@P0 000000000000@P0 000000000000@P0  @P0  @P0J @P0^  @P0 @P0  @P0 @P0  @P0 @P0  @P0F @P0Z  @P0 @P0  @P0 @P0  @P0 @P0  @P0B @P0V  @P0 @P0  @P0 @P0  @P0 @P0  @P0> @P0R  @P0} @P0  @P0 @P0  @P0 @P0 @P0E@P0@P0g@P0@P0w@P0@P0@P0@P0%@P0@P0@P8 D@P8 &@P8 2@P8 @P8 )@P8 @P8 M@P0 n000000000000000000000000000000000000@P0 J000000000000000000000000000000000000@P0 \000000000000000000000000000000000000@P8 @P8 @P8@P8 @P8 @P8 w@P8 k@P8 @P8@P8 @P8 @P0 + @P8@P0 %301 @P0 '302 @P0 )303 @P8 @P8 @P0 000000000000@P8@P0 000000000000@P0 000000000000@P0 000000000000@P8 P P WFUPDAT B56 F CCS CCS 3.0 SL-149@PTTT0 TTTT33 : < ) :3 < . . \33 : < '30 : < .  \@P3+ : < %30 : < . 'T0 T300 13T H3 -\ lT 03; ; : @PV :T0 o\33 : < + :3 < .̶  T B3\ 0 ; 30 : :\0 W TTTTT@P33̻ 3'\ E3 -T \ 70 / T\\\3\̝ &\3; H -@P\\ T\\\T3= '3TG H3 -\\0 9H/PFUPDATPUPINITLABHANNXTRANTOTALP UPDENDGETMASCCSCSTRSWIT 6UPDRECFILERRCCSADDPPRTLINXFORMLNgUNCUPDyPCONUPD{ADDIT }COSUPDWRITERUPDIT REACITP P WUPINIT C49 F CCS CCS 3.0 SL-149@P@P T -d0 d 0d T3 : ~3 ; :T33 : ? 3 : ? 8"d @P4h h "p8n (h 1 T3 (T33 < - T @P_  \30 .\30 < -\  d 3\X &\33X < -3\\ 0 &@P3\ <3 -\\30g6̽ &\630 < -\3\Eh̰ &\33h < -3\\w0̣ &;\ <@P -\\30̖ &\30 < -\3TM00 (TV30 < -T0\ "0 5 #;\%@P &3\ <0 -\\3 .٤  \30 < -\0 d dT330 F8¤ @P ̽0 ̸ &\X30 F -\ B, hT'0; > P@P0% ; P0 G 1\300 H̖ 0  (T3X F0 -T03 H h/T2@P0P$ C)d T3 > I\30 >   &\30 F -\  8 d@P|HPUPINIT~PAMONTOADAYTOAYERTOPGMIN EDIT CCSMVA OPENFLFILERR@UPDENDFREADR ICCSADNCCSBLKVP P WLABHAN B67 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT   T3 < hT3 : Sz0 S 1\@P \3 < h3T lHPLABHANPNXTRANTAPMOTCCSMVACLOSFLP P WLNXTRAN B85 F CCS CCS 3.0 SL-149@P@P@P1h T300 1'0 T30 G -T dT 1 @P. T0T h  l @P0< T 9HPNXTRANHPSTATIT2GETS FILERRUPDEND"FREAD (DISP 0CCSE2AAP P WTOTALP C23 F CCS CCS 3.0 SL-149@P * TOTALS *  @P+ @P? @PD * P R E V I O U S@Po * @P @P ACCOUNTS NUMBER AMT DELQ PAYOFF AMT DELQ  PA@PYOFF @P @P ADDED  @P @P @P REACTIVATED  @P; @PO @PT UPDATED  @P @P @P RELEASED  @P @P @P SATISFIED  @P @P @P WRITTENOFF  @PK @P_ @Pd REJECTED  @P @P @P0 5 Bl dT31 @ ?3 : ?\ 3 @ ? :03 ?\ @13 ?b : ?3\ @ ?0 : ?\39 @ ?@P0 : ?\31 @ ?.3 : ?\ 3 @ ?r :0 ? h h D(hT@Pȵ  D(hT 5@Pا 1ء 1T1 =3 ; <\ 13 =" ; <1\ =f3 ; <\ 13 = ; <1\ =)3 ; <\ @P, =m ;03 <\ P =0 ; <\3 V = ;03 <\ J =09 ; <\3 =u :03 <\ t =0 : <\3 z = :0; <\ n =@P3WA : <1\ =|3 : <\ b13 = : <1\ h =3 : <\ \13 =H : < d D,hT@P} 1H"PTOTALPPCCSMVACCSGETCCSPUTEDIT  PRTLIN{P P WsUPDEND C47 F CCS CCS 3.0 SL-149@P? T00r 0\g0P 0\E0 0\w0 8\@P+ 3\0 3\%  3\쨷 3\Ũ ;\@P0V#  \00 T 0 =THPUPDENDoPCLOSFLTAPMOTgPGMOUTkP P WEGETMAS B58 F CCS CCS 3.0 SL-149@PT33 = I >3 : IT33 >   (T3 F0 -T @P0+   d0 l1THPGETMASAPCCSMVAREADR FILERRUPDEND%CCSBLK;P P WkRSWIT C16 F CCS CCS 3.0 SL-149@P@PWRS@P999 @P998 @P997 @P @P @P - ACCOUNT NOT IN ACCAGE @P0  d0T A0  /  l\ @0HhlT3; ?@P0E  ? 0(π h  (ʀ hT 0 ;@PV :@PX : ( Vh 0( Vh\ @Pg :@Pi : ( hh 0( hh\ @Px :@Pz : ( Dh 0( Dh\ @P :@P :\33 B 0 B\\33 I3 : I\31  : 03 ;\ 3 ? ?3Tw3 : (T@P3 D0 -TT3@ I30 > : IT3 >0  1ݤ0  \3; F -@P\\ 33 : K :0 KyT3 &\33 I -0\d00 \33  = 0; =\ @P3 < 03 <\ 33 B  B3\  B30  B\33  =3  = $h\@P3- : <3  @PA@PD@PG@PJ@PM(@PP@PS@PV@PY@P\@P_@PbT 33 : ? 0 ? h!( ( hʝ ʘ !hހhڀ hր@P h\@P@P0 1\ : :T0\ :1 :\1HPUNCUPDPCCSMVAcCCSPYTP P WCONUPD B32 F CCS CCS 3.0 PSrPD SL-149@PCm@PN@P- NO NON-FINANCIALS ACCEPTED@P@P03U@P @P@P!@P$@P'@P*@P- @P0@P3@P6 @P9@P<@P=@PB@PGT33  ? 93 9 . . 60 ژ(0T h\hȞ #Ț dhȗhT 0 :h\@Pr hȍ(Έh 1 )T :33 M : Mr hȵ!& ( h  @P!ȦhȢh ȞhT @P@P 9ؑ3\ N33 N .̓ 43TH 33 ? 9 900 . . &\33 ? 03 ?\ :3; I] : I@PT3 ]T33E] : (3Th D3 -T3\ N30 NHEPCONUPDPCCSCSTICCSAD[ICALJLlCCSMVACHNGNFCCSPUTPUTS FILERRUPDENDP P WCOSUPD B33 F CCS CCS 3.0 SL-149@P@P@P@P@PY@PT3 N 93 9 . . \13 N30 9 9 . \3 N 93 9 . YT3; : I@P00 : J\11 ;T33g  (T630 E -T 10/ *T@P3[g0  3&\6 F3 -\\11 ;T30g &\630 H -\@PH|PCOSUPDPCCSCSTCCSMVA+WRITER:FILERRIUPDENDOREADR ZUPDRECuP P W.UPDIT C48 F CCS CCS 3.0 SL-149@PT33  : 03 :\ 33 : :3\  30 : :\33  :3 :\ 033 ; : 0 :T >@P+HPUPDIT *PCCSADDFORMLN%P P WREACIT C14 F CCS CCS 3.0 PSrPD SL-149@P@P @P0 50l3T 33 =  =3\ : ?30 ?\33 9 9 H\31 9 90 CT ?;T 0 ;@P3- : 03 :\ 33 : :3\  30 : :\33 : I3 : TT33  (T@P3X E -T 1/T330  &3\ F0 -\T3 RT30 &\@P3 H -\T 33 : L :00 L "0 5 X 6lT3  703\ :33 I= : I3\ : =38= J =T@P0G00GdI00HdJdK\ 33 : EL :03 E\ " :33 QR : U3T%=3 : (TV3; D -@PT\0 \33= : &\33 D -\HPREACITPCCSMVAFORMLN'CCSADD*WRITERGFILERRUPDENDREADR bCCSBLKvUPDRECzPUTACFCCSTIMPUTS P P WPRTLIN C09 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T 0 ;33 : : d [@P05 d0 \ hT [ T 5 [ؿ 10 T1 V3 T;\  V@P3` \\ _13 V \T30 <0 (T3 D0 -T0 &̞ l \@P3 V0 \3\ V0 \3\ ;0 &3\ D0 -\̥ \13 V 8\\@P0 :̺ &\30 D -\T V H TThhh4PPRTLINPQ8PKUPQ8PREPCCSADD*CCSGETAYERTOBCCSCSTECCSMVAP PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP PUPDATE A21 A CCS CCS 3.0 SL-149@PPUPDATEPFUPDATP P WQ8QBDS C46 F CCS CCS 3.0 SL-149@P8 601@P0 70360@P8@P8 / @P0 000000000000@P0 000000000000@P8 @P0 - ACCOUNT ALREADY IN ACCAGE @P0  CO HOST @P8 5 @P8 @P0 TRAN ACCOUNT BORROWERS DELINQUENT DELINQUENT C@P0 URRENT @P0 @P0 CODE NUMBER NAME DATE AMOUNT P@P0 AYOFF ACTION @P0 " @P0  @P0 @P0  @P8@P8 @P8 @P8@P8 @P0 <-- HDR1 FROM UTILITY FILE GOES HERE -->  @P0  @P0  @P0 <-- HDR2 FROM UTILITY FILE GOES HERE --> DAILY MASTER FILE UPDATE REPORT @P0 H PAGE @P0 \ @P0 _<-- HDR3 FROM UTILITY FILE GOES HERE --> <-DATE->  @P0 @P0 @P0hADDACT  @P0ACCAGE  @P06COSIGNER  @P0 DELQMST  @P0INACCT  @P0UPDINPUT  @P0UPDPRINT  @P0RSWFIL  @P0TRANFL  @P0TRNBCK  @P0XUTIFIL  @P8 @P0 FHDR1@P0 HUPDY@P8 B@P8 w@P8 e@P8 @P8 @P8 @P8 @P8 @P8 2@P8 Y@P8 @P8 @P8 _@P0 00000000001@P0 000000000000@P0 000000000000@P0 000000000000@P0 000000000000000000000000000000000000@P0 000000000000@P8 9@P8 :@P8 ;@P8 <@P8 =@P8 >@P8 ?@P8 @@P8 A@P8 B @P8 C @P8 D @P8 E @P8 F @P8 G@P8 H@P8 I@P8 J@P8 K@P8 L@P8 M@P8 N@P8 O#@P8 P(@P8 Q7@P8 RB@P8 SP@P8 TR@P8 U`@P8 V@P0 000000000000@P8 ;@P8 #@P0 000000000000@P0 000000000000@P0  @P0  @P0J @P0^  @P0 @P0  @P0 @P0  @P0 @P0  @P0F @P0Z  @P0 @P0  @P0 @P0  @P0 @P0  @P0B @P0V  @P0 @P0  @P0 @P0  @P0 @P0  @P0> @P0R  @P0} @P0  @P0 @P0  @P0 @P0 @P0E@P0@P0g@P0@P0w@P0@P0@P0@P0%@P0@P0@P8 D@P8 &@P8 2@P8 @P8 )@P8 @P8 M@P0 n000000000000000000000000000000000000@P0 J000000000000000000000000000000000000@P0 \000000000000000000000000000000000000@P8 @P8 @P8@P8 @P8 @P8 w@P8 k@P8 @P8@P8 @P8 @P0 + @P8@P0 %301 @P0 '302 @P0 )303 @P8 @P8 @P0 000000000000@P8@P0 000000000000@P0 000000000000@P0 000000000000@P8 P P WFUPDAT B56 F CCS CCS 3.0 SL-149@PTTT0 TTTT33 : < ) :3 < . . \33 : < '30 : < .  \@P3+ : < %30 : < . 'T0 T300 13T H3 -\ lT 03; ; : @PV :T0 o\33 : < + :3 < .̶  T B3\ 0 ; 30 : :\0 W TTTTT@P33̻ 3'\ E3 -T \ 70 / T\\\3\̝ &\3; H -@P\\ T\\\T3= '3TG H3 -\\0 9H/PFUPDATPUPINITLABHANNXTRANTOTALP UPDENDGETMASCCSCSTRSWIT 6UPDRECFILERRCCSADDPPRTLINXFORMLNgUNCUPDyPCONUPD{ADDIT }COSUPDWRITERUPDIT REACITP P WUPINIT C49 F CCS CCS 3.0 SL-149@P@P T -d0 d 0d T3 : ~3 ; :T33 : ? 3 : ? 8"d @P4h h "p8n (h 1 T3 (T33 < - T @P_  \30 .\30 < -\  d 3\X &\33X < -3\\ 0 &@P3\ <3 -\\30g6̽ &\630 < -\3\Eh̰ &\33h < -3\\w0̣ &;\ <@P -\\30̖ &\30 < -\3TM00 (TV30 < -T0\ "0 5 #;\%@P &3\ <0 -\\3 .٤  \30 < -\0 d dT330 F8¤ @P ̽0 ̸ &\X30 F -\ B, hT'0; > P@P0% ; P0 G 1\300 H̖ 0  (T3X F0 -T03 H h/T2@P0P$ C)d T3 > I\30 >   &\30 F -\  8 d@P|HPUPINIT~PAMONTOADAYTOAYERTOPGMIN EDIT CCSMVA OPENFLFILERR@UPDENDFREADR ICCSADNCCSBLKVP P WLABHAN B67 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT   T3 < hT3 : Sz0 S 1\@P \3 < h3T lHPLABHANPNXTRANTAPMOTCCSMVACLOSFLP P WLNXTRAN B85 F CCS CCS 3.0 SL-149@P@P@P1h T300 1'0 T30 G -T dT 1 @P. T0T h  l @P0< T 9HPNXTRANHPSTATIT2GETS FILERRUPDEND"FREAD (DISP 0CCSE2AAP P WTOTALP C23 F CCS CCS 3.0 SL-149@P * TOTALS *  @P+ @P? @PD * P R E V I O U S@Po * @P @P ACCOUNTS NUMBER AMT DELQ PAYOFF AMT DELQ  PA@PYOFF @P @P ADDED  @P @P @P REACTIVATED  @P; @PO @PT UPDATED  @P @P @P RELEASED  @P @P @P SATISFIED  @P @P @P WRITTENOFF  @PK @P_ @Pd REJECTED  @P @P @P0 5 Bl dT31 @ ?3 : ?\ 3 @ ? :03 ?\ @13 ?b : ?3\ @ ?0 : ?\39 @ ?@P0 : ?\31 @ ?.3 : ?\ 3 @ ?r :0 ? h h D(hT@Pȵ  D(hT 5@Pا 1ء 1T1 =3 ; <\ 13 =" ; <1\ =f3 ; <\ 13 = ; <1\ =)3 ; <\ @P, =m ;03 <\ P =0 ; <\3 V = ;03 <\ J =09 ; <\3 =u :03 <\ t =0 : <\3 z = :0; <\ n =@P3WA : <1\ =|3 : <\ b13 = : <1\ h =3 : <\ \13 =H : < d D,hT@P} 1H"PTOTALPPCCSMVACCSGETCCSPUTEDIT  PRTLIN{P P WsUPDEND C47 F CCS CCS 3.0 SL-149@P? T00r 0\g0P 0\E0 0\w0 8\@P+ 3\0 3\%  3\쨷 3\Ũ ;\@P0V#  \00 T 0 =THPUPDENDoPCLOSFLTAPMOTgPGMOUTkP P WEGETMAS B58 F CCS CCS 3.0 SL-149@PT33 = I >3 : IT33 >   (T3 F0 -T @P0+   d0 l1THPGETMASAPCCSMVAREADR FILERRUPDEND%CCSBLK;P P WkRSWIT C16 F CCS CCS 3.0 SL-149@P@PWRS@P999 @P998 @P997 @P @P @P - ACCOUNT NOT IN ACCAGE @P0  d0T A0  /  l\ @0HhlT3; ?@P0E  ? 0(π h  (ʀ hT 0 ;@PV :@PX : ( Vh 0( Vh\ @Pg :@Pi : ( hh 0( hh\ @Px :@Pz : ( Dh 0( Dh\ @P :@P :\33 B 0 B\\33 I3 : I\31  : 03 ;\ 3 ? ?3Tw3 : (T@P3 D0 -TT3@ I30 > : IT3 >0  1ݤ0  \3; F -@P\\ 33 : K :0 KyT3 &\33 I -0\d00 \33  = 0; =\ @P3 < 03 <\ 33 B  B3\  B30  B\33  =3  = $h\@P3- : <3  @PA@PD@PG@PJ@PM(@PP@PS@PV@PY@P\@P_@PbT 33 : ? 0 ? h!( ( hʝ ʘ !hހhڀ hր@P h\@P@P0 1\ : :T0\ :1 :\1HPUNCUPDPCCSMVAcCCSPYTP P WCONUPD B32 F CCS CCS 3.0 PSrPD SL-149@PCm@PN@P- NO NON-FINANCIALS ACCEPTED@P@P03U@P @P@P!@P$@P'@P*@P- @P0@P3@P6 @P9@P<@P=@PB@PGT33  ? 93 9 . . 60 ژ(0T h\hȞ #Ț dhȗhT 0 :h\@Pr hȍ(Έh 1 )T :33 M : Mr hȵ!& ( h  @P!ȦhȢh ȞhT @P@P 9ؑ3\ N33 N .̓ 43TH 33 ? 9 900 . . &\33 ? 03 ?\ :3; I] : I@PT3 ]T33E] : (3Th D3 -T3\ N30 NHEPCONUPDPCCSCSTICCSAD[ICALJLlCCSMVACHNGNFCCSPUTPUTS FILERRUPDENDP P WCOSUPD B33 F CCS CCS 3.0 SL-149@P@P@P@P@PY@PT3 N 93 9 . . \13 N30 9 9 . \3 N 93 9 . YT3; : I@P00 : J\11 ;T33g  (T630 E -T 10/ *T@P3[g0  3&\6 F3 -\\11 ;T30g &\630 H -\@PH|PCOSUPDPCCSCSTCCSMVA+WRITER:FILERRIUPDENDOREADR ZUPDRECuP P W.UPDIT C48 F CCS CCS 3.0 SL-149@PT33  : 03 :\ 33 : :3\  30 : :\33  :3 :\ 033 ; : 0 :T >@P+HPUPDIT *PCCSADDFORMLN%P P WREACIT C14 F CCS CCS 3.0 PSrPD SL-149@P@P @P0 50l3T 33 =  =3\ : ?30 ?\33 9 9 H\31 9 90 CT ?;T 0 ;@P3- : 03 :\ 33 : :3\  30 : :\33 : I3 : TT33  (T@P3X E -T 1/T330  &3\ F0 -\T3 RT30 &\@P3 H -\T 33 : L :00 L "0 5 X 6lT3  703\ :33 I= : I3\ : =38= J =T@P0G00GdI00HdJdK\ 33 : EL :03 E\ " :33 QR : U3T%=3 : (TV3; D -@PT\0 \33= : &\33 D -\HPREACITPCCSMVAFORMLN'CCSADD*WRITERGFILERRUPDENDREADR bCCSBLKvUPDRECzPUTACFCCSTIMPUTS P P WPRTLIN C09 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T 0 ;33 : : d [@P05 d0 \ hT [ T 5 [ؿ 10 T1 V3 T;\  V@P3` \\ _13 V \T30 <0 (T3 D0 -T0 &̞ l \@P3 V0 \3\ V0 \3\ ;0 &3\ D0 -\̥ \13 V 8\\@P0 :̺ &\30 D -\T V H TThhh4PPRTLINPQ8PKUPQ8PREPCCSADD*CCSGETAYERTOBCCSCSTECCSMVAP PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP PUPDATE A21 A CCS CCS 3.0 SL-149@PPUPDATEPFUPDATP P WQ8QBDS C46 F CCS CCS 3.0 SL-149@P8 601@P0 70360@P8@P8 / @P0 000000000000@P0 000000000000@P8 @P0 - ACCOUNT ALREADY IN ACCAGE @P0  CO HOST @P8 5 @P8 @P0 TRAN ACCOUNT BORROWERS DELINQUENT DELINQUENT C@P0 URRENT @P0 @P0 CODE NUMBER NAME DATE AMOUNT P@P0 AYOFF ACTION @P0 " @P0  @P0 @P0  @P8@P8 @P8 @P8@P8 @P0 <-- HDR1 FROM UTILITY FILE GOES HERE -->  @P0  @P0  @P0 <-- HDR2 FROM UTILITY FILE GOES HERE --> DAILY MASTER FILE UPDATE REPORT @P0 H PAGE @P0 \ @P0 _<-- HDR3 FROM UTILITY FILE GOES HERE --> <-DATE->  @P0 @P0 @P0hADDACT  @P0ACCAGE  @P06COSIGNER  @P0 DELQMST  @P0INACCT  @P0UPDINPUT  @P0UPDPRINT  @P0RSWFIL  @P0TRANFL  @P0TRNBCK  @P0XUTIFIL  @P8 @P0 FHDR1@P0 HUPDY@P8 B@P8 w@P8 e@P8 @P8 @P8 @P8 @P8 @P8 2@P8 Y@P8 @P8 @P8 _@P0 00000000001@P0 000000000000@P0 000000000000@P0 000000000000@P0 000000000000000000000000000000000000@P0 000000000000@P8 9@P8 :@P8 ;@P8 <@P8 =@P8 >@P8 ?@P8 @@P8 A@P8 B @P8 C @P8 D @P8 E @P8 F @P8 G@P8 H@P8 I@P8 J@P8 K@P8 L@P8 M@P8 N@P8 O#@P8 P(@P8 Q7@P8 RB@P8 SP@P8 TR@P8 U`@P8 V@P0 000000000000@P8 ;@P8 #@P0 000000000000@P0 000000000000@P0  @P0  @P0J @P0^  @P0 @P0  @P0 @P0  @P0 @P0  @P0F @P0Z  @P0 @P0  @P0 @P0  @P0 @P0  @P0B @P0V  @P0 @P0  @P0 @P0  @P0 @P0  @P0> @P0R  @P0} @P0  @P0 @P0  @P0 @P0 @P0E@P0@P0g@P0@P0w@P0@P0@P0@P0%@P0@P0@P8 D@P8 &@P8 2@P8 @P8 )@P8 @P8 M@P0 n000000000000000000000000000000000000@P0 J000000000000000000000000000000000000@P0 \000000000000000000000000000000000000@P8 @P8 @P8@P8 @P8 @P8 w@P8 k@P8 @P8@P8 @P8 @P0 + @P8@P0 %301 @P0 '302 @P0 )303 @P8 @P8 @P0 000000000000@P8@P0 000000000000@P0 000000000000@P0 000000000000@P8 P P WFUPDAT B56 F CCS CCS 3.0 SL-149@PTTT0 TTTT33 : < ) :3 < . . \33 : < '30 : < .  \@P3+ : < %30 : < . 'T0 T300 13T H3 -\ lT 03; ; : @PV :T0 o\33 : < + :3 < .̶  T B3\ 0 ; 30 : :\0 W TTTTT@P33̻ 3'\ E3 -T \ 70 / T\\\3\̝ &\3; H -@P\\ T\\\T3= '3TG H3 -\\0 9H/PFUPDATPUPINITLABHANNXTRANTOTALP UPDENDGETMASCCSCSTRSWIT 6UPDRECFILERRCCSADDPPRTLINXFORMLNgUNCUPDyPCONUPD{ADDIT }COSUPDWRITERUPDIT REACITP P WUPINIT C49 F CCS CCS 3.0 SL-149@P@P T -d0 d 0d T3 : ~3 ; :T33 : ? 3 : ? 8"d @P4h h "p8n (h 1 T3 (T33 < - T @P_  \30 .\30 < -\  d 3\X &\33X < -3\\ 0 &@P3\ <3 -\\30g6̽ &\630 < -\3\Eh̰ &\33h < -3\\w0̣ &;\ <@P -\\30̖ &\30 < -\3TM00 (TV30 < -T0\ "0 5 #;\%@P &3\ <0 -\\3 .٤  \30 < -\0 d dT330 F8¤ @P ̽0 ̸ &\X30 F -\ B, hT'0; > P@P0% ; P0 G 1\300 H̖ 0  (T3X F0 -T03 H h/T2@P0P$ C)d T3 > I\30 >   &\30 F -\  8 d@P|HPUPINIT~PAMONTOADAYTOAYERTOPGMIN EDIT CCSMVA OPENFLFILERR@UPDENDFREADR ICCSADNCCSBLKVP P WLABHAN B67 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT   T3 < hT3 : Sz0 S 1\@P \3 < h3T lHPLABHANPNXTRANTAPMOTCCSMVACLOSFLP P WLNXTRAN B85 F CCS CCS 3.0 SL-149@P@P@P1h T300 1'0 T30 G -T dT 1 @P. T0T h  l @P0< T 9HPNXTRANHPSTATIT2GETS FILERRUPDEND"FREAD (DISP 0CCSE2AAP P WTOTALP C23 F CCS CCS 3.0 SL-149@P * TOTALS *  @P+ @P? @PD * P R E V I O U S@Po * @P @P ACCOUNTS NUMBER AMT DELQ PAYOFF AMT DELQ  PA@PYOFF @P @P ADDED  @P @P @P REACTIVATED  @P; @PO @PT UPDATED  @P @P @P RELEASED  @P @P @P SATISFIED  @P @P @P WRITTENOFF  @PK @P_ @Pd REJECTED  @P @P @P0 5 Bl dT31 @ ?3 : ?\ 3 @ ? :03 ?\ @13 ?b : ?3\ @ ?0 : ?\39 @ ?@P0 : ?\31 @ ?.3 : ?\ 3 @ ?r :0 ? h h D(hT@Pȵ  D(hT 5@Pا 1ء 1T1 =3 ; <\ 13 =" ; <1\ =f3 ; <\ 13 = ; <1\ =)3 ; <\ @P, =m ;03 <\ P =0 ; <\3 V = ;03 <\ J =09 ; <\3 =u :03 <\ t =0 : <\3 z = :0; <\ n =@P3WA : <1\ =|3 : <\ b13 = : <1\ h =3 : <\ \13 =H : < d D,hT@P} 1H"PTOTALPPCCSMVACCSGETCCSPUTEDIT  PRTLIN{P P WsUPDEND C47 F CCS CCS 3.0 SL-149@P? T00r 0\g0P 0\E0 0\w0 8\@P+ 3\0 3\%  3\쨷 3\Ũ ;\@P0V#  \00 T 0 =THPUPDENDoPCLOSFLTAPMOTgPGMOUTkP P WEGETMAS B58 F CCS CCS 3.0 SL-149@PT33 = I >3 : IT33 >   (T3 F0 -T @P0+   d0 l1THPGETMASAPCCSMVAREADR FILERRUPDEND%CCSBLK;P P WkRSWIT C16 F CCS CCS 3.0 SL-149@P@PWRS@P999 @P998 @P997 @P @P @P - ACCOUNT NOT IN ACCAGE @P0  d0T A0  /  l\ @0HhlT3; ?@P0E  ? 0(π h  (ʀ hT 0 ;@PV :@PX : ( Vh 0( Vh\ @Pg :@Pi : ( hh 0( hh\ @Px :@Pz : ( Dh 0( Dh\ @P :@P :\33 B 0 B\\33 I3 : I\31  : 03 ;\ 3 ? ?3Tw3 : (T@P3 D0 -TT3@ I30 > : IT3 >0  1ݤ0  \3; F -@P\\ 33 : K :0 KyT3 &\33 I -0\d00 \33  = 0; =\ @P3 < 03 <\ 33 B  B3\  B30  B\33  =3  = $h\@P3- : <3  @PA@PD@PG@PJ@PM(@PP@PS@PV@PY@P\@P_@PbT 33 : ? 0 ? h!( ( hʝ ʘ !hހhڀ hր@P h\@P@P0 1\ : :T0\ :1 :\1HPUNCUPDPCCSMVAcCCSPYTP P WCONUPD B32 F CCS CCS 3.0 PSrPD SL-149@PCm@PN@P- NO NON-FINANCIALS ACCEPTED@P@P03U@P @P@P!@P$@P'@P*@P- @P0@P3@P6 @P9@P<@P=@PB@PGT33  ? 93 9 . . 60 ژ(0T h\hȞ #Ț dhȗhT 0 :h\@Pr hȍ(Έh 1 )T :33 M : Mr hȵ!& ( h  @P!ȦhȢh ȞhT @P@P 9ؑ3\ N33 N .̓ 43TH 33 ? 9 900 . . &\33 ? 03 ?\ :3; I] : I@PT3 ]T33E] : (3Th D3 -T3\ N30 NHEPCONUPDPCCSCSTICCSAD[ICALJLlCCSMVACHNGNFCCSPUTPUTS FILERRUPDENDP P WCOSUPD B33 F CCS CCS 3.0 SL-149@P@P@P@P@PY@PT3 N 93 9 . . \13 N30 9 9 . \3 N 93 9 . YT3; : I@P00 : J\11 ;T33g  (T630 E -T 10/ *T@P3[g0  3&\6 F3 -\\11 ;T30g &\630 H -\@PH|PCOSUPDPCCSCSTCCSMVA+WRITER:FILERRIUPDENDOREADR ZUPDRECuP P W.UPDIT C48 F CCS CCS 3.0 SL-149@PT33  : 03 :\ 33 : :3\  30 : :\33  :3 :\ 033 ; : 0 :T >@P+HPUPDIT *PCCSADDFORMLN%P P WREACIT C14 F CCS CCS 3.0 PSrPD SL-149@P@P @P0 50l3T 33 =  =3\ : ?30 ?\33 9 9 H\31 9 90 CT ?;T 0 ;@P3- : 03 :\ 33 : :3\  30 : :\33 : I3 : TT33  (T@P3X E -T 1/T330  &3\ F0 -\T3 RT30 &\@P3 H -\T 33 : L :00 L "0 5 X 6lT3  703\ :33 I= : I3\ : =38= J =T@P0G00GdI00HdJdK\ 33 : EL :03 E\ " :33 QR : U3T%=3 : (TV3; D -@PT\0 \33= : &\33 D -\HPREACITPCCSMVAFORMLN'CCSADD*WRITERGFILERRUPDENDREADR bCCSBLKvUPDRECzPUTACFCCSTIMPUTS P P WPRTLIN C09 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T 0 ;33 : : d [@P05 d0 \ hT [ T 5 [ؿ 10 T1 V3 T;\  V@P3` \\ _13 V \T30 <0 (T3 D0 -T0 &̞ l \@P3 V0 \3\ V0 \3\ ;0 &3\ D0 -\̥ \13 V 8\\@P0 :̺ &\30 D -\T V H TThhh4PPRTLINPQ8PKUPQ8PREPCCSADD*CCSGETAYERTOBCCSCSTECCSMVAP PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP P*END 00022P