(E EuJI.ANY LIBRARY P042882(*JOB,, INSTALL CORRECTIONS 04/07/82 00010*K,L14 00020*CTO, INSTALLING PRINT FROM B.PRINT, LIBRARY FILE 00030*OPEN,FN=B.PRINT,OW=LIBRARY,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,PRINT,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM PRINT HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190_ 00200 00210 00220 00230 00240 00250 00260 00270 00280 00290 00300 00310 00320 00330 00340 00350 00360 00370 00380 00390 00400 00410 00420 00430 00440 00450 00460 00470 00480 00490 00500 00510 00520 00530 00540 00550 00560 00570 00580 00590 00600 00610 00620 00630 00640 00650 00660 00670 00680 00690__ 00450 00460 00470 00480 00490 00500(UM RI.TOOL LIBRARY P(*JOB,, INSTALL TOOLS 01/05/83 00010*K,L14 00020*CTO, INSTALLING AKOUNT FROM B.AKOUNT, LIBRARY FILE 00020*OPEN,FN=B.AKOUNT,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,AKOUNT,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM AKOUNT HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING BATS FROM B.BATS, LIBRARY FILE 00020*OPEN,FN=B.BATS,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,BATS,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM BATS HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING CAT17 FROM B.CAT17, LIBRARY FILE 00020*OPEN,FN=B.CAT17,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,CAT17,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM CAT17 HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING CAT6 FROM B.CAT6, LIBRARY FILE 00020*OPEN,FN=B.CAT6,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,CAT6,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM CAT6 HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING CHEAT FROM B.CHEAT, LIBRARY FILE 00020*OPEN,FN=B.CHEAT,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,CHEAT,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM CHEAT HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING DDT FROM B.DDT, LIBRARY FILE 00020*OPEN,FN=B.DDT,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,DDT,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM DDT HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING DISM FROM B.DISM, LIBRARY FILE 00020*OPEN,FN=B.DISM,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,DISM,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM DISM HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING DL FROM B.DL, LIBRARY FILE 00020*OPEN,FN=B.DL,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,DL,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM DL HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING DMPFCB FROM B.DMPFCB, LIBRARY FILE 00020*OPEN,FN=B.DMPFCB,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,DMPFCB,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM DMPFCB HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING LIST FROM B.LIST, LIBRARY FILE 00020*OPEN,FN=B.LIST,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,LIST,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM LIST HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING LOOK FROM B.LOOK, LIBRARY FILE 00020*OPEN,FN=B.LOOK,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,LOOK,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM LOOK HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING MOUN FROM B.MOUN, LIBRARY FILE 00020*OPEN,FN=B.MOUN,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,MOUN,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM MOUN HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING MOVE FROM B.MOVE, LIBRARY FILE 00020*OPEN,FN=B.MOVE,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,MOVE,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM MOVE HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING MOVEID FROM B.MOVEID, LIBRARY FILE 00020*OPEN,FN=B.MOVEID,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,MOVEID,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM MOVEID HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING PASSW FROM B.PASSW, LIBRARY FILE 00020*OPEN,FN=B.PASSW,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,PASSW,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM PASSW HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING PRINT FROM B.PRINT, LIBRARY FILE 00020*OPEN,FN=B.PRINT,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,PRINT,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM PRINT HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING PROVE FROM B.PROVE, LIBRARY FILE 00020*OPEN,FN=B.PROVE,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,PROVE,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM PROVE HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING PURGE FROM B.PURGE, LIBRARY FILE 00020*OPEN,FN=B.PURGE,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,PURGE,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM PURGE HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING REBILD FROM B.REBILD, LIBRARY FILE 00020*OPEN,FN=B.REBILD,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,REBILD,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM REBILD HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING REDU FROM B.REDU, LIBRARY FILE 00020*OPEN,FN=B.REDU,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,REDU,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM REDU HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING SCRNED FROM B.SCRNED, LIBRARY FILE 00020*OPEN,FN=B.SCRNED,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,SCRNED,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM SCRNED HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING SEP FROM B.SEP, LIBRARY FILE 00020*OPEN,FN=B.SEP,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,SEP,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM SEP HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING SNARF FROM B.SNARF, LIBRARY FILE 00020*OPEN,FN=B.SNARF,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,SNARF,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM SNARF HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING SPY FROM B.SPY, LIBRARY FILE 00020*OPEN,FN=B.SPY,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,SPY,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM SPY HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING SQUISH FROM B.SQUISH, LIBRARY FILE 00020*OPEN,FN=B.SQUISH,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,SQUISH,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM SQUISH HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING SSP FROM B.SSP, LIBRARY FILE 00020*OPEN,FN=B.SSP,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,SSP,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM SSP HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING STAT FROM B.STAT, LIBRARY FILE 00020*OPEN,FN=B.STAT,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,STAT,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM STAT HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING TIME FROM B.TIME, LIBRARY FILE 00020*OPEN,FN=B.TIME,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,TIME,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM TIME HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING UNSEQ FROM B.UNSEQ, LIBRARY FILE 00020*OPEN,FN=B.UNSEQ,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,UNSEQ,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM UNSEQ HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING WEAVE FROM B.WEAVE, LIBRARY FILE 00020*OPEN,FN=B.WEAVE,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,WEAVE,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM WEAVE HAS BEEN INSTALLED 00140*CTO, 00150*CTO, 00330*CTO, INSTALL C O M P L E T E !!! 00340*Z 00350__,2 00080*K,I8 00090*N,UNSEQ,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM UNSEQ HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING WEAVE FROM B.WEAVE, LIBRARY FILE 00020*OPEN,FN=B.WEAVE,OW=LIBRARY,LU=21,R 00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,WEAVE,,,B 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM WEAVE HAS BEEN INSTALLED 00140*CTO, 00150*CTO, 00330*CTO, INSTALL C O M P L E T E !!! 00340*Z 00350<! ~bB.REBILDLIBRARY x042882< PSWREBILD REBUILD INDEX FILE (NYGSBC) @P@POj@POm `@POt $@PO}@PO@PO@PO@PO@P @PSYSVOL @P00FILE $$ @PO  REBUILD FILE VER 2.0 @PN  @PON  COPYING BACK @PO'N @PO>@PO) DUP KEY:  @PO: @PO@ RECORDS =  000 @PO[DELQMST @PO`LADLQMST@PO_@POd@POe$$PRINT @POTOO"O#O$hTO%O hkhhTO"OjO OkO TOlOTO[Om@POOmO_\O`OmOmOd\OeOmOmOiTOnOoOn\OpOmOpOmTOq-d `@POd!TOsȍ 'TOsO"Ot\OuT2OsOs &\OsO"OtO) dO \@PP OqO OvOq\O"OjO OwO 2dO7Ox1p4OrhT-@POyT\P\@PP4O\P\Or\OyPPP@h \Or\P\\OyPOdRdOdO@dO@PP_AdOO(p<dOdd!d8d9 dTOsOsO> ) 'TO@PPOsO"OtTOOq l l lTOOs &\OsO"Otm@PP\Oq l l l\Os &\OsO"OtTOOs̳ &\OsO"Ot dO{T@PPOY\8OWOYOW " lOXOZ 6  l TOs\OqT OsOs@PQ 'TPOsO"OtTPOqZ dOdO|TNOsO} l۬  &\@PQ.OsO"Ot#dO  2Q dO~"QO, dO, dO    @PQY  l   J @ :Od O_ @PQhTOO@PQOOnOi ̷h\O@PQOO̬ ̬h ̣h\@PQO@PQOOO~ TOOsOs 'TQOsO"OtO| BTPOs &\@PQOsO"OtTOO"OjONOO TQ OqTOs &\OsO"Ot\Oq d7 @PR l dTPOs̰ &\OsO"Ot\Os̤ &\OsO"Ot\OqOd\Os@PR1̐ &\OsO"Ot ldO&TQNOsOsO} dO| 'TQOsO"Ot@PR\dO 2S̜ TQOOs &\OsO"Ot S dO "S@PRO, dOdO=dNdNTQNNOh\@PROONO߀hT@PRNOsnnOsO'   &\OsO"Ot#TRUOsO"O dO̳h\@PROOO)OvOTQO"OjO)OO  O&OO?TO?OK\OKOuOoO@OOo l\O"OjO@Ok@PS O OpO| &TQOsTQOqTPOs̗ &\OsO"  d@PS5   dT2OsOs 'TROsO"Ot@POSP@PSP\OsTTPREBILDPHFLOT P)Q8STP SVFLOAT P.FMRDELOFMEOFCOPGMIN OPGMINTOWTREADRGTREBIOCCSCSTOCCSMVARZERO SOPENFLR FMERR SJPGETFCBPCREATEPyCNV2W PCLOSFLSDELETES!GETS R?PUTS RkCLEAR QWRITERRHXDEC RUPDFCBS?PGMOUTSTPREBILD P\GTREBI RETREIVE PARAMETERS FROM ONE INPUT LINE. @P@PbZMP@Ph@Pl@Pp @P,,,,,,,,,@P4 ,,, SYSVOL @P_ @PrTbTcd4edfg \cdhij Țh T h@P\l@l h hhTmkh hT@lhȱ h\A@lȧ@Ph\mkh ho\@lhkȗ hi\A@plȍ d \lplo dn\@Pmkl hG\@lhC hATsA@ql d  h/\@qll\@Pmkl h\@lh h\A@ql̽ d \[lql@PBHTThwhhhh\hh\\hPGTREBIDPQ8PKUPJQ8PREPGSCAN CCSMVAWTREAD{PGMOUTMIN0 P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION PSR 10/82@PhhHhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P PZERO @P h7 n@P H TT h\hPZERO PQ8PKUPQ8PREPP  PFMERR FM FILE ERROR REPORTER W/WO PAUSE SL-***@P@Pl %@Pq@Ps7L@Pg@P FILE MANAGER ERROR: FILE=XXXXXXXX,XXXXXXXX REQUEST= , ISTAT =$ . @P(FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PSTS UPDRECDELRECCOMFILVOLUSEREDUCE $ @Ph PAUSE @PwTlml\nlolT%\eh ! < ( h\(rsts@P\dstsTgur  \ghlgvr  T@PHTThh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVAxCCSHXAWTREADPGMOUTP *T __l %@Pq@Ps7L@Pg@P FILE MANAGER ERROR: FILE=XXXXXXXX,XXXXXXXX REQUEST= , ISTAT =$ . @P(FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PSTS UPDRECDELRECCOMFILVOLUSEREDUCE $ @Ph PAUSE @PwTlml\nlolT%\eh ! < ( h\(rsts@P\dstsTgur  \ghlgvr  T@PHTThh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVAxCCSHXAWTREADPGMOUTP <,b QAB.P710 LIBRARY x999999081883< PP710 * DISPLAY/EDIT - RECORD MANAGER. * @P@P7(@P:@P@ @PD`@PJ?,@PRH.R P@PYEX@P]G,N@Pg @Pk <@Pq@Pt:@Py @P|@@P~@P @PSYSVOL @Pz * * FILE DISPLAY/EDIT * * VER. 4.9 @Pc@P00000000@P@PNOT DELETED NOT UPDATED WRITTEN @P1 RRN@P: XXXXXX @PEXACT E.O.F.NEAR KEY RRN ON OFFPAUSE RECORD LOCKED @P,SEARCHING @P' FILE: XXXXXXXX,XXXXXXXX,XXXXXXXX. TYPE: SEQ RECORD LEN: XXXXX @PM # RECS: MAX. RECS: @PKINDX@PSEQ @Pc @Pd P1,L1 P2,L2 P3,L3 P4,L4 KEYS: XXXX,XX XXXX,XX XXXX,XX XXXX,@PXX @P CMD:^ ^ ^ ^ ^ ^ ^  ^ @P @P  @P  @P@P3@P$,,,,@P#@P4@P&,@P @P @P@P5@P~TdhxhuT7z8yȜ ȗ hT<9@P9 hhT&=9h dT@l> d\@?l\&=9l@PԜ l\@l l\A@ d \@A@l\&=9lҜ l\@P@l̾ l\B@̴ d ̮ d\B@T d dC d5T@P*TD-d `d!T 'T " l\;@PUT2 &\ "2dv7F/p4EdT -@G@PT\\v\\E\G@ \E\\\GvRdt du@P@dwAdx d+d!̶dIT8TTR\3\\ ]T)@P@'A@\A@'J@\B@'K@Tt\:L'ML\;'N;̿ ;\@PK;'N; dO dP$A dQ1h\@P\L:zQ: l1h\@P-\<;zQ; 1T7z8y\7'Sy\7MN y#@PX I  \7cTy\7zTy @P{@P{@PO{@Pi{@P{ !l,  lTU\7V7WyydX\YRO\@PYO\ZRO  d9 [  h\$@P;^;T\]\     ̝@P  ̻  C { 44 1Ky  ̼ @P'̷ ̲ ̭ ̨ ̣ @P@P@P @PA̞ ̙ ̔ @P^@P^@P^@P^@P^@P^@P^@P^@P^@Pz^@P~^@PP̏ ̊ @P_@P_@P_@P_@P`@P`@P`@P`@P`@P`@Pb@Pb@Pd " l\_l  , dP1 {d" hT^c` @@PT1:\@@ hT^@h h\_@d h̹ hT\<_^T@P   lT\;c;\c``Tc !l a@Pb  'TE, @P dc "T:T$̦ ̧ " dc ddTcd\T@P-;c; F F̾ 8l9l d"\c@PO@PBO@PO l [ "Tc !laOH  2@PzT, \@@ d^T^@l d_\_@d @Pl dT*:_^T :T  c"" 2@P53T$ Td T!dT\;@Pc;F@P@P@P@P "\  d\@@ d^T^@l d_\_@d l@P+ dT:_^Td Fl̿ Nl̷ V̹l@PVt 2` l̬ 2g l@Pi@Pi "s d2\@@̝ l\^@l̖ l\_@d l̍ l\:_^@P\̤ll̼ 2̶ l 2 lr@P)@P8@P d6\  d# {G {T0UT;_:7W@Pyy   l  d9 dO" deT@POff Tfe @PG@P̡ {̣H {̜G ]T̐ 29T}̄ " {\@P@Z@y !l" [T$;c`xTZgy@P3i@Pi# {G dhI  lTl 2\@P "{\Z@yy\Zgyn@P@P@PX T dC dd2 d5d3d, :@P@Pl \Z;y T^Z;y-@PQ@P"l̇  lTTxwc`Tc 2T3 "@PT 2.\ "$dc%dd\Z@yT@PGchl !l̶b ̯ 2e\ d5d\T_@Pry\iWi AdjTjL\Zk7y\Yly@PL@P {\g7my\vg@PV@P[@P,  {  d^T|-@^nTW lT \ \@PZ-Vy\7:yT\@n`Tm7`y l\ H@P l\@niT:i2ipp @P_@Pz@P=@PC {# 0\t diTiWl\iW3 @PH] dOhT@PTf (2LT<^T\<;<; de l l̷ "@P\e$VdQ\<;Q;ܼ 2vH T$:T$TT@P\kqkH \kqkѤr\kqk "_@P 0ds\;tk T^;t; Tsu\vwdh d@PP1dx   l\cxy`i d^T8^Udz d{ ) l @P+l\{^ l\:^:e5 D l l\{^\7|y @PVd}G c l\7}y\_:y\ g\u7@Pzy6 ̭ {̧l Ni"\eif\PTi\sz^d^\@PG7^y N"\6fi\37:y\)7Wy\@Pd\7@yTTPP710 PHFLOT Q8STP FLOAT FMRDELFMEOFCVDC RSCAN PGMIN WTREADCCSMVAMIN0 CLOSFLZERO OPENFL<PFMERR GETFCBVCNV2W CONVERCHO2LRBHXDECfCCSGETCNVRT 8CNV1W READR EFDWSUBGETS \FDWADDCCSPUTPUPDREC)DELRECWRITERPUTS DBUG CCSCSTPGMOUTPP710 P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP  PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP PwBHXDEC HEX TO DECIMAL W/LEADING BLANKS @P@P @P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPBHXDECcPQ8PKUPkQ8PREPhP  PDBUG HEX+ASCII DUMP OF PROGRAM VARIABLES @P@P6 @P;P4I@PA ~.@P3||@PHT/.45 hT.6789 hdt"T;\3@Ps<\3=Ƚ hT>' hȳ hMh\@P+ȯ( hF\+AAȥ`;fd43%n)d ~4$ '?@PC .n 17d)TU.6;9: @P@HHTT h\h\hYPDBUG PQ8PKUPQ8PREPPGMIN IWTREADCCSMVAgCCSHXAP P-CNV1W 31 BIT TO 32 BIT INTEGER CONVERSION 12/83 @PhhaHhll@PHTTh h\h hPCNV1W PQ8PKUP#Q8PREP P P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION PSR 10/82@PhhHhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P PZERO @P h7 n@P H TT h\hPZERO PQ8PKUPQ8PREPP  PFMERR FM FILE ERROR REPORTER W/WO PAUSE SL-***@P@Pl %@Pq@Ps7L@Pg@P FILE MANAGER ERROR: FILE=XXXXXXXX,XXXXXXXX REQUEST= , ISTAT =$ . @P(FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PSTS UPDRECDELRECCOMFILVOLUSEREDUCE $ @Ph PAUSE @PwTlml\nlolT%\eh ! < ( h\(rsts@P\dstsTgur  \ghlgvr  T@PHTThh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVAxCCSHXAWTREADPGMOUTP  PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P PrCNVRT B52 A ITOS CCS 3.0 SL-149@P Hihf`hc DjH qXhUS jJQȠ jE HKL HJ AHDHED h3XT@P+1,h&+h%3* 1L ) h+TT(! l l @@PV ߀3PCNVRT PDWMUL +DWADD AP P2CHO2LR DECK-ID B51 ITOS 1.2 SUMMARY-126@P H*h)`h'h!h  Qhl ` h h @P+PCHO2LRP  PlCONVER DECK-ID C10 ITOS 1.1 SUMMARY-122@P1B@'d @P h h h (hT@P#  1  (hT@P7 0n    h@PI n 1  0l@PXHTThhhh\ h hPCONVERZPQ8PKUP`Q8PREP]FDWSUB FDWADD4P P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P __NVERZPQ8PKUP`Q8PREP]FDWSUB FDWADD4P P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREP<2 B.PROVE LIBRARY x042882< P PROVE CHECK FILE MANAGER DATA STRUCTURES @PTTTTPPROVE PQ8STP PRINITPRCHEKPGMOUTPPROVE Pl\10:$:" $Xh\1:#d:"8,d\@P.:#60l d0" ,l0 .TnCZT%@PH(14H1 PROVE RUN ,A2,1H/,A2,1H/,A2,4X,I6,//,15H VOLUME LABEL ,4A2,///)@PlHPPRINITnPQ8QINIQ8QX Q8QEND VPC DISPLABQUIET uPROMPTISHIFTMEMORYERROR MMREADDATTIMFDWADDPGMOUTFP P0= : (h54  (h-, TZ':! (̀0hT@PO (Ā0h\@PVT 0(hT@P`9  hد@PiȬ \R+:!T dd @ h @1> 2 @$hT13:#g:$"!d:" d@Pߜ 2 d `0,;Th0!  l `,;R!h `,ބ00;O!hT@P0:(:" `,ь!hT@P3:,:&:" `,Ō0!h\@P3:,:*:"1\:(:&0:"T^0:*  TBZ=:!TMTW `,dg0!Ƥ * `, ;Q!@Ph\@P:&d 8\Z?0:!\\ `$0!h\@P:( 8\Z@:!\\1T:#3:&d:"\ZB0:!\3\\:& \ZC:!\@PC\\3:* \ZD:!\\ d `0,;Sl0!0  l `,dg08! @Pn l `,l0!”0  l `,l!  l dϔ l @Plޜ l l `$l0"  ̣  TZO:!TT `, ;O!@P hT@P4 3T@P@PD d d l  \ZT0:!\\\  @Pddgn0:.ۜ  \ZV:!\\\ dlnܯ;T:$:,@P0$:$:"S@P(@P(@P(0?  TZ\:!T\?T> Dd! d!Κ Η \@PSZ`:!\h\@P_\\ lΚ Η \Zc:!\:.h\@P{\"1\Re:! l ,dg" \Zh:! 0,h\@P ,0h\@P ,0 hT5@P ,0h\@PT:@P @P(9H NFCB = $,Z4,17H KEYBA TOO SMALL) @P@P(9H NFCB = $,Z4,17H KEYBA TOO LARGE) @P4@P(9H NFCB = $,Z4,19H NO *AL* IN HEADER) @PA@P(9H NFCB = $,Z4,27H HEADER ADDRESS ERROR, FCB) @PN @P (9H NFCB = $,Z4,24H HEADER SIZE ERROR, FCB)@P#@P#(9H NFCB = $,Z4,25H HEADER OWNER ERROR, FCB) @P:@P:(9H NFCB = $,Z4,30H FIAT DISAGREEMENT, MASK = $,Z4) @P3U@PU(33H FILE COUNTS CONFLICT: NFILES = ,I5,12H, VLCURF = ,I5)@PVs@Ps(21H FIAT LEFTOVER, FIAT(,I5,5H) = $,Z4,10H FCB IS $,Z3,1H0,24H+ BIT POSITION ( F - 0@P )) @P@P(5H ASD:,4(3H  $,Z4)) @Pp@P(50H VLLBL DISAGREES WITH ASD - LARGEST HOLE AVAILABLE) @P@P(9H NFCB = $,Z4,17H FILE SIZE ERROR) @P @P(9H NFCB = $,Z4,29H FDB DISAGREEMENT, MASK = $,Z4)@Pr@P(20H FDB LEFTOVER, FDBX(,I5,5H) = $,Z4) @P@P(//35H "ASD" WITH ALL FILES REMOVED IS: //)@PF@P(21H ZERO LENGTH HOLE: $,Z4,1H,,Z4)@P0@P0HPPRCHEK2PQ8QINI/Q8QX Q8QENDTWCMPRCHKFDDrMMREAD$FDWADD!FDWSUBREMOVEP P3TJ:"TZ3:&:" d̈!3 ,l ,dz8f @P3,l ,l0f ,l ,l0f ,l ,l0f@P Z@P,Z@PZ $" 0l:*n ,d0::+n ,l:&n ,l0:'n ,l n ,h @P,րh\@P0:"T0:&d !e l +T Z~:!TT ,h 0,hT:(@P:" ,l f8;@P@P(6H FCB $,Z4,40H OVERLAPS FILE SPACE WITH LARGER ADDRESS) @P9@P(6H FCB $,Z4,41H OVERLAPS FILE SPACE WITH SMALLER ADDRESS)@P+@P@PHTThh4hhPREMOVEPQ8PKUPQ8PREPQ8QINIQ8QX Q8QENDTWCMPRFDWADDFDWSUBP P6TWCMPR COMPARE TWO 31-BIT INTEGERS @P  h  ! h@P h  h 5 h@P#HTTh h\h hPTWCMPR&PQ8PKUP,Q8PREP)P P:!VT\:.TM\1Z@:!r\\:.\B\ZB:!\0\:.\7 d#hT@P@Pf 1\ZG1:!\:. l爼h\@P 1 lۀh\@P 1\\ lɈh\@Pnh\@Pfܹ 1\ZM1:! ḽh T@Pܦ 1 l̟h\@P+ܙ 1TTZN1:! d#h\@PA 1 lh\@PN 1\@PV(31H NO FCB FOR FDB ENTRY, NFCB = $,Z4,10H, NFDB = $,Z4)@Pr(31H NAME/OWNER ERROR, NFCB = $,Z4,10H, NFDB = $,Z4)@P(31H FDB MULTI-MARK, NFCB = $,Z4,10H, NFDB = $,Z4)@P(8H FDD : ,8(X,Z4),2X,8A2) @P(8H FCB : ,8(X,Z4),8X,8A2) @P(25H FDD HASH ERROR, NFDD = $,Z4,X,8(X,Z4),2X,8A2,3H $,Z4) @P<@P@P"@!HHTT hh" hhhhh\h"PCHKDEFPQ8PKUPQ8PREPQ8QINI3Q8QX Q8QEND1VPC FDWADD`MMREADfP P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PGMMREAD MASS MEMORY READ FUNCTION @P hhh'h hTdT`DhҀ@P2HTTh\h\h h\h؀PMMREAD5PQ8PKUP;Q8PREP8FREAD DISPAT&P PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P PZQUIET INDICATORS FOR ENVIRONMENT @P $$  l=T l2 l- l(ܘ l# dRl@P4h dRlh dRl@PN HTThPQUIET PPQ8PKUPVQ8PREPSTSNABL5AUTON APGMIN P PVPC VALIDATE TWO PRINTABLE CHARACTERS @P H" 2 1 `h"Ƞ 2 1 `ȸPVPC P PuWTRD WTREAD INTERFACE @PX hh hT=T  h@P+X X:XjDhBhT8Xo X /6Ȉh}Ȉ@PV{h~hhT9c wh [YlX7 @PX! 1 OhF?X& Xlh=19116h h+&@P$h h ! hT^TX X@Pȟ h H !bhΐjTxXT@PX X\h! 1 Oh^! 1 hhX@P- X8XhBh@h?h 7h ' jT89@PX|hhy TN8 !h h hT`@P9X=! uyntXy+ !ijeͤ @P_nXdhHH T:>? h@@P  PAUSE @P8@P>Xo Xl)hyX` Xw= lhtoȠ lb@Piel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P P MEMORY @PHPMEMORYP PISHIFT @PH"h"hC PISHIFTP  P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO PQ8PKUPQ8PREPP __ P MEMORY @PHPMEMORYP PISHIFT @PH"h"hC PISHIFTP <^{ tkRB.PURGE LIBRARY x999999111982< PPURGE PURGE FILES FROM VOLUMES @P@P_@Pf  (@Po@Ps   " #2 @P@PDELETED CURRENTLY OPENFM ERROR@POK @P NOT FOUND @P( PURGE FILES VER 2.0 @P4PURGEALL PURGE OW=XXXXXXXX , VL=XXXXXXXX @PRALL ID'S@PLALL VOLUMES @P ENTER OK TO DELETE @PV@P  @P@P @P@P XXXXXXXX/ XXXXXXXX/ XXXXXXXX : DELETED  @P VOLUME XXXXXXXX NOT MOUNTED @PY@PhTZ[T\]^T\_(`aTbc hT``eȼ @PJ\ffV\gffWȚ Ȗ Tfgfȋ \hff@Pe\gffȆ \hffTd d "Td @P 2\iff\Lj8kj\Rf8jfW \f8jfe \@P,f8kjT\_8la dmT`Tm+nno 'T@PWn\pTCqqrr  l̯ \Gffr TCf@Pif\Gfsf\ftf\Cqq\fhfud0vB @PX4 1T3\_8laY  \\_wa ll <\@Px\\_y_qazla   T^f4fY \@P{{rr ?@P@PTnn 12 $p  'TWn\XT}f|q@P:\ x|q\}|}\f|q\fif\gfsf\hft@PefT\_~aV @Pw@PRw@Pwe @P~@P~\fxf\\_a@P@P@PTTPPURGE PQ8STP PGMINTPGMIN WTREADgGTPURGCCSCSTCCSMVA2SEKVITGETVITZERO AGETFCBEFMERR )DELETEPGMOUTPPURGE  PGTPURG RETREIVE PARAMETERS FROM ONE INPUT LINE. @P@PbZMP@Ph@Pl@Pp @P,,,,,,,,,@P4 ,, OR (CR) ,@PrTbTcd4edfg \cdhij Țh hm\l@Pl h hhTmkh hVTlhQȹ hO\lȰh\mkh @Ph<\lh8Ƞ h6\plȗh\mkh h#\lhn hTsql@P do  h \ql@PHTThhhh\\\ZPGTPURGPQ8PKUPQ8PREP SCAN CCSMVAWTREAD{MIN0 P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP PZERO @P h7 n@P H TT h\hPZERO PQ8PKUPQ8PREPP PFMERR FM FILE ERROR REPORTER W/WO PAUSE SL-***@P@Pw@Py@P@P)#@Pf7@Pi?- @P FILE MANAGER ERROR: FILE NAME = , REQUEST = , ISTAT = . @P*FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PUTS UPDRECDELRECCOMFILVOLUSEREDUCE@Po PAUS@PrE @Ps @@P{T)T&l ! ! , h\*xfgf Kh @P\ikjk 9hTmhnnnx Ȼ   \moymz@Px  T@PHTTh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVA|CCSHXAWTREADPGMOUTP P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP P4SEKVIT SEARCH FOR VIT MATCH TO VOLUME NAME @P H-h,TTh'\h&\h%h# L `: ` " v  l@P+`PSEKVITPQ8PKUPQ8PREPP __x  T@PHTTh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVA|CCSHXAWTREADPGMOUTP P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP P4SEKVIT SEARCH FOR VIT MATCH TO VOLUME NAME @P H-h,TTh'\h&\h%h# L `: ` " v  l@P+`<wk vuJB.PRINT LIBRARY x042882< PJPRINT @P@P:@PB@PD @PH#&)-2@PX@P[`@P]@Pd__.@Pi @Pn@P@P@P@P@PX@P  @P/ @PC  @Pn @P  @P @P  @P @P  @P+ @P?  @Pj @P~  @P @P  @P @P  @P' @P;  @Pf @Pz  @P @P  @P @P  @P# @P7  @Pb @Pv  @P @P  @P @P  @P @P3  @P^ @Pr  @P @P  @P @P  @P @P/  @PZ @Pn  @P @P  @P @P  @P @P+  @PV @Pj  @P @P  @P @P  @P @P'  @PR @Pf  @P @P  @P @P  @P @P#  @PN @Pb  @P @P  @P @P  @P @P   @P J @P ^  @P @P  @P @P  @P  @P   @P F @P Z  @P @P  @P @P  @P  @P   @P B @P V  @P @P  @P @P  @P @P   @P > @P R  @P } @P  @P @P  @P @P   @P : @P N  @P y @P  @P @P  @P @P  @P6 @PJ  @Pu @P  @P @P  @P @P  @P2 @PF  @Pq @P  @P @P  @P @P  @P. @PB  @Pm @P  @P @P  @P @P  @P* @P>  @Pi @P}  @P @P  @P @P  @P& @P:  @Pe @Py  @P @P  @P @P  @P" @P6  @Pa @Pu  @P @P  @P @P  @P @P2  @P] @Pq  @P @P  @P @P  @P @P.  @PY @Pm  @P @P  @P @P  @P @P*  @PU @Pi  @P @P  @P @P  @P @P&  @PQ @Pe  @P @P  @P @P  @P @P"  @PM @Pa  @P @P  @P @P  @P @P  @PI @P]  @P @P  @P @P  @P @P  @PE @PY  @P @P  @P @P  @P @P  @PA @PU  @P@Pv  @P @P PRINT FILE. @P(P@P / / MM-DD-YY HHMM @P1 J0@PSPTFN@PnhT56T789T7:;<Tv=h  dȪ  T@P>? 2 lHhh  d2ȑ  l dA l@P 9  d7  l BdFdd3TvGG 'TvG7@PDT|7:D<TvHIH\vEHJH\vKHLHT\IDMD@P\NDOD\DPDT&\IQRQ\7:S,,,,<(S)CREEN OR (P)RINTER> SSS @P_ @PsTbTcd4edfg \cdhij șh T h@P\lcl h hhTmkh hTclhȰ h\dclȦ@Ph\mkh h\clhȔ h\dcplȉ d \lplod@Pn\mkl hf\clhb h`Ttdcql d  hN\cqll@P\mkl͜ h<\crh8 h6\dcr̻ l,̷lTmkl hTc@PJh̨ h\dci̞ d \[i@PfHTThThnhyhh\\h h hh\hhPGTPRINhPQ8PKUPnQ8PREPkSCAN =CCSMVAWTREAD|PGMOUTMIN0 GP P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP PREALN CONVERT ASCII TO REAL - 2 WORD INTEGER SL-***@P@P@P@P `"d hAT-@d h:\-@dT@b h/\-@d+h !(TѨ@PFhh\-@dT \۞  T\@ ȵ @Pf\\ l5l)\@\+!\șl!T\\T \@P\\@f"H@G@PHTTh\h\hhh\h h_PREALN PHFLOT 0Q8PKUPQ8PREPHDFLOT%FLOAT DFLT YDBLE Q8QD2DMCCSGET@P PFMERR FM FILE ERROR REPORTER W/WO PAUSE SL-***@P@Pl %@Pq@Ps7L@Pg@P FILE MANAGER ERROR: FILE=XXXXXXXX,XXXXXXXX REQUEST= , ISTAT =$ . @P(FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PSTS UPDRECDELRECCOMFILVOLUSEREDUCE $ @Ph PAUSE @PwTlml\nlolT%\eh ! < ( h\(rsts@P\dstsTgur  \ghlgvr  T@PHTThh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVAxCCSHXAWTREADPGMOUTP PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P P3LASTCH @P @P h  1 h! hT @P! h H TTh\hPLASTCH'PQ8PKUP-Q8PREP*CCSGETP  P MEMORY @PHPMEMORYP P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP PwHEXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P @P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHEXDECcPQ8PKUPkQ8PREPhP __T h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP PwHEXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P @P @P >h hn9 1  00l- (dh -&l# h 1p8(h<a jB.MOVE LIBRARY x999982060282< PMOVE @P@P @P @P(@P@Po$@P 0OKALL @P:2&87F "*H- M@P$@P@P MOVE FILES@Pq@P AAAAAAAA/ BBBBBBBB CANNOT BE MOVED  PAUSE @P@P@P@P AAAAAAAA/ BBBBBBBB MOVED TO:BBBBBBBB/ CCCCCCCC @Pt FILE TO BE MOVED (CR FOR ALL FILES) @P AAAAAAAA/ BBBBBBBB @P OK TO MOVE, ALL FOR MOVE WITH NO VERIFICATION @PSYSVOL @P @P$ThTTT*T\* @PO\\*Td\h d\ h{@Pzh "\ d\t   d@P d dT  &\  1 dd 2 T@PTB  T  Z  T_^ @P iTZ\^TBT2 \ @P&  \ &Gdl Ք@PQ֔ l̞ dd\C7bd6Gd9\Z T@P|Z* \^.\P:TT* 1Jd"= *c@Pz~~Z\V\6n\q6TV*TV \gTV @PTV\n6T*dT.\\\.T{2T@P !0\\\ !T \@P( z\  u\ q@P5@P5  \\ l@PO@PO\\\qTT =TBT @Pz\  \ ߤ \  פ \! Ϥ" ɤ# @P+@P@P@P@P3@PTTPMOVE PQ8STP COMPARPGMIN %PGMINTWTREADGTMOVE,: DEFAULT IS LOGON ID,SYSVOL < TO OW@P_NER >,SYSVOL @PxTfTgh4ihjk \ghlmn Ȕh h\p@Pp h\p hhTqoh hTphȭ h\ t@PpȢ d \ptpȖh\qoh h\phr h\up@P ds Tybpup\[v4wv\fTgh4ihjkk @P$\ghlmn /do hf\pp l\p dqlT@POqol hGTphB̒ h@\tpr d \ptpsl\q@Pzol h\ph hTup d \bpup@P!HTThh!h,hGhT\hhhhh\\hhPGTMOVEPQ8PKUPQ8PREPSCAN MCCSMVAWTREADMIN0 WP P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP P>COPY DECK-ID *** ITOS 2.0 (RWE) NYGSBC SUMMARY-***@P@P;ʀ@P;@P; @Pf @P;:@P;`@P;@P;hĒhT;; h f;f; 1d; ;5d;% `d;d;( ll @P;ll llT;gg "\;g "d;4!h ll h;?h@P<(T;;;:g "L \;;g "L ;ll@P;p8:ll l l d;T;i;g;*d;gH  "@P= T;i;g "L  7 d;@P=$ !\;i;g ">,L ; =;ldd d @P=Od d d d;:;Dd;;;Ed;<;Fd;=;Gd;>T;B;;@g;p&) 1$@P<>,@P,@P,@P=>,@P>,;d ;d;?T;;@P9@P>9 Ad;Ȁ@P=@P<>=@P<>=@P<>=@P<>=@P>= Bl @P@@P>@ @l @P<>C@P<3>C@P<;>C@P= >C@P>Cll\;;р@P=">K@P>KT;Ȑ;@P;>O@P>Oll\;g\;g(H%TTh h h h h\h h h @P>z h h PPCOPY >\PQ8PKUP>bQ8PREP>_FMRDEL;PGMINT;OPENFL<GETFCB<)GETS =PUTS >FDWSUB=jCLOSFL>5SYSMSG>LP P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP  P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P __ H"!hh 6" # l o" "n`PGETVITP <f& jirRB.MOVEIDLIBRARY x999982060382< P(MOVEID @P@P @P @P(@P@Po$@P0OKALL 2&87F "*H- M@P@P@P MOVE ID @Pm@P AAAAAAAA/ BBBBBBBB CANT BE RENAMED  PAUSE @P@P@P@P AAAAAAAA/ BBBBBBBB :NEW ID =BBBBBBBB  @Pp FILE TO BE MOVED (CR FOR ALL FILES) @P AAAAAAAA/ BBBBBBBB @P OK TO MOVE, ALL FOR MOVE WITH NO VERIFICATION @PSYSVOL @PThTTT*T\* @PG\\* dd\ hih "T@Pr d\p  d d dT  @P 'T  1 dd 2TTB @P  TZ  \^  eTZ\@P^ToT*\   \@P  &.dl є    l̢ @PIdd\Z\Z*TT* !'$dT&T@Pt\\.T !.ܚl\\\@P !STy\u\q\m@Pm@P\\ l,@P@P\\\mTZT =TBT] @P\ \ߤ \פ \Ϥ ɤ E@P#$@P$@P$@P$@P$@P$TTPMOVEIDPQ8STP 'COMPARPGMIN PGMINTmWTREAD~GTMVID4CCSMVA:BLANK GETVITZERO GETFCBSYSMSGMOVE qRENAME^POPENFLCLOSFLPGMOUT%PMOVEID P!MOVE @P h8n@PHTT h\ h\hPMOVE PQ8PKUPQ8PREPP PZERO @P h7 n@P H TT h\hPZERO PQ8PKUPQ8PREPP PBLANK @P h7n@PH TT h\hPBLANK PQ8PKUPQ8PREPP  P)COMPAR @P hh !  h@PHTT h\ h\hPCOMPARPQ8PKUPQ8PREPP PLGTMVID RETREIVE PARAMETERS FROM ONE INPUT LINE. @P@PfZMP@Pl@Pp@Pt @P,,,,,,,,,@P4 ,, : DEFAULT IS LOGON ID,SYSVOL,LOGON ID < TO OW@P_NER >,SYSVOL @PvTfTgh4ihjk \ghlmn Ȗh h\p@P.p h\p hhTqoh htT.phoȱ hm\/.tpȧ @Pd \ptpțh\qoh hM\.phIȋ hG\/.upr ds @PTwbpup\pl\qol h\.ph h\/.tp @P"d \ptp@P0HTThphhhh\hhh\\hh+PGTMVID2PQ8PKUP8Q8PREP5SCAN CCSMVAWTREADMIN0 P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP __ l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 < rB.SSP LIBRARY x042882< PSSP SORTED STATUS PROCESSOR @P@PhTTTTTTTTPSSP PQ8STP PGMINTSSINIT DEFSFL GTDATAGENRPTRETSFLPGMOUTPSSP P&SSINIT INITIALIZE WSP @P@P4 ` ( 839",'! 0* @PSELECTED FILE STATUS  @PENTER SELECTED VOLUME NAME : [ ] @P#SORT BY SECTOR ADDRESS OR FILE NAME (ADDR/NAME) : [ ]@P?GROUPED BY OWNER (YES/NO) : [  ] @PPRESTRICT TO A SINGLE OWNER (YES/NO) : [ ] @Pf VOLUME ???????? NOT MOUNTED@PtYOU HAVE SELECTED THE FOLLOWING:@PINFORMATION FROM VOLUME ????????, MMUNIT??@PSORTED BY FILE NAME @PSORTED BY SECTOR ADDRESS@P WITHIN OWNER NAME@PBUT, ONLY FOR ????????@P SELECTION@P(CR) => VIEW@P (RESET) => TRY IT AGAIN@PENTER SELECTED OWNER : [  ] @P(LINE FEED) => PRINT@P???? IS NOT AN OPTION @PERROR - ???????? VIWPS IS NOT 96@PENTER FILE NAME PATERN [  ] @P$ADDR@P&NAME@P(YES @P*NO @P,SYSVOL @P0????????@PS d70 d d8 d09 d:0 d; @0(d$T33506T177TT4T@P~8\\9:\,717T;77\9:\?\9:T\&15 5\#@1 5Al@PT $& \ 55\BC\(51 50 Tp*51 5\9?D E@PFl\1 (* 1\ 55\BD\(55 \*55T9PGE@P*Hd4\(* \55TBG0 \177\D7I ld@PU\07/7\J/7IlT}9:\t?\77K0 d\9:T z:\@PL  \I \M0 \IT177̣ \B\9:\N\I@P\O\4\I\P d59d\\9:T%Q:Rd4 w    @PlTxHrPSSINITPCKSTR PROMPTPGMIN jCCSMVACLRSCRLMARGN|DISPLAdSEKVITERROR ;GETVITPGMOUTP  P&DEFSFL DEFINE SORT FILE @P@P WX@P@SSP@ @PSYSVOL @PT1 T T60 Vl\ 1X \ \ T1< T30<TlT  @P0:d` da'db 6  ,l dc0 dd de\f1 \< 3T<T08ll @Pe#T T0 ll l\< T<3Tl "\THPDEFSFLPCCSMVAISHIFTZERO -DELETE1PAGE1 6CREATE^DSKERRgGETVITjOPENFLvLHOLESP P&4GTDATA SELECT FCB-S @P? dn(dm1TTl T/1 T0 Tݜ @P+!HPGTDATA0POWNER !WCMTCHCCSBLK NXTFCBGENREC'P P&5GENRPT GENERATE FINAL REPORT @P@P $1 @P1 FILENAME OWNER FILE RECORD RECORD MAX. STAT FCB START SECTOR FCBIND CREATE@P; EXPIRE K1 K2 K3 @PO K4 @PS TYPE LENGTH COUNT RECORD ALGN INDEX SECTOR COUNT  DATE @P~ DATE LEN POS LEN POS LEN POS L@PEN POS @P@P@P@P@P ????? FILES  @P @P @P PRINTING REPORT@P0 T05 TT  d <dT17d01l\7 l\7@P'ld\17ll\7Sl\17l   d\3T<lҨ @PR #T0  QT JT  >dT8 d:T@P}0:l lT0lT l\0: dd1T70dlܞ ܝ̜@P %\17lܒ 1\7l\17Sl\7l dܧ\l d\7@Pln̖ S̒l\ l\:\0l\ l\:̍ 1\7 l\7@Pl\7l $ldTw d:T}0:T l\0:T7@P)d8l@P.@P.HPGENRPT0POWNER `DISPLAERROR  ZERO MPFACE'READR GDSKERRVCCSMVAgVLTOI CHO2LRFDWADDCONVERP P&RETSFL DESTROY SORT FILE @PT3<lT1<T30<TlHPRETSFLPCLOSFLZERO DELETE P P:CKSTR TWO OPTION STRING MATCH @P h   h    hl@P!HTTh h h\h h\h hPCKSTR $PQ8PKUP*Q8PREP'P P&DSKERR REPORT DISK ( FM ) ERROR @PT0lT HTThPDSKERRPQ8PKUPQ8PREP SYSMSGPGMOUTP PFMTFCB GENERATE STATUS RECORD @P@P@P @EDCL OPN Y $  $@P. 0 @P S R A D C B O@P@P @P @P@P@P1T hhT@P>n݄h\@PGn 1 hʫl%  ȧl ȹ șlȗl @Pr T"dTTTT\\\ \@P #d$ %l\&&&'l( )l*l lT@P\ d\l\  l\ dwd\\rl@P\+lt\  T<lj\lh\lf \d\d\dTv,@P&, 0d- dGlTB  T.h<dRn$4l\3hT@PI'/0n l l 1@P9^@P@@PC`@PI@PP@PW @Pa@PsnHkTTh\ h h h h h h h h h h h 6h hs ht@P hu h] h] h] h\ h hh h h h h h h h h @Ph h h h h$ h h h h?PPFMTFCBuPQ8PKUP{Q8PREPxVDC CCSBLK2CCSMVAVLTOI +CHO2LRFCNV2W CONVERFRHX ISHIFT1P  P&=GENREC GENERATE STATUS RECORD @P C L N Y d0TT3%olllddT@P3+<00ll #THPGENREC9PSETKEY FMTFCB WRITER*DSKERR4P P&LHOLES LIST HOLES @P@P `@P%Y@P@P@P@P@P AVAILABLE @P *@P0*6 0  d%1T 1T!T"" @(dd  d!@PUT30 %d0# h$ }Ⱦ&h\@Pk r&ȳ0&h\@Pv &T0'hT0&d\  lT10Ȏ$hT@P3ld d T 1\$% Ϋ TB1'('T<38l@Pl #T) l%1 l @lT  0ltHCPLHOLESPZERO :CCSBLK>CCSMVAMMREADVSETKEY|FRHX CHO2LRFDWSUBCONVERWRITERDSKERRFDWADDP P&iMPFACE OUTPUT INTERFACE @P ,*ILYPN@P@P h05 Th9 !4 T P? !'hlTl@P5'\\ #  #\ @POȰHTTh\hhh h h h\hhPMPFACERPQ8PKUPXQ8PREPUMPWRIXCLRSCR DISPLA.P P&NXTFCB GET NEXT FCB @P@P `@P@P@P@@P@P0 (h0 dl$ !-  h)hT%0 l @0(d' 1H d# @hT@P363 %l\13  l hd0% 'ȷ$h (h (hT@PYqopȥ `0h. h Tplș 8"m @Prȑ `hȓlHPNXTFCB{PFDWADD MMREAD6CCSMVAWMEMORYfP  PFOWNER CONDITIONAL COMPARISON OF 8 BYTE STRINGS @P h #  h  h  h  h @P)HTTh h h h h\h h h hPOWNER ,PQ8PKUP2Q8PREP/P P&PAGE1 PRODUCE BULK STATUS INFORMATION @P@P//4 L(X@P `@P~ 08@P @P1 VOLUME: ???????? DATE ??/??/?? ???? VINMBR ??@P) VIBMS* ????,???? VIFDD* ????,???? VINFDB ????? $???? VINXTB $????@PO MAXIMUM NUMBER OF FILES PERMITTED: ????? CURRENT NUMBER OF EXISTING FILES: ???@Pz??@P{ VIASD* ????,???? VIASDS ????? $???? @P AVAILABLE SECTORS: ???????? LARGEST BLOCK: ???????? @P ???????? ?,???? ???????? ?,???? ???????? ?,???? ???????? ?,???? ???????? ?,?@P??? ???????? ?,???? ???????? ?,???? @P d8d:T1TdhThdRdhx\@P(htdRdd lTT!0086 [T0d(T7 dl\7@PSllT\.8l\\00:0%l\\88&l\\:08:)l@P~\ d8\B8 l\\E:*l\\0M8\17)l@P1\7l\7l 0ld:0'l\\a:(dT9T<x:\7O9l\7@Pl ll6 30l\\: lTZ\8!l\ l\08 l\@P\:TK17{d01l\7l d \7lT @$d̺d0  d!@P T30 %d0#̧  d0$ p0$hT@P0=l l1O l V$h\@P0Vl̯ 7\7l lˀ$hT@Pi̝hT@Pr @&f0'dTh\@P: l̞ l̰1! @l! l " , dT17d08l6 @P\7l\ d0:\01:\"\:\70l5  \7l\@P71l\7Ol\7l\17l l @ HHPPAGE1 PVDC FCCSMVADATTIM ISHIFTVLTOI CHO2LRoMPFACEFRHX ZERO MMREAD!FDWADD:CONVERgP P&SETKEY SET PRIMARY SORT KEY @P@P %0 %d0TT1j\1\1[@P. sl\00rd00\ h@dRmػ 1<0l\0l\Th.@P0YdRl\1h$0dRd\hdRl\1h0dRd\9@P@P @ HHsPSETKEYPFRHX CCSMVAISHIFTUP  P>WCMTCH WILD CARD MATCHING @P h  1! h h!T \ @P( hHTTh\h\h\hPWCMTCH.PQ8PKUP4Q8PREP1CCSGETP P2CHO2LR DECK-ID B51 ITOS 1.2 SUMMARY-126@P H*h)`h'h!h  Qhl ` h h @P+PCHO2LRP P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION @PhhHhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P PlCONVER DECK-ID C10 ITOS 1.1 SUMMARY-122@P1B@'d @P h h h (hT@P#  1  (hT@P7 0n    h@PI n 1  0l@PXHTThhhh\ h hPCONVERZPQ8PKUP`Q8PREP]FDWSUB FDWADD4P P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP P#FRHX DECK-ID B53 ITOS 1.2 SUMMARY-126@P Hh`hDhBh 0 q c H A`PFRHX P P4SEKVIT SEARCH FOR VIT MATCH TO VOLUME NAME @P H-h,TTh'\h&\h%h# L `: ` " v  l@P+`PSEKVITPQ8PKUPQ8PREPP P5VLTOI DECK-ID B61 ITOS 1.2 SUMMARY-126@P H/h.`h,h'Dh*h((`B 9H!  0 nH DQ S  0n `'@P+d PVLTOI P PuWTRD WTREAD INTERFACE @PX hh hT=T  h@P+X X:XjDhBhT8Xo X /6Ȉh}Ȉ@PV{h~hhT9c wh [YlX7 @PX! 1 OhF?X& Xlh=19116h h+&@P$h h ! hT^TX X@Pȟ h H !bhΐjTxXT@PX X\h! 1 Oh^! 1 hhX@P- X8XhBh@h?h 7h ' jT89@PX|hhy TN8 !h h hT`@P9X=! uyntXy+ !ijeͤ @P_nXdhHH T:>? h@@P  PAUSE @P8@P>Xo Xl)hyX` Xw= lhtoȠ lb@Piel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P PGMMREAD MASS MEMORY READ FUNCTION @P hhh'h hTdT`DhҀ@P2HTTh\h\h h\h؀PMMREAD5PQ8PKUP;Q8PREP8FREAD DISPAT&P PHMPWRXX UNIT RECORD FUNCTION PROCESSOR SUMMARY-***@P h  h  h  ɀhHhh H hT+@@@P+@ h ɀhHhhhhPMPWRIX MPREDXMPWRIUMPREDUMPMOTN3P P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP P&DUPL DUPLICATE ( COPY ) ARRAY @P  1 h8n@PHTT h\ h\hPDUPL PQ8PKUPQ8PREPP P%REPL REPLICATE ( INITIALIZE ) ARRAY TO CONSTANT @P  1 h8n@PH TTh\ h\hPREPL PQ8PKUPQ8PREPP PVPC VALIDATE TWO PRINTABLE CHARACTERS @P H" 2 1 `h"Ƞ 2 1 `ȸPVPC P P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP P MEMORY @PHPMEMORYP PISHIFT @PH"h"hC PISHIFTP PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO PQ8PKUPQ8PREPP __ PISHIFT @PH"h"hC PISHIFTP PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO PQ8PKUPQ8PREP<$ ~kB.CHEAT LIBRARY x042882< PCHEAT CHEAP PEEK AT MEMORY ( MAIN + MASS ) @P@P (P F $@P >@P$ , @P R@P @P@P`@Pi@Pr MMU: @Pv MMADR: @Pz  @P  @P+-@PERROR @PRELATIVE@P31 BIT @PMAIN@PMASS@P hhTThT\rh\ hh@PJ \h\h!h\T @Pu  \h\h\h dk@PTkdT)hT hi\l\hd 1 !h hV\@PhS\hPl dddqT3 dl\h\vh@P\ h\ h\h d  ̭ R@P ̢ ̛  ̓  h Th@PK̕   dRl T h\hg\@Pv h  \ h  \h T@Ph Th T ̓ Wdq dT@Pdd\\Tah\h "`T@Pkdg d d _d̾dd!G\~ d d dz h@P"h\@P&܀hT@P-fz l 1  \{h Tzdhܮ̷ @PXd_dq l lddddTT@Ph\h dTn `1Y@P)@P ld\lM@P8@P̨ `l\hTih@PC@P̔ l\hTih@P"@PTTPCHEAT PQ8STP VPC +PGMINT%WTREADBLANK CNVSTREHEXASCMEMORYFDWADDFDWSUBMOVECHMMREADMPWRIXKPGMOUTPCHEAT  PVPC @PTh HTThPVPC PQ8PKUPQ8PREP VDC P P CNVSTR @P @P,-.+@P l+l+l+l+l+T h hTh ޘ l\hӘ  T@P7@P=\hTȶ  l\h \\h\@PhȘh hȕ  l" 9 & TT@PT T  !Tl Tlp d@P:JHGTThOh[hchmhqh|hhhh\h=hIhQh[h_hj@Phphuhxh\hHhhhhhhhh h>\h7\h5\h3hPCNVSTRPQ8PKUPQ8PREPMATHOPNEXTCHHEXNUM1DECNUMCFDWADDFDWSUBFDWMUIFDWDIVP P?DECNUM @P@P l Th !Thh\hh h lTl@P*HTTh\h\h\h\hhـPDECNUM,PQ8PKUP2Q8PREP/DECDIGISHIFTNEXTCH"P PDECDIG @P09@P h 7 3h@P HTThPDECDIGPQ8PKUPQ8PREPP  P4HEXNUM @P l Th !Thh dRlTl@P HTTh\h\h\h\hPHEXNUM"PQ8PKUP(Q8PREP%HEXDIGISHIFT NEXTCHP P-HEXDIG @P09AF@P h 7 3h 8 4 h@P HTThPHEXDIG#PQ8PKUP)Q8PREP&P P.MATHOP @P+-*/@P h  h  h  h  h@P! HTThPMATHOP$PQ8PKUP*Q8PREP'P P%NEXTCH @P @P h ,Th @PH TTh\h\hPNEXTCHPQ8PKUPQ8PREPCHAR P P@FDWDIV @Phhh lla4d  dl l@P*HTTh h\h\h h\hPFDWDIV,PQ8PKUP2Q8PREP/P PxASCII ASCII TO HEX CONVERSION @P@P @P  @P!DhCTfh ???  @P BIT 14 STORAGE MODE FOR INDEXED FILE@P ? > ???????  @P BIT 13 OPEN/CLOSED INDICATOR ? > ??????  @P BIT 12 FILE COMPRESSION INDICATOR @P ? > ???  @P BIT 11 SPECIAL PROCESSING INDICATOR ? > ???  @P@ BIT 8 BINARY DATA INDICATOR @PT ? > ??????  @Pe BIT 0 FILE TYPE ? > ??????????  NEDAT*@P - # EXISTING RECORDS ???@P????? $????,???? ( 7, 8)  @PLINKF* - NEXT FREE INDEX BLOCK ???????? $????,???? ( 9, 10)  TNKEY*@P - TOTAL # KEY INDEX BLOCKS ???@P????? $????,???? (11, 12)  @PKEYBA* - KEY INDEX SECTOR ADDRESS $??,???? (13, 14)  @P0 LENKYI ????? ????? ?????@PD ????? (15, 17, 19, 21)@PU POSKYI ????? ????? ????? ????? (16, 18, 20, 22)TSFIL*@P - TOTAL SECTORS ALLOCATED ???@P????? $????,???? (23, 24)  @PNAMEXX - FILE NAME ???????? ???? ???? ???? ???? (25, 26, 27, 28)OWNRXX@P - OWNER NAME ???????? ???@P? ???? ???? ???? (29, 30, 31, 32)@PBYTLEN - RECORD LENGTH IN BYTES ????? $???? (33)  PRSRN*@P - REL. RECORD # LAST PROCESSED ???@P4????? $????,???? (34, 35)  @PENEWRN* - REL. RECORD # LAST COMPRESSED ???????? $????,???? (36, 37)  @Pp PAUSE @P  @PUNUSED  ???? ?@P??? ???? ???? ???? ???? ???? ???? @P???????????????? (?? > ??)  @P FIRST RECORD OF RPG ARRAY DATA ????? $???? (86)  @P TEXT EDITOR FILE TYPE @P$????? $???? (87)  @P5 MAX. RECORD COUNT OF DIRECT FILE ????? $???? (88)  @P` EXPIRATION DATE ?????? @Pt ???? ???? ???? (89, 90, 91) @P CREATION DATE ?????? ???? ???? ???? (92, 93, 94)  @P FILE USAGE ????? $???? @P ?????????????? (95)  @P FILE TO BE SORTED FLAG ????? $???? ??? (96)  @P 1 2 3@P 4  @P_hT%TeTWTW&'&TT_T_WTW a\@PW\W()(\\W\W(%)(\B d\b\ j\e(u+(@P, \c(u+(-dެ .l\g/0/Ф1 \k/0/d@P l\o&2&̴3 Tpr&2&d̤ l\e(+(@P ̗4 \c(+(̩d ̩l\e(+(5 \c( +(-@P6d- .l\x&=2&Ԥ6 \u&=2&dUŬ l\{7e8@Pa7̸ T7e87d}̨ lT| _T_WTWaTx W\W@P()(\ \ _\_W\Wa\ W\W()(\ \_\_W\Wa\W@P\W()(\\W\W9:;:\"Tl;\>\A\D\c\f\@Pi\ld_d`\_W\Wa\WThW(})(\Td \d@P \d\dTW\W(<(\\W\W()(\\ d \!d@P 8\"d\#d\ W\W(<(\!\"W\W()(\#T$W\W&@P c'&\$Ty%_T}_WTW2a\%W\W()(\&:\'_\_W\W Za\'@P WTW(E)(T (b d= &d>h\@P h\@P W\W(&(h\@P h\@P W\W(?(Ԁh\@P ̀h\@P W\W(@(̿ h\@P ̸ h\@P W\W(A(̪hT @P d̡h\@P d̙h\@P d̑h\@P d>h\@P dh\@P %d h\@P -d h\@P 5dT [>WT WB:C: d\W\WB:E:= (,?h\F@P ]F̷ l U2 \YT Y\Z$\Z*\[L\[RT \dW\]dX\^dY\@P W&]G&\\u\]W\W(])(\^z\_l\`l\al\W&G&\ _\`@P W\W()(\aT 8bWT <W&H&\bW\W(I(\JKJb @P \JKJ \JKJ \JKJ \JKJ \@P JKJ\cW\W&H&T kcW\W(I(\c((c \e(@P 4(TTFdT\Fl\:\%Fl\9%\MFl\(M\@P _uFl\Bu\Fl\&\Fl\D\Fl\/\Fl\L@P \=Fl\7=\eFl\Me\Fl\N\Fl\OT 8FlT@P >J\Fl\P\Fl\?\-Fl\Q-\UFl\R U\}@P Fl\S}\Fl\T\Fl\U\Fl\V\mFl\Wm@P TW?XddT 6\Fl\\EFl\:E\9Y:T FlT (@P 6\BY:\gFl\&g\Fl\D\Fl\/\Fl\L\@P aFl\7\/Fl\M/\NY:\Fl\O\ Fl\J \5F@P l\P5@P` @P \]F@P @P @P F @P H @P < @P B @P K @P T @P ] @P f @P o @P x @P @P @P @P @P @P @P @P @P @P @P @P @P @P @P  @P @P  @P & @P 6 @P D @P M @P V @P _ @P h @P q @P  @P @P @P d\?]\Fd\QT -FdT 2R \Fh\S \TY@P :YdZ\UHT U[Z \fTN.:T eWT W9:A:@P є]^l\f\LI\LY:\LF\LF\L%F\LMF\LuF\LF\@P LF\LF\LF\L=F\LeF\LF\LF\LF\LF\LF\L-F@P A\LUF\L}F\LF\LF\LF\LY:T LmF\LY:\LF\L EF\L@P lY:\LF\LY:\LgF\LF\LF\LF\LF\L/F\LY:\LF\@P L F\L5F\L]F\LF\LF\LF@P @P @P @P @P @P TTPDMPFCBPQ8STP VDC {PGMINTcDFINITgHEXDEC CCSMVA HEXASC CNV2W iCONVER mCHO2LR qCLRSCR DSPLA LASTCH INPUT PMPWRIX ZPGMOUT PDMPFCB PDFINIT INITIALIZE FOR DMPFCB @P@P@P@P A:  B: C: A B C Z @P@P@P`@P! @P2@P3????????@P7$????,????@P<,@P=DMPFCB - DUMP FILE CONTROL BLOCK@PMFILE NAME:@PROWNER:@PUVOLUME: @PYFCB INDEX:@P^MM UNIT:@PbFCB SECTOR ADDRESS: @PlPHYSICAL UNIT:@PsSELECTION: [?]@PzVOLUME NOT MOUNTED@PFILE NOT FOUND@PILLEGAL INPUT CHARACTER @PZ: EXIT @P@P DMPFCB@P<,@P,,,,@P< FILE NAME >,, --- OR <(CR)> @P" "TTTȓ hT hȅ hT<@PMh h\<h h\<h h\<hȊd "T@PxT=\\M\3\R\3\U\ 3\@P\Y\7\ ^\  3\ \b \ 7\l@P\ 3\d \sT  d,T2 T0 @Pܔ֔Д@P\\ \\ \0 T,,,Ty\@P=\ \0d ! dT  T0d- 1! 1B@PhT // +\ $\0l !( llT#, d&\&@P,̿d.@P "\z "T5TTd,2 @PT0  dTd Md\  \  l՜  l@Pl Tl ?̕ dTP  ddT#, d@P&\&,d.TTTd,\\̙l\@PH  \  l\@P T@PT\\ lݔ2  dT d AT< \@P d +l l\ \ ḷ  lTd.  @Pddl)T+T1T5 d,\\\ \ @Pl\@P@P ddT.T<\.v@Pu@P d d  d\  lT/000 * l\ @P lT  "L l\ ,@P<@PZH:@P  Ȣ h Ph'I#Bȑ?h ! PhX h5h -@Py1 Hh hT # h T @P h l X X h? h>X? "  2 2  " P"@P  hh# 2 PhT80/ !h !@P1 X Xl X XlzPCLRLINOCLRSCRDDISPOS0DSPLA ^FLUSH 4INPLEN1INPUT TERMCH9PWTREADOPENFLCLOSFLP P2CHO2LR DECK-ID B51 ITOS 1.2 SUMMARY-126@P H*h)`h'h!h  Qhl ` h h @P+PCHO2LRP P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION @PhhHhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P PlCONVER DECK-ID C10 ITOS 1.1 SUMMARY-122@P1B@'d @P h h h (hT@P#  1  (hT@P7 0n    h@PI n 1  0l@PXHTThhhh\ h hPCONVERZPQ8PKUP`Q8PREP]FDWSUB FDWADD4P PHASH HASH FILE NAME + OWNER NAME INTO FDD @Pd@Pg`@Pi hH_h_h]h[hZhWhu dldHTThShe\hOha\hT\hPh@P 6PZCNVRTPQ8PKUPQ8PREPCCSGETOP PICNVRT @P-09 ,.+-@P4@P@P@P@ lhh h T= u@PY "\=hǘ 6Ҙ 2h̘ hƘ ȼh ȷhȺ@P Ȳhȴ ȭh (hh (,hh"! ( @P=-h $l d;>dWd< dldH@PTThlh~\hhhz\hm\hihOPICNVRTPQ8PKUPQ8PREPCCSGETLP P9SCAN SCAN - SCAN STRING TO SEPERATOR @P % l@P ThT#  ! lhހ@P%HTTh\h\hh\hPSCAN (PQ8PKUP.Q8PREP+RAO CCSGETP  P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP PISHIFT @PH"h"hC PISHIFTP PMOD @PH"h"h <PMOD P P RAO @PH""PRAO P  PNFETCH @P@P0,,A,@P6N@P9 @P+ @P:hT. hj )1hT23+45\2365\23+7@Pe365 \23-48ȿ  hʄnذ (1Ȧ l \2395@PTH TT h\h\hPNFETCHPQ8PKUPQ8PREPPGMINT>WTREADNPGMOUTP __H""PRAO P <% ~kB.STAT LIBRARY x042882< PrSTAT STATUS FILE @P@P@P@P@P N P6"@P@PFILENAME OWNER FILE RECORD RECORD MAX. STAT FCB START SECTOR FCBIND CREATE E@P/XPIRE K1 K2 K3 @PCK4 @PF TYPE LENGTH COUNT RECORD ALGN INDEX SECTOR COUNT  DATE @PqDATE LEN POS LEN POS LEN POS LEN@P POS @P VOLUME ???????? @P ???????? NOT FOUND @P ???????? / ???????? NOT FOUND @P @PSSP @P @P @P @P,,,,@P,@P< FILE NAME >,, --- OR <(CR)>   STAT@P @PT hTp dTp h hTp h\p@P$h\ph\phȯ h " h 3TȞ l\pȖ@PO h " h , d\p  6T l @Pz" l dۜ . l hTpqT .Td @P". dT zT\T\@P\\F\\\@P+\\m\\\@P& ! "  "TTT@PQ\ !\\\\\T@P q@Pq@PIq@P_q@PbqPSTAT PQ8STP pSCAN HASH WTREADHNFETCHCCSMVA@CHAIN BPGMIN mGETVOLFETFCBFMTFCBPGMOUT>PSTAT P>FETFCB FETCH THE SPECIFIED FCB @P` hhT hh\ h T)h@P*HTTh\h h h\hPFETFCB,PQ8PKUP2Q8PREP/FDWADD MMREADP  PFMTFCB GENERATE STATUS RECORD @P@P@P @EDCL OPN Y $  $@P. 0 @P S R A D C B O@P@P @P @P@P@P1T hhT@P>n݄h\@PGn 1 hʫl%  ȧl ȹ șlȗl @Pr T"dTTTT\\\ \@P #d$ %l\&&&'l( )l*l lT@P\ d\l\  l\ dwd\\rl@P\+lt\  T<lj\lh\lf \d\d\dTv,@P&, 0d- dGlTB  T.h<dRn$4l\3hT@PI'/0n l l 1@P9^@P@@PC`@PI@PP@PW @Pa@PsnHkTTh\ h h h h h h h h h h h 6h hs ht@P hu h] h] h] h\ h hh h h h h h h h h @Ph h h h h$ h h h h?PPFMTFCBuPQ8PKUP{Q8PREPxVDC CCSBLK2CCSMVAVLTOI +CHO2LRFCNV2W CONVERFRHX ISHIFT1P PMGETVOL GET SPECIFIED VIT @P@P@P ! !)T 1TT  \\@P/  lHTTh\hhh\hh hhPGETVOL9PQ8PKUP?Q8PREPZH:@P  Ȣ h Ph'I#Bȑ?h ! PhX h5h -@Py1 Hh hT # h T @P h l X X h? h>X? "  2 2  " P"@P  hh# 2 PhT80/ !h !@P1 X Xl X XlzPCLRLINOCLRSCRDDISPOS0DSPLA ^FLUSH 4INPLEN1INPUT TERMCH9PWTREADOPENFLCLOSFLP  P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP P#FRHX DECK-ID B53 ITOS 1.2 SUMMARY-126@P Hh`hDhBh 0 q c H A`PFRHX P PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P  PGMMREAD MASS MEMORY READ FUNCTION @P hhh'h hTdT`DhҀ@P2HTTh\h\h h\h؀PMMREAD5PQ8PKUP;Q8PREP8FREAD DISPAT&P P4SEKVIT SEARCH FOR VIT MATCH TO VOLUME NAME @P H-h,TTh'\h&\h%h# L `: ` " v  l@P+`PSEKVITPQ8PKUPQ8PREPP PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P  P5VLTOI DECK-ID B61 ITOS 1.2 SUMMARY-126@P H/h.`h,h'Dh*h((`B 9H!  0 nH DQ S  0n `'@P+d PVLTOI P P9SCAN SCAN - SCAN STRING TO SEPERATOR @P % l@P ThT#  ! lhހ@P%HTTh\h\hh\hPSCAN (PQ8PKUP.Q8PREP+RAO CCSGETP PISHIFT @PH"h"hC PISHIFTP  P RAO @PH""PRAO P PNFETCH @P@P0,,A,@P6N@P9 @P+ @P:hT. hj )1hT23+45\2365\23+7@Pe365 \23-48ȿ  hʄnذ (1Ȧ l \2395@PTH TT h\h\hPNFETCHPQ8PKUPQ8PREPPGMINT>WTREADNPGMOUTP __H""PRAO P PNFETCH @P@P0,,A,@P6N@P9 @P+ @P:hT. hj )1hT23+45\2365\23+7@Pe365 \23-48ȿ  hʄnذ (1Ȧ l \2395@PTH TT h\h\hPNFETCHPQ8PKUPQ8PREPPGMINT>WTREADNPGMOUTP <S[o <~:B.WEAVE LIBRARY x042882< P /WEAVE WEAVE FILES TOGETHER @P@P0@P" @P& 'P@P.@P1J@P3IK@P6$$ $^_24"@PA@P W E A V E VERSION 5.0 08/31/82 @Pdd@P @P&80@P\@P, INVALID OU@P2TPUT FILE NAME@P DONE--REMEMBER TO SEQUENCE BEFORE EDITING@P FILE PYRAMID TO DEEP --  @PAT"T !\"#!T'"T$%Ⱦ )\@Pl,&!Ȳ "TT'';(\))O)\.))\3) )T@P9TTk$T*+,\k d-.,hT @P// ,hT@P0 l " ,h9&  ,h dӎ  T1 @P Id2\2d5  T5" K1 ,h\@P  \3  ,h \3h\@P$ $-Jh\@P, \1  ,Jh\1hx\@PB ,|h\@PI \4  ,|h T4hZ\@P`6Qܿ " ,h ,|h ,Jh  ,9hT@P ,h+*97 $-9h , 7hTx@P(@P(T (.,hT@P@P ,hҔ&  ,9hT@P3' ,h d \3'86l@P@PTk@P@P\9kTk:Tk0\;<;TH=!Tv\';>;\?@P !\k0 d@̊,h\@P &0 1\TPWEAVE PQ8STP .CHAR XPGMIN BWTREADGTWEAV[VALID aPGMOUT CCSMVAOPEN KILFILZERO MAKFILREED CLOSFLPDOREPLPARSE MOVECHWRIT SHRINKPWEAVE PGTWEAV WEAVE-RETREIVE PARAMETERS FROM ONE INPUT LINE.@P@PjZMP@Pq@Pv@Pz  H!(@P,,,,,,,,,@P4 ,,,,<REPLACE 2>, ,,@PTj\j\kTlm4nmop \lmrs@Pt /h TȻ d\vvȰ h hhTwuh l Tv@Plȟ d\vlȕ d\ȋh\wudyx l\vl l\@Pvl lTz d \vzvl\wul l\{l@P. l\q̿ d ̹ d\q̬lTwul lT|l@PY̝ l\|̓ dy x d\|l\wul l\|@Pl lT | d  d\|l\wul h\@P|h̸ h\|̭ d ̧ h\|\[}4{~\44@P\kTlm4nmopp \lmrst /du T@P hTvv l dwdxTKwudy h{TUvhv hs\@P0vho hm\l\wulݜ hY\vhU՜ hR\vhN hL\@P[z̻ d \vzv̶l\wul h+\vh'̧ h$\vh ̗ hT @Px dy  h \v@P@P@P@P@P@P@P*@P3@P@@PC@PV@P_@Pn@Pq@P@P@P@P@P@P@P@P@P @P2@P^@P@P@P@P @P9H6TThhh9h[hf\hhh}hhhh\hqh hh h@Ph hh\hAhPGTWEAVPQ8PKUPQ8PREPSCAN CCSMVAWTREADPGMOUTMIN0 &P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP PHOPEN @P@PK@P@P TlTl `lT -ThT T@P0HTThh\hh h h h hPOPEN 2PQ8PKUP8Q8PREP5ZERO ILOCF OPENFLMOVE SYSMSG'PGMOUT+P PKILFIL @P@P:"@P@P TEMPFILE P@P DELETING @P@ h j 1T8 5 'T8<;T8T: :T@Pk 8Ȩ T<=>?ȹ '\ 8<; H TThhhPKILFILPQ8PKUPQ8PREPOPENFLKFMERR XCLOSFL_CCSMVAcDELETEkWTREADuP PMAKFIL @P@P> "@PJ@P@P FILENAME P@P9SYSVOL @P CREATING @PL l2h # j j 1 hT8Ө Ψ  'T8@?@PwT8 lz@P h fض 1S " lO hLhK' G #Dd,T> >(\@P9C DCT 88E$F l0T@GHI 1@P"\ 8@?@Pp4Jdl "T dK f 1HTTh_hmh\h\h\@P hr=PMAKFILPQ8PKUPQ8PREPOPENFL`FMERR qCLOSFLxCCSMVACREATEWTREADPGMOUTP PSHRINK @P@Pv@Pz@Pn NOT REDUCED @Pa NOT SEQUENTIAL@P|Taeu !> Tvwfxy\vwnzy.Tu !@P ! llT{Tuȷ 4 @PTuvHTThhhh h\hh h h\hPSHRINKPQ8PKUPQ8PREPGETFCB}WTREADCLOSFLZERO REDUCEFMERR P PGPARSE RETREIVE PARAMETERS FROM BUFFER LINE @P@P  @PD @P,@P:@PT T \ \\\ @PAhhThǘ hT hȻ h\  ȱh\h h\@Pl hȟ h\  ȕ ȑ d \ȅ  d \@Pl  hj\ hf hdT   l\l RԜ hL\ @PhH hF\  lTDl 4̶ h.TO h)̯ h'\  @P̣l\l ̘ h\ h ̒ h \  @P 9H6TTh-h?hFhWhuhhhhhhh\hh.hHhV\hhw\@P8hh\hh\hhPPARSE PQ8PKUPQ8PREPSCAN PGMIN CCSMVAMIN0 P PREED @P@P l :  ! l l@P ! !% dl l h 5 dl lT T@P@P lhHTTh\hh h h hh hh\hhhPREED PQ8PKUPQ8PREPGETRCSSHPRECP  P>GETRCS @PN@P  @P hT )  l@Pl @P"TTHTTh h\h\h\h\hPGETRCS*PQ8PKUP0Q8PREP-READR SYSMSG#PGMOUT'P PJSHPREC @P(@P_@P, h  hT@P*@P0 l@P4HTT h\h\h\h\ %hPSHPREC6PQ8PKUP?? &\@P@?s?A??? d?d?T?q??? l   'T@$?^?!????,d ? d?@P@d?՜ 2AQ d?"AQ$?  d?p?? ln?@P@  Ld ?  LlՀphT@PA d? !? !?ǜ # d? 6̢ ̳d? lܘ)̘ %̜$?h @PA/?,d?̞ph ̚phT@PA???@PAB? l? "@PANw? ʀp hT?>@PA^???ä??l 'T@?s?A???̣ ? !T@+ ?T@/?> p? @PA&\?s?A???deT?> p? &\?s?A??? d?? l? T?>@PA?s?T?>?\??TA=?s????T@?????@P?A@PAT@TPSNARF PQ8STP APGMINT?PGMIN ?WTREADAGTSNAR?VALID @PGMOUTAOPENS @FMERR AmZERO A}GETFCBAGETLNO@LKILFIL@tMAKFIL@wPGETS @LINUM ACCSMVAAPUTS A[UPDFCBASHRINKACLOSFLAPSNARF P[GTSNAR RETREIVE PARAMETERS FROM ONE INPUT LINE. @P@PfZMP@Pl@Pp@Pt !@P,,,,,,,,,@P4 ,, ,, @PyTfTgh4ihjk \ghlmn ȓh T d@P\pp h hhTqoh lTplȰ d\pȦh\@Pqoh l\plȖ l\tpȌ d \ptpsdr\q@Pol l\pl lTzup d  d\upl\q@P%ol̜ l\l l\/.m̼ d ̶ h\.m\[v4wv@PP\bp4xp\fTgh4ihjkk \ghlmn /@P{do T hTp.p l dqdrTqods hT.ph@P h\/.pl\qol hr\.phn hl\/.tp d @P\ptpl\qol hL\.phH̬ hF\/.up̢ d ̜ h5\@P.up̚l\qolr h"\.h hT/.m ds  h \@P'.m@P.@P.@P.@P.@P.@P.@P.@P .@P.@P.@P+.@P/@P/@P/@P /@P0*H'TThhhhh\hihhhh\hhhh\hhzPGTSNAR2PQ8PKUP8Q8PREP5SCAN CCSMVAWTREAD_PGMOUTMIN0 P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP P(OPENS @P @P@PTlT@PHTTh\hh h\hPOPENS PQ8PKUPQ8PREPZERO OPENFLP PGETLNO @P@PE+(@PL@PO@PS&@P ENTER < FIRST LINE # >,< LAST LINE # > @P@,,,,,,,,,@P- FIRST GREATER THAN LAST -- RE-ENTER@PTTETFGHGIJh  h \FGLMN  h_TA@POO llChhT@PKh d 8Ȼ h@TFh;Tȭh\@P@PKhȤ d ȝ h$\FFȔ h\Fh\ -TYFG-S@PJ{@PH TTh\hlPGETLNOPQ8PKUPQ8PREPSCAN BLANK UWTREADCCSMVA|INTGR MIN0 P P>LINUM @P@P@P T hT 9! = 1Th h H @P4TTh\hPLINUM 2PQ8PKUP8Q8PREP5CCSMVA CCSGETINTGR %P P3INTGR B65 F CCS CCS 3.0 SL-149@P hlh !ThT(l @P"H TTh\h\hPINTGR %PQ8QI2FQ8PKUP+Q8PREP(CCSGETP PKILFIL @P@P9"@P@P TEMPFILE P@P DELETING @P?T8 5 'T8:9T8T; ;T 8Ө T@Pj:<=> '\ 8:9 H TThhhЀPKILFILPQ8PKUPQ8PREPOPENFL@FMERR MCLOSFLTCCSMVAXDELETE`WTREADjP PMAKFIL @P@P= "@PI@P@P FILENAME P@P9SYSVOL @P CREATING @PK lT8  'T8>=T8 lh@PiHhG& C "@hT@ @ȫ\9B CBT 8Ȭ$ȧ@P lȡ5T>FGH8 1&\ 8>=@Pp4Idl "T !\ dJ f 1HTThvhh\@Ph\h\hePMAKFILPQ8PKUPQ8PREPOPENFLNFMERR [CLOSFLbCCSMVAuCREATEWTREADPGMOUTP PSHRINK @P@Pv@Pz@Pn NOT REDUCED @Pa NOT SEQUENTIAL@P|Taeu !> Tvwfxy\vwnzy.Tu !@P ! llT{Tuȷ 4 @PTuvHTThhhh h\hh h h\hPSHRINKPQ8PKUPQ8PREPGETFCB}WTREADCLOSFLZERO REDUCEFMERR P P9VALID VALIDATE INPUT CHARACTERS $20 TO $7E @P ! h lh!T ~9 6@P# lHTTh\h\h\hPVALID )PQ8PKUP/Q8PREP,CCSGETP  PZERO @P h7 n@P H TT h\hPZERO PQ8PKUPQ8PREPP PBLANK @P h7n@PH TT h\hPBLANK PQ8PKUPQ8PREPP PFMERR FM FILE ERROR REPORTER W/WO PAUSE SL-***@P@Pw@Py@P@P)#@Pf7@Pi?- @P FILE MANAGER ERROR: FILE NAME = , REQUEST = , ISTAT = . @P*FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PUTS UPDRECDELRECCOMFILVOLUSEREDUCE@Po PAUS@PrE @Ps @@P{T)T&l ! ! , h\*xfgf Kh @P\ikjk 9hTmhnnnx Ȼ   \moymz@Px  T@PHTTh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVA|CCSHXAWTREADPGMOUTP *T __i?- @P FILE MANAGER ERROR: FILE NAME = , REQUEST = , ISTAT = . @P*FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PUTS UPDRECDELRECCOMFILVOLUSEREDUCE@Po PAUS@PrE @Ps @@P{T)T&l ! ! , h\*xfgf Kh @P\ikjk 9hTmhnnnx Ȼ   \moymz@Px  T@PHTTh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVA|CCSHXAWTREADPGMOUT<>r 2z'B.DISM LIBRARY x042882< PCDISM DISMOUNT VOLUME FROM USER TERMINAL @P@P@P@P@P@P@P1@P)@P/ # $@',%4@P DISMOUNT UTILITY VOLUME DK LU HD -------- -- -- -- DISK (1-7)@P TO DISMOUNT: DK= @P_  @Pj 000000@P@PA XXXXXXXX DISMOUNTED FROM TERMINAL XX, ID=XXXXXXXX @P ERROR VOLUME NOT DISMOUNTED ISTAT=$XXXX @PhTT[T\\ h@P'T## PKT$_T#diȗ h\\_@PRT h\hh\d 1h\d\\_\_@P} 1\ ?T  d\#̉ T@P# ? 3 #\ ! ! \ T@P 19 \ \\\T T6@PT 1@P\$AT>\A\[A\A  \A@P;@P?@P?TTPDISM PQ8STP BPGMINTPGMIN WTREADGETVIT(CCSMVAHXDEC MEMORYTCCSGETSYSMSGVOLUSECCSHXAPGMOUT@PDISM PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP P MEMORY @PHPMEMORYP __ @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP P MEMORY @PHPMEMORY<pO {"UB.UNSEQ LIBRARY x042882< SUBROUTINE PGSJL(IARRAY,IBPOS,ILNG,OARRAY,OBPOS,OLNG) B9800001 1 /B98 F CCS CCS 3.0 SL-149B9800002C B9800003C CYBERCREDIT SYSTEM VERSION 3 B9800004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B9800005C COPYRIGHT CONTROL DATA CORPORATION, 1979 B9800006C B9800007C LEFT JUSTIFY WITH TRAILING BLANKS THE CONTENTS OF AN ARRAY B9800008C OF GIVEN LENGTH B9800009C IARRAY = INPUT ARRAY B9800010C IBPOS = BEGINNING POSITION WITHING THE INPUT ARRAY B9800011C OF THE VALUE TO BE LEFT JUSTIFIED B9800012C ILNG = LENGTH OF THE VALUE TO BE LEFT JUSTIFIED B9800013C OARRAY = OUTPUT ARRAY (CAN BE SAME AS INPUT ARRAY) B9800014C OBPSO = BEGINNING POSITION WITHIN THE OUTPUT ARRAY B9800015C OLNG = LENGTH OF THE OUTPUT VALUE B9800016 INTEGER IARRAY(170),OARRAY(170),IBPOS,OBPOS,ILNG,OLNG B9800017 INTEGER WKARR(15) B9800018C MAXIMUM LENGTH OF THE FIELD IS 30 POSITIONS B9800019C MAXIMUM ARRAY SIZE IS 340 CHARACTERS B9800020C B9800021C CLEAR WORK ARRAY TO BLANKS B9800022 CALL CCSBLK(WKARR,30) B9800023C LEFT JUSTIFY VALUE IN WORK ARRAY B9800024 IHOLD=$0000 B9800025 IPOS=IBPOS B9800026 DO 20 K=1,ILNG B9800027 CALL CCSGET(IARRAY,IPOS,IHOLD) B9800028 CALL CCSPUT(IHOLD,K,WKARR) B9800029 IPOS=IPOS+1 B9800030 20 CONTINUE B9800031C TRANSFER WORK ARRAY TO OUTPUT ARRAY B9800032 IPOS=OBPOS B9800033 DO 30 K=1,OLNG B9800034 CALL CCSGET(WKARR,K,IHOLD) B9800035 CALL CCSPUT(IHOLD,IPOS,OARRAY) B9800036 IPOS=IPOS+1 B9800037 30 CONTINUE B9800038C RETURN B9800039 RETURN B9800040 END B9800041 SUBROUTINE PGSJR(IARRAY,IBPOS,ILNG,OARRAY,OBPOS,OLNG) B9900001 1 /B99 F CCS CCS 3.0 SL-149B9900002C B9900003C CYBERCREDIT SYSTEM VERSION 3 B9900004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B9900005C COPYRIGHT CONTROL DATA CORPORATION, 1979 B9900006C B9900007C RIGHT JUSTIFY WITH LEADING ASCII ZEROS THE CONTENTS OF AN B9900008C ARRAY OF GIVEN LENGTH B9900009C IARRAY=INPUT ARRAY B9900010C IBPOS = BEGINNING POSITION WITHIN THE INPUT ARRAY B9900011C OF THE VALUE TO BE RIGHT JUSTIFIED B9900012C ILNG =LENGTH OF THE INPUT VALUE B9900013C OARRAY=OUTPUT ARRAY (CAN BE THE SAME AS INPUT ARRAY)B9900014C OBPOS =BEGINNING POSITION WITHIN THE OUTPUT ARRAY B9900015C OLNG =LENGTH OF OUTPUT B9900016C B9900017 INTEGER IARRAY(170),OARRAY(170),IBPOS,OBPOS,ILNG, OLNG B9900018 INTEGER WKARR(15),WKPOS B9900019C MAXIMUM LENGTH OF FIELD IS 30 POSITION B9900020C MAXIMUM ARRAY SIZE IS 340 CHARACTERS B9900021C B9900022C CLEAR WORK ARRAY TO ZEROS B9900023 DO 10 K=1,15 B9900024 WKARR(K)=$3030 B9900025 10 CONTINUE B9900026C RIGHT JUSTIFY VALUE IN WORK ARRAY B9900027C # LEADING ZEROS EQUALS OUTPUT LENGTH - INPUT LENGTH B9900028 WKPOS=OLNG-ILNG+1 B9900029 IHOLD=$0000 B9900030 IPOS=IBPOS B9900031 DO 20 K=1,ILNG B9900032 CALL CCSGET(IARRAY,IPOS,IHOLD) B9900033 CALL CCSPUT(IHOLD,WKPOS,WKARR) B9900034 WKPOS=WKPOS+1 B9900035 IPOS=IPOS+1 B9900036 20 CONTINUE B9900037C TRANSFER WORK ARRAY TO OUTPUT ARRAY B9900038C OUTPUT ARRAY IS NOT USED INITIALLY AS IT CAN BE AT B9900039C THE SAME ADDRESS AS THE INPUT B9900040 WKPOS=1 B9900041 IPOS=OBPOS B9900042 DO 30 K=1,OLNG B9900043 CALL CCSGET(WKARR,WKPOS,IHOLD) B9900044 CALL CCSPUT(IHOLD,IPOS,OARRAY) B9900045 WKPOS=WKPOS+1 B9900046 IPOS=IPOS+1 B9900047 30 CONTINUE B9900048C RETURN B9900049 RETURN B9900050 END B9900051 SUBROUTINE PGSLST C0100001 1 /C01 F CCS CCS 3.0 SL-149C0100002C C0100003C CYBERCREDIT SYSTEM VERSION 3 C0100004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0100005C COPYRIGHT CONTROL DATA CORPORATION, 1979 C0100006C C0100007C PRINTS THE VALID DATA NAME LIST C0100008C C0100009 COMMON /CBLK1/UTIFIL,DELQM,RPTTBL,RPTPGM,RPTWKE,UTIRQB,DLQRQB, C0100010 2TBLRQB,PGMRQB,WKERQB,OPBUF,Q2SAVE,Q3SORT,Q4LVLB,Q5SLCT,Q6NAME, C0100011 3Q6TOT,Q6EPOS,Q7RPT,Q5ANS,TBL,HPGMN,UTREC,PGMKEY,TBLKEY,BIN,ISTAT, C0100012 4HPKEY,RADDR,TBLREC,OPHLD,D1TYPE,D1LNG,LRPGWK,IHOLD2,PGMREC,IND, C0100013 5PRCREC,ERRMSG,UTEMSG,ABTMSG,XYN,TC,CS,PRCWRK,PRCRQB,LU C0100014 COMMON /CBLK1/ IMAXC,NLKEY,NNAME,NSKEY,NSLCT,NTFLDS,RPTWKP,WKPRQB C0100015C C0100016C FILE RETRIEVAL C0100017 INTEGER UTIFIL(15),DELQM(15),RPTTBL(15),RPTPGM(15),RPTWKE(15), C0100018 2 UTIRQB(24),DLQRQB(24),TBLRQB(24),PGMRQB(24),WKERQB(24), C0100019 3 PRCWRK(15),PRCRQB(24),RPTWKP(15),WKPRQB(24) C0100020C C0100021C OPERATOR RESPONSES C0100022 INTEGER OPBUF(32),Q2SAVE,Q3SORT(60),Q4LVLB(9),Q5SLCT(170), C0100023 2 Q6NAME(51),Q6TOT(77),Q6EPOS(102),Q7RPT(15),Q5ANS C0100024C C0100025C MISCELLANEOUS C0100026 INTEGER XYN,TC,CS(2),TBL(4),HPGMN(3),RPTG(2),UTREC(42),ISTAT, C0100027 2 ZERO,PGMKEY(3),TBLKEY(3),COMMA,BIN,HPKEY(3),RADDR,TBLREC(42), C0100028 3 OPHLD,D1TYPE,D1LNG(2),LRPGWK(42),IHOLD2(2),PGMREC(42),IND(3), C0100029 4 PRCREC(42),ERRMSG(23),UTEMSG(26),ABTMSG(7) C0100030C C0100031 INTEGER HDR1(2),HDR2(2),HDR3(2),HEAD1(66),HEAD2(66),HEAD3(66), C0100032 2 LISTH1(66),LISTH2(55),LISTH3(55),PGCNT,ITEMP(8), C0100033 3 IBUF(66) C0100034C C0100035 DATA LISTH1 /'PGGEN ',21*$2020,'REPORT GENERATOR DATA NAME LIST ',C0100036 2 26*$2020/ C0100037 DATA LISTH2 /3*$2020,'STARTING',4*$2020,'DATA EDIT DEC ', C0100038 2 21*$2020,'SUB SUB SUB SUB SUB'/ C0100039 DATA LISTH3/' NAME POSITION LENGTH TYPE CODE POS ',5*$2020, C0100040 2'DESCRIPTION ',9*$2020,' NAME1 NAME2 NAME3 NAME4 NAME5'/ C0100041 DATA HDR1/'HDR1'/,HDR2/'HDR2'/,HDR3/'HDR3'/ C0100042 DATA HEAD1/$0C, 54*$2020,'PAGE 01',7*$2020/,HEAD2/52*$2020, C0100043__ 2 ZERO,PGMKEY(3),TBLKEY(3),COMMA,BIN,HPKEY(3),RADDR,TBLREC(42), C0100028 3 OPHLD,D1TYPE,D1LNG(2),LRPGWK(42),IHOLD2(2),PGMREC(42),IND(3), C0100029 4 PRCREC(42),ERRMSG(23),UTEMSG(26),ABTMSG(7) C0100030C C0100031 INTEGER HDR1(2),HDR2(2),HDR3(2),HEAD1(66),HEAD2(66),HEAD3(66), C0100032 2 LISTH1(66),LISTH2(55),LISTH3(55),PGCNT,ITEMP(8), C0100033 3 IBUF(66) C0100034C C0100035 DATA LISTH1 /'PGGEN ',21*$2020,'REPORT GENERATOR DATA NAME LIST ',C0100036<p X{"UB.REDU LIBRARY x042882< PREDU @Pn@P_@Pd@Pf@Ph 4@P3 REDUCE FILE. @PA FILE: XXXXXXXX:XXXXXXXX:XXXXXXXX REDUCED @P  @PnhT[T\]^T_`3abTc.TdTe 'T@P e_fȒh  h T.g22 " lT2TeThAih\@PihAjh\khAlh\_`AmbTTPREDU PQ8STP PGMINTrPGMIN vWTREAD|GTREDUZERO OPENFLFMERR INTGR SHRINKCLOSFLCCSMVAPGMOUTPREDU PQGTREDU RETREIVE PARAMETERS FROM ONE INPUT LINE. @P@PbZMP@Ph@Pl@Pp @P,,,,,,,,,@P4 < FILE NAME >,,, ,@PrTbTcd4edfg \cdhij Țh T h@P\l5l h hhTmkh hT5lh{Ȳ hy\65lȩh\@Pmkh hf\5lhbș h`\65plȏ d \lplodn\m@Pkl h>\5lh: h8Ts65ql d  h&\5qll\mk@Pl͜ h\5ch h\65c̻ l@P8HTThhhhh\\h h\h"PGTREDU:PQ8PKUP@Q8PREP=SCAN CCSMVAWTREAD{PGMOUTMIN0 P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP P3INTGR B65 F CCS CCS 3.0 SL-149@P hlh !ThT(l @P"H TTh\h\hPINTGR %PQ8QI2FQ8PKUP+Q8PREP(CCSGETP PZERO @P h7 n@P H TT h\hPZERO PQ8PKUPQ8PREPP PSHRINK @P@Pv@Pz@Pn NOT REDUCED @Pa NOT SEQUENTIAL@P|Taeu !> Tvwfxy\vwnzy.Tu !@P ! llT{Tuȷ 4 @PTuvHTThhhh h\hh h h\hPSHRINKPQ8PKUPQ8PREPGETFCB}WTREADCLOSFLZERO REDUCEFMERR P PFMERR FM FILE ERROR REPORTER W/WO PAUSE SL-***@P@Pl %@Pq@Ps7L@Pg@P FILE MANAGER ERROR: FILE=XXXXXXXX,XXXXXXXX REQUEST= , ISTAT =$ . @P(FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PSTS UPDRECDELRECCOMFILVOLUSEREDUCE $ @Ph PAUSE @PwTlml\nlolT%\eh ! < ( h\(rsts@P\dstsTgur  \ghlgvr  T@PHTThh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVAxCCSHXAWTREADPGMOUTP *T __l %@Pq@Ps7L@Pg@P FILE MANAGER ERROR: FILE=XXXXXXXX,XXXXXXXX REQUEST= , ISTAT =$ . @P(FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PSTS UPDRECDELRECCOMFILVOLUSEREDUCE $ @Ph PAUSE <t.` Y~:B.LIST LIBRARY x042882< P.LIST LIST FILE - TO PRINTER OR SCREEN- HEX,ASCII @P@P@P LIST@P*hT T  T TTTPLIST PQ8STP -PGMINTPGMIN WTREADLISTIT)QUIT +PLIST P?bLISTIT @P@PU@PX $ @P^@Pa@PcP@Pf 1 0  %"F@P RECORD LENGTH EXCEEDS 3000 BYTES @P>FILE@P@ NOT FOUND@PE PAUSE(LF TO PRINT)@PpT10=Q>TQTTSTTT=UVW d<Ⱦ "CȽ@P"CTY\Z[ hT\^_hȤ 7 #ȧ șhT`Ȟ {ȍ@P 4Ȗ 0T0l]h d\ Pb10h\@Pc (l l P! '0h\@Pb dd de\T]d1T=UFfUQWWE  Tgh\i@P%Y\gj l1TT1d\=UVW d0<TTT>kT '\@PP@lmnTo\HPLISTIT]PPGMIN qGTLISTwLSTAPE}OPENITMAKEIDWTREAD OUT WICNVRTCCSGETGETRECBINDISMPWRIXBINPRN-BLSTAL@PQUIT BCCSMVADP PGTLIST RETREIVE PARAMETERS FROM ONE INPUT LINE. @P@PbZMP@Ph@Pl@Pp @P,,,,,,,,,@P4 < FILE NAME >,,,,<(P)RINT> SSS @P_ @PsTbTcd4edfg \cdhij șh T h@P\lcl h hhTmkh hTclhȰ h\dclȦ@Ph\mkh h\clhȔ h\dcplȉ d \lplod@Pn\mkl hf\clhb h`Ttdcql d  hN\cqll@P\mkl͜ h<\crh8 h6\dcr̻ l,̷lTmkl hTc@PJh̨ h\dci̞ d \[i@PfHTThThnhyhh\\h h hh\hhPGTLISThPQ8PKUPnQ8PREPkSCAN =CCSMVAWTREAD|PGMOUTMIN0 GP PBINDIS @P@P5 @P:P|;L5@P, RECORD  @PCT1T56\,7Z Ah hT: hOT)T);<;T= >\=@Pn? ( h6\)\)6@A@ hȸ)h\@P) ( h \);;ȧh ( :h\@P66ؙȗ '\: @Pؖ 1\:HTT h\h\h}PBINDISPQ8PKUPQ8PREPHEXDECDOUT HCCSBLKUHEXASC\CCSMVA`CCSPUThP PBINPRN @P@PS@PV  @P]*@PIRECORD XXXX@PR@Pb ( h ( h hTMhTIWXWTYZ^ Ah hT ]\\@PO\O^X^T_G\_HȽ h?TO\OTSUS hȢ!0بȧ,h\@POȥ ( h"\O^^ȕh (G h\@PTT\[ &`@P dahT@Pf B1T}W]ݜ !HTT h\h\haQPBINPRNPQ8PKUPQ8PREPVDC HEXASCoCCSMVAuMPWRIXCCSBLKCCSPUTHEXDECP P?BLSTAL @P@P``@PeNO$/ 60 @Pt @P5PRINT? (Y/N) @P=NOT A BASIC FILE@PE1 LIST OF BASIC FILE: ???????? / ???????? / ????????@P0uk f 0(d (lTb5chTbfd Hh  T@PhEih\1hEjh\7hEkhTlEm\lnoT h0h  1 @PhȤ!T1psTsȉ \tsؐ\b=cTHPBLSTALPDSPLA INPUT CCSMVAMPWRIXGETRECGETLINOUT QUIT P PGETLIN @Pd@P @P TTT hPOOhT@PlF   l 1@ (h99h h6T@P/a+l)lT  T h\aȳ Ȱ  h@PZ\a@PbHTT h\h\hhhhhh h\hhˀPGETLINdPQ8PKUPjQ8PREPgCCSBLKHEXDECCCSMVA-CCSGET;CCSPUTFP P?OPENIT @P@P" @P%`@P????????@P) lrT"1"\""\1"7"Z\"7"Tȯ @PTeTȩ ]Th !S hȺhT h\ȊhT&@P00lT3\0țHl\1"7"d8;@P d(\(  *\d$ 1 1HTThihh hk@Phh hxh~\h\hSPOPENITPQ8PKUPQ8PREPHASH ^CCSMVA,SEKVITMGETVITVFDWADDlMMREAD|CNV2W P P?iGETREC @P@P _@P0@P0@P@P O 1T1 "T &T hT3\ $܈h@P7  1! ,Ę h\hȿ h\ \ ȶ A h@P] HTThPGETREC_PQ8PKUPeQ8PREPbFDWSUBQUIT FILL  CCSMVA&P P?=FILL @P@P@@P0 "T `hT10;' # TT @P(,l l@P/ H TTh\hPFILL 1PQ8PKUP7Q8PREP4QUIT MMREADFDWSUBFDWADD!P P?sOUT @P@P @P @P PAUSE @P0< !T=  1 \=   l Ah hژ<؈ hT@P;nЀ@PATh h  1h\=  \=  HTT h @Plhh\hhPOUT bPQ8PKUPhQ8PREPeVDC 9WTREADLASTCHBP PQUIT @P @PTTHPQUIT PWTREADPGMOUTP P?EMAKEID @P@P$/@P LIST @P T1\T 1\ \ \7 H @P8TThhhhhhPMAKEID6PQ8PKUPl@PBHTTh\h\h\h\hPLUREADDPQ8PKUPJQ8PREPGFREAD DISPAT&FDWADD-P P-MTBLEN @PTh !h\h h\h h \h h\ll@P! HTThPMTBLEN#PQ8PKUP)Q8PREP&MEMORYP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP PBBLKSIO BUFFERED WTREAD INTERFACE SUMMARY-***@P$$SYSA $ SYSVOL @P+@P/ h  T/ h Xx hs h hn Xm Xh@PZh X^ X}w 2 1Tr 2 1Nn !Jh d ȶ 3XH>ZH:@P  Ȣ h Ph'I#Bȑ?h ! PhX h5h -@Py1 Hh hT # h T @P h l X X h? h>X? "  2 2  " P"@P  hh# 2 PhT80/ !h !@P1 X Xl X XlzPCLRLINOCLRSCRDDISPOS0DSPLA ^FLUSH 4INPLEN1INPUT TERMCH9PWTREADOPENFLCLOSFLP P3LASTCH @P @P h  1 h! hT @P! h H TTh\hPLASTCH'PQ8PKUP-Q8PREP*CCSGETP PHASH HASH FILE NAME + OWNER NAME INTO FDD @Pd@Pg`@Pi hH_h_h]h[hZhWhh hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHEXDECcPQ8PKUPkQ8PREPhP P4SEKVIT SEARCH FOR VIT MATCH TO VOLUME NAME @P H-h,TTh'\h&\h%h# L `: ` " v  l@P+`PSEKVITPQ8PKUPQ8PREPP P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P PGMMREAD MASS MEMORY READ FUNCTION @P hhh'h hTdT`DhҀ@P2HTTh\h\h h\h؀PMMREAD5PQ8PKUP;Q8PREP8FREAD DISPAT&P P9SCAN SCAN - SCAN STRING TO SEPERATOR @P % l@P ThT#  ! lhހ@P%HTTh\h\hh\hPSCAN (PQ8PKUP.Q8PREP+RAO CCSGETP PICNVRT @P-09 ,.+-@P4@P@P@P@ lhh h T= u@PY "\=hǘ 6Ҙ 2h̘ hƘ ȼh ȷhȺ@P Ȳhȴ ȭh (hh (,hh"! ( @P=-h $l d;>dWd< dldH@PTThlh~\hhhz\hm\hihOPICNVRTPQ8PKUPQ8PREPCCSGETLP P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION @Phh Hhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P PHMPWRXX UNIT RECORD FUNCTION PROCESSOR SUMMARY-***@P h  h  h  ɀhHhh H hT+@@@P+@ h ɀhHhhhhPMPWRIX MPREDXMPWRIUMPREDUMPMOTN3P  PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P P%GETVIT DECK-ID B11 ITOS 2.0 SUMMARY-CHI@P H"!hh 6" # l o" "n`PGETVITP P MEMORY @PHPMEMORYP PISHIFT @PH"h"hC PISHIFTP  PMOD @PH"h"h <PMOD P P RAO @PH""PRAO P __HPMEMORYP PISHIFT @PH"h"hC PISHIFTP <\D ~:nB.CAT6 LIBRARY x042882< PCAT6 @P@P(@PTAPE@P@P5@P 1 & TAPE P@P@PFILENAME OWNER FILE RECORD RECORD MAX. STAT FCB START SECTOR FCBIND CREATE E@P/XPIRE K1 K2 K3 @PCK4 @PF TYPE LENGTH COUNT RECORD ALGN INDEX SECTOR COUNT  DATE @PqDATE LEN POS LEN POS LEN POS LEN@P POS @P CATALOG-UTIL DUMP TAPE 99/99/99 @P NOT MASTER CONSOLE@PTThhTTTȟ  \@P"ȓ Tȵdȳd hTh hTh\h\h\@PMFh\hTh\lTr\\d@Pxdd\rd\lPCAT6 PPGMIN DATTIMCCSMVAHEXDECWTREADPGMOUT,MPMOTN6MPWRIX=MPREDUWFMTFCBgPCAT6 PFMTFCB GENERATE STATUS RECORD @P@P@P @EDCL OPN Y $  $@P. 0 @P S R A D C B O@P@P @P @P@P@P1T hhT@P>n݄h\@PGn 1 hʫl%  ȧl ȹ șlȗl @Pr T"dTTTT\\\ \@P #d$ %l\&&&'l( )l*l lT@P\ d\l\  l\ dwd\\rl@P\+lt\  T<lj\lh\lf \d\d\dTv,@P&, 0d- dGlTB  T.h<dRn$4l\3hT@PI'/0n l l 1@P9^@P@@PC`@PI@PP@PW @Pa@PsnHkTTh\ h h h h h h h h h h h 6h hs ht@P hu h] h] h] h\ h hh h h h h h h h h @Ph h h h h$ h h h h?PPFMTFCBuPQ8PKUP{Q8PREPxVDC CCSBLK2CCSMVAVLTOI +CHO2LRFCNV2W CONVERFRHX ISHIFT1P P2CHO2LR DECK-ID B51 ITOS 1.2 SUMMARY-126@P H*h)`h'h!h  Qhl ` h h @P+PCHO2LRP P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION @PhhHhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P PlCONVER DECK-ID C10 ITOS 1.1 SUMMARY-122@P1B@'d @P h h h (hT@P#  1  (hT@P7 0n    h@PI n 1  0l@PXHTThhhh\ h hPCONVERZPQ8PKUP`Q8PREP]FDWSUB FDWADD4P P#FRHX DECK-ID B53 ITOS 1.2 SUMMARY-126@P Hh`hDhBh 0 q c H A`PFRHX P PHEXDEC BINARY TO DECIMAL CHARACTER CONVERSION @P@P'@P@Pd@P @P ~!dhTdhh\dhh\dh՘h\ dh̘h@P7p8 0hp8 0hp8 0hp8 0hp8 0hȱ  hȭ  hȩ  hȦ@Pb  h h$ " -hT hdRl\ hdRl\ h  dRl@PHTTh\h h hjPHEXDECPQ8PKUPQ8PREPMOD ISHIFTnP P5VLTOI DECK-ID B61 ITOS 1.2 SUMMARY-126@P H/h.`h,h'Dh*h((`B 9H!  0 nH DQ S  0n `'@P+d PVLTOI P P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P PHMPWRXX UNIT RECORD FUNCTION PROCESSOR SUMMARY-***@P h  h  h  ɀhHhh H hT+@@@P+@ h ɀhHhhhhPMPWRIX MPREDXMPWRIUMPREDUMPMOTN3P PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P PISHIFT @PH"h"hC PISHIFTP PMOD @PH"h"h <PMOD P  P&iMPFACE OUTPUT INTERFACE @P ,*ILYPN@P@P h05 Th9 !4 T P? !'hlTl@P5'\\ #  #\ @POȰHTTh\hhh h h h\hhPMPFACERPQ8PKUPXQ8PREPUMPWRIXCLRSCR DISPLA.P PuWTRD WTREAD INTERFACE @PX hh hT=T  h@P+X X:XjDhBhT8Xo X /6Ȉh}Ȉ@PV{h~hhT9c wh [YlX7 @PX! 1 OhF?X& Xlh=19116h h+&@P$h h ! hT^TX X@Pȟ h H !bhΐjTxXT@PX X\h! 1 Oh^! 1 hhX@P- X8XhBh@h?h 7h ' jT89@PX|hhy TN8 !h h hT`@P9X=! uyntXy+ !ijeͤ @P_nXdhHH T:>? h@@P  PAUSE @P8@P>Xo Xl)hyX` Xw= lhtoȠ lb@Piel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP P MEMORY @PHPMEMORYP __iel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT h<D' uJwB.CAT17 LIBRARY x042882< PCAT17 @P@P(@PTAPE@P5@P 1 &  TAPE P@P@PFILENAME OWNER FILE RECORD RECORD MAX. STAT FCB START SECTOR FCBIND CREATE E@P/XPIRE K1 K2 K3 @PCK4 @PF TYPE LENGTH COUNT RECORD ALGN INDEX SECTOR COUNT  DATE @PqDATE LEN POS LEN POS LEN POS LEN@P POS @P CATALOG-UTIL DUMP TAPE 99/99/99 @P NOT MASTER CONSOLE@PTThhTTTȟ  \@P"ȓ Tȵdȳd hTh hTh\h\h\@PMFh\hTh\lTr\\d@Pxdd\rd\lPCAT17 PPGMIN DATTIMCCSMVAHEXDECWTREADPGMOUT,MPMOTN6MPWRIX=MPREDUWFMTFCBgPCAT17 PFMTFCB GENERATE STATUS RECORD @P@P@P @EDCL OPN Y $  $@P. 0 @P S R A D C B O@P@P @P @P@P@P1T hhT@P>n݄h\@PGn 1 hʫl%  ȧl ȹ șlȗl @Pr T"dTTTT\\\ \@P #d$ %l\&&&'l( )l*l lT@P\ d\l\  l\ dwd\\rl@P\+lt\  T<lj\lh\lf \d\d\dTv,@P&, 0d- dGlTB  T.h<dRn$4l\3hT@PI'/0n l l 1@P9^@P@@PC`@PI@PP@PW @Pa@PsnHkTTh\ h h h h h h h h h h h 6h hs ht@P hu h] h] h] h\ h hh h h h h h h h h @Ph h h h h$ h h h h?PPFMTFCBuPQ8PKUP{Q8PREPxVDC CCSBLK2CCSMVAVLTOI +CHO2LRFCNV2W CONVERFRHX ISHIFT1P P2CHO2LR DECK-ID B51 ITOS 1.2 SUMMARY-126@P H*h)`h'h!h  Qhl ` h h @P+PCHO2LRP P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION @PhhHhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P PlCONVER DECK-ID C10 ITOS 1.1 SUMMARY-122@P1B@'d @P h h h (hT@P#  1  (hT@P7 0n    h@PI n 1  0l@PXHTThhhh\ h hPCONVERZPQ8PKUP`Q8PREP]FDWSUB FDWADD4P P#FRHX DECK-ID B53 ITOS 1.2 SUMMARY-126@P Hh`hDhBh 0 q c H A`PFRHX P  PwHEXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P @P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHEXDECcPQ8PKUPkQ8PREPhP P5VLTOI DECK-ID B61 ITOS 1.2 SUMMARY-126@P H/h.`h,h'Dh*h((`B 9H!  0 nH DQ S  0n `'@P+d PVLTOI P P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P PHMPWRXX UNIT RECORD FUNCTION PROCESSOR SUMMARY-***@P h  h  h  ɀhHhh H hT+@@@P+@ h ɀhHhhhhPMPWRIX MPREDXMPWRIUMPREDUMPMOTN3P  PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P PISHIFT @PH"h"hC PISHIFTP PMOD @PH"h"h <PMOD P P&iMPFACE OUTPUT INTERFACE @P ,*ILYPN@P@P h05 Th9 !4 T P? !'hlTl@P5'\\ #  #\ @POȰHTTh\hhh h h h\hhPMPFACERPQ8PKUPXQ8PREPUMPWRIXCLRSCR DISPLA.P PuWTRD WTREAD INTERFACE @PX hh hT=T  h@P+X X:XjDhBhT8Xo X /6Ȉh}Ȉ@PV{h~hhT9c wh [YlX7 @PX! 1 OhF?X& Xlh=19116h h+&@P$h h ! hT^TX X@Pȟ h H !bhΐjTxXT@PX X\h! 1 Oh^! 1 hhX@P- X8XhBh@h?h 7h ' jT89@PX|hhy TN8 !h h hT`@P9X=! uyntXy+ !ijeͤ @P_nXdhHH T:>? h@@P  PAUSE @P8@P>Xo Xl)hyX` Xw= lhtoȠ lb@Piel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP P MEMORY @PHPMEMORYP __iel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP P MEMORY <_ kuB.BATS LIBRARY x999999051782< P>BATS @P@P=8@P=< @P=@<@P=C JP@P=Gd @P=OG *8@P=W@P=Y@P$$HOST $$ SYSVOL @P$$BATCH $$ SYSVOL @P< @P< NOT SENT SENDING SENT RECEIVED PRINT REQ ABORTED DISC PEND DISC-@P=*SENT@P=, NO ACTIVE JOBS@P=4@P=5@P=6@P=YhT=7T<=8T< "T<$ "T<\<=8\<@P= "\< "\<T<=9=9=9 h h (d h@P= (hT@P==?h  d=:=; $=@=?d=BT=C=D<=E ,hT@P==<<=<=F=F T=5< $=GlT<\<=D=H<=H=H $=A=J<=K=J   4\=6=L<\=4=K<\=6=M<T<=N\=N==,\<<\<< ,hT@P>:<<\<=K<=O=K $=BhT@P>Ld< ,h\@P>Ud< ,h\@P>^d< ,h\@P>gd<̑ W !S ,ҀhT@P>y<\<=P<=R=P 1* !& ,h\@P><\<=P<=S=P ,h ,hT>8@P><\<=K<=O =KT<@P=>@P>=? < 2=@P=>@P>=; 2==: T=I=T=,=U=T=V@P=Z>@P>T@P=n>@P>T=W\@P=y>@P>\=X\@P=>@P>\=W\@P=>@P>\=X\T@P=>@P=>PBATS PQ8STP >GET4 =VDC >JPGMINT=]ZERO =aOPENFL=eGETS =pCLOSFL={PGMIN =CCSMVA>{CCSCST=CCSPUT=DIG3 =CCSGET>PDATTIM>&HEXDEC>)TIMDIF>DANDT >wDSP >WTREAD>PGMOUT>SYSMSG>PBATS P)GET4 @P AhTh ( Dh@P H TTh\hPGET4 PQ8PKUP#Q8PREP CCSGET P PDSP @P@PX!@Pd,P @P BATCH STATUS ??/??/?? ????:?? @P) JOB STATUS FILE REQUESTED SENT RECEIVED TIME USED @PQ PAUSE @PU@Pg 1ATTXYXT\Z[Z\Z\Z\Z]ZT@P \\^_^\ \Z`Z hȩ h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHEXDECcPQ8PKUPkQ8PREPhP P3LASTCH @P @P h  1 h! hT @P! h H TTh\hPLASTCH'PQ8PKUP-Q8PREP*CCSGETP PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO PQ8PKUPQ8PREPP PMOD @PH"h"h <PMOD P P MEMORY @PHPMEMORYP PISHIFT @PH"h"hC PISHIFTP __RO <$! ~kB.SQUISHLIBRARY x042882< PSQUISH COMPRESS 50MB SMD FILE MANAGER AREA @P@PPROVE @PTTTTTTPSQUISHPQ8STP SQINITMRKHDRDHOLE SQUIRM CHAIN PSQUISH P!nSQINIT INITIALIZE SQUISH @P@P @P @P @PNO$OK@P@P50MB SMD HOLE COMPRESSOR @PENTER MMUNIT NUMBER:@PI T O S NOT DISABLED@P$INVALID MMUNIT NUMBER @P/???????? DISMOUNT PERMISSION (OK): @PA???????? VERIFY (OK): @PLNOT MASTER CONSOLE@PUTOO MANY FILES FOR PROGRAM STRUCTURE@PgERROR VOLUSE $????@PpNON-NUMERIC @Pv VOLUME DISMOUNTED@PSPOOLER IS ENABLED@PBATCH IS ENABLED@PCOMM18 IS ENABLED @P `h V0(dTTTT\\\ \ L\@PTȻ \\\Ȱ \\\ȥ \\\Ț \@P$\\ȒdT1 hT0l %Tp !T h\_@P0Od\0d # &\$ŀ@P` h\_d\d0 d !J dh\_hT_f. 1 d@P\/TTT0l hT_ +Tn\g\@P\\v̮0Ld̦ hTI_l̟ h\_d0T0d0 l̜h\@Pf@ܓ 1̡lT,A\̭0\  V'\U\\@P HPSQINIT PVPC }WTREADQUIET LMARGNDISPLAPGMOUTPROMPTICNVRT5ERROR @MEMORYZERO VOLUSEHEXASCMMREADP P!nMRKHDR PASS 1 - MARK FILE HEADER SECTORS @P @P MARKING HEADERS @PDONE - NO HOLES FOUND @P@PT \3T3d \\T0 dhddT3@PHʔ 1j\3.l hȼ 1]0- G000 !?001 % @Ps30ȟ0h 0ț0hT@P@Pȑ00h\@Pnl0d{0d|0d}00h;T@Pnd\00l !H`PMRKHDRPDISPLAMMREAD%PGMOUT7FDWADDCFDWSUBMMWRITP P!nDHOLE MOVE FILES DOWN @P@PR@PT@PY@P MOVING ???????? ????????@PB@ @ @P0[ 00$d ,d h0p2 )0?5 ">@P0ܔ4 \.302. dS0n3nnn lΣ  l0%hT@Pf0)h\@P f 1TTRURV0}D dWY dX`AmT@P8d3\{0l\0.lod@pl0d: dZ !< + 1@Pc3$0ll1Tt:.l d1d2 cl\:0.lT;\;@PT@;@=l\0.ld\0\133\.o.03\0o3 0W@P`XAmT40.d03\3{l\10l l "08.d@P/d0 dd03\3l@P`@P@P @ HH^PDHOLE PVPC MMREADkFDWADDCHKHDRWTREADMMWRITFDWSUBP P!n%CHKHDR VALIDATE HEADER SECTOR @PAL .&*@P@PSECT: ????, ???? NO AL IN HEADER@PSECT: ????, ???? BAD HEADER ADDRESS POINTER 1 @P+SECT: ????, ???? BAD HEADER ADDRESS POINTER 2 @PBSECT: ????, ???? BAD HEADER FCB INDEX @PUSECT: ????, ???? HEADER SELF ADDRESS WRONG@PjSECT: ????, ???? FCB DOES NOT ADDRESS FILE@PT d0dT109 \M %\+F %\@PB> 5\B5 \U-- \UT00d0 T@P̱ \j̬ \j@P/H,TThhhhhhhhh h\h|hhhhhhhh h h h h@P h`PCHKHDRPQ8PKUPQ8PREPBADHDRFDWADDMMREADFDWSUBP  PBADHDR BAD HEADER SECTOR MESSAGE, ABORT @P@P, P@P2@PHEADER SECTOR CONTENTS @P4T\T\,-\.T/ h( h\0Ts\s*\*@P_313 1\/\,-T@PuHTTh h\h\h h h\hPBADHDRuPHFLOT VQ8PKUP{Q8PREPxHEXASC5DISPLADISPLADCCSMVAKHEXASCXPGMOUTbP P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PbHEXASC HEX TO ASCII CONVERSION @P@P @P0123456789ABCDEF@PTh3 h\h, hh\@P+h!dRl\h hݨ hрh\@PDhdRl@PPHTThhh\h hPHEXASCRPQ8PKUPXQ8PREPUISHIFTP PGMMREAD MASS MEMORY READ FUNCTION @P hhh'h hTdT`DhҀ@P2HTTh\h\h h\h؀PMMREAD5PQ8PKUP;Q8PREP8FREAD DISPAT&P PGMMWRIT MASS MEMORY WRITE FUNCTION @P hhh'h hTdT`DhҀ@P2HTTh\h\h h\h؀PMMWRIT5PQ8PKUP;Q8PREP8FWRITEDISPAT&P PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P PZQUIET INDICATORS FOR ENVIRONMENT @P $$  l=T l2 l- l(ܘ l# dRl@P4h dRlh dRl@PN HTThPQUIET PPQ8PKUPVQ8PREPSTSNABL5AUTON APGMIN P  PVPC VALIDATE TWO PRINTABLE CHARACTERS @P H" 2 1 `h"Ƞ 2 1 `ȸPVPC P PuWTRD WTREAD INTERFACE @PX hh hT=T  h@P+X X:XjDhBhT8Xo X /6Ȉh}Ȉ@PV{h~hhT9c wh [YlX7 @PX! 1 OhF?X& Xlh=19116h h+&@P$h h ! hT^TX X@Pȟ h H !bhΐjTxXT@PX X\h! 1 Oh^! 1 hhX@P- X8XhBh@h?h 7h ' jT89@PX|hhy TN8 !h h hT`@P9X=! uyntXy+ !ijeͤ @P_nXdhHH T:>? h@@P  PAUSE @P8@P>Xo Xl)hyX` Xw= lhtoȠ lb@Piel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P P MEMORY @PHPMEMORYP PICNVRT @P-09 ,.+-@P4@P@P@P@ lhh h T= u@PY "\=hǘ 6Ҙ 2h̘ hƘ ȼh ȷhȺ@P Ȳhȴ ȭh (hh (,hh"! ( @P=-h $l d;>dWd< dldH@PTThlh~\hhhz\hm\hihOPICNVRTPQ8PKUPQ8PREPCCSGETLP PISHIFT @PH"h"hC PISHIFTP P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO PQ8PKUPQ8PREPP __=-h $l d;>dWd< dldH@PTThlh~\hhhz\hm\hihOPICNVRTPQ8PKUPQ8PREPCCSGETLP PISHIFT @PH"h"hC PISHIFTP P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO <q {"fB.DDT LIBRARY x999999063082< PYDDT @PhPHQ`P+O@PPL `PP+ @PP4 `PP_`PPr`PPv`PPz@PQ@PQ"  {   ,    n  DDT 1.0 (10/11/78) ILLEGAL COMM@PQMAND ILLEGAL SYNTAXILLEGAL HEX INPUT ADDRESS OUT OF PROGRAM RANGESYMBOL TABLE F@PQxULL SYMBOL NOT FOUNDPROGRAM TOO LARGE PROGRAM NOT FOUND SWITCH ON SWITCH OFF@PQPAUSE PLEASE PTR PROBLEMS TO M.L. PETTITT X6384 LJLOPS X:phSh @PQ}h zhT#h'hp hQ hO XFOXX^ h)&h#@PQh  h3 h/ h -X$;4h5h$T XX[ + 9@PR$"$XAX ( $ $ 2  X $ 2   @PROX XX   XPXhX   X=X:d@PRzXlH- ` g"  `X X X X  d4 X  f"X ߆"f" XC@PR  XH5h3 XXDX&%hrBX" 7X / @PR' " $ YwXHK `QH " c q @PRH0XA hkhjhi X X XX"XfX  jVX RjP X@PS& XP H h 2Xt h hXh  @PSQjH"XXXX   ! AX hH""HX"X @PS| XX hh H Q1=e"d43 @PSXP PX!OXX} AX QX IX 1X 2X 3X 4X OX 0X_X{@PSX zXX^X] XO =XLpi`dcb`^\@PShRHQhOMKIG  hH WjY B h@PT(H JjD B  XX AhX %X$ f"@PTSbbbXf"bbb  ""@PT~  XtXXhX X X XX"X "X"X@PT H\h]" "SLhThh;xhLh Vh CTC h7@PTxthV+RP"a( H " jTL ; h: h6@PTXD h2 h.XIX% XXX;h hX2hX.h"@PU* H h hXXŘXXX X"X X@PUUa "  hX<  !X hC < !@PU h7 hX X o@hk@hH"X XXX@PU  " ^!  X+( X:gX7  XXDXXQX@PUl6X3"" f")"XXXXXX}" XX?X=X;XNX@PVlXXFpXeXX?hXrX9hXlXX0h @PV,$f" hXhDXOXXhXEXX hX;K"h@PVWh%f"#bQQ"hhf"bhhTRXgTX@PVz hX&|Fzf"xbvFtf"rb`XHXh]X?[X@PVhTQX +XxKX =XqCBX Xu:X -Xa4X =XZ,@PV+X~XpXU"Xoh+h4hUIh&hXSh"h,hKhRh$Jh! @PWhAhA h=M" ` g" T." )ThbӠ@PW.4 &PX< ThTX XhX@PWYhXXhX&X ! ("f"@PW~zhzwt?r" hn"lf" hg\ h@PWXIX XTX'fX8D6`h h5h THD` U"@PWژ q_1hf 1(hTHD@PX{XcXBhhhX hmhkX.hfXX%@PX0"H^;X"XX X"XX X`X ;X6Xf"@PX[  H   X hX " @PX `oX hXXX?XP X. @PXX, X* X( X& X$ X" X gX1 0XfXl XX ( 6jz$"@PXL XmXsXO XXXej_ Xh (X4 X1 )X.X4@PYPCMDTBLQ"PWTREADTSYSMSGWHPGMOUTWPGMINTVxPGMIN QOPENFLWGETS WCLOSFLWAP *T 00080*K,I8 00090*N,DDT,,,B 00100*Z 00110*CTO, INSTALLATION IS COMPLETE. 00120*CTO, THE PACKAGE IS CALLED DDT. 00130*Z 00140*END PYDDT @PhPHQ`P+O@PPL `PP+ @PP4 `PP_`PPr`PPv`PPz@PQ@PQ"  {   ,    n  DDT 1.0 (10/11/78) ILLEGAL COMM@PQMAND ILLEGAL SYNTAXILLEGAL HEX INPUT ADDRESS OUT OF PROGRAM RANGESYMBOL TABLE F@PQxULL SYMBOL NOT FOUNDPROGRAM TOO LARGE PROGRAM NOT FOUND SWITCH ON SWITCH OFF@PQPAUSE PLEASE PTR PROBLEMS TO M.L. PETTITT X6384 LJLOPS X:phSh @PQ}h zhT#h'hp hQ hO XFOXX^ h)&h#@PQh  h3 h/ h -X$;4h5h$T XX[ + 9@PR$"$XAX ( $ $ 2  X $ 2   @PROX XX   XPXhX   X=X:d@PRzXlH- ` g"  `X X X X  d4 X  f"X ߆"f" XC@PR  XH5h3 XXDX&%hrBX" 7X / @PR' " $ YwXHK `QH " c q @PRH0XA hkhjhi X X XX"XfX  jVX RjP X@PS& XP H h 2Xt h hXh  @PSQjH"XXXX   ! AX hH""HX"X @PS| XX hh H Q1=e"d43 @PSXP PX!OXX} AX QX IX 1X 2X 3X 4X OX 0X_X{@PSX zXX^X] XO =XLpi`dcb`^\@PShRHQhOMKIG  hH WjY B h@PT(H JjD B  XX AhX %X$ f"@PTSbbbXf"bbb  ""@PT~  XtXXhX X X XX"X "X"X@PT H\h]" "SLhThh;xhLh Vh CTC h7@PTxthV+RP"a( H " jTL ; h: h6@PTXD h2 h.XIX% XXX;h hX2hX.h"@PU* H h hXXŘXXX X"X X@PUUa "  hX<  !X hC < !@PU h7 hX X o@hk@hH"X XXX@PU  " ^!  X+( X:gX7  XXDXXQX@PUl6X3"" f")"XXXXXX}" XX?X=X;XNX@PVlXXFpXeXX?hXrX9hXlXX0h @PV,$f" hXhDXOXXhXEXX hX;K"h@PVWh%f"#bQQ"hhf"bhhTRXgTX@PVz hX&|Fzf"xbvFtf"rb`XHXh]X?[X@PVhTQX +XxKX =XqCBX Xu:X -Xa4X =XZ,@PV+X~XpXU"Xoh+h4hUIh&hXSh"h,hKhRh$Jh! @PWhAhA h=M" ` g" T." )ThbӠ@PW.4 &PX< ThTX XhX@PWYhXXhX&X ! ("f"@PW~zhzwt?r" hn"lf" hg\ h@PWXIX XTX'fX8D6`h h5h THD` U"@PWژ q_1hf 1(hTHD@PX{XcXBhhhX hmhkX.hfXX%@PX0"H^;X"XX X"XX X`X ;X6Xf"@PX[  H   X hX " @PX `oX hXXX?XP X. @PXX, X* X( X& X$ X" X gX1 0XfXl XX ( 6jz$"@PXL XmXsXO XXXej_ Xh (X4 X1 )X.X4@PYPCMDTBLQ"PWTREADTSYSMSGWHPGMOUTWPGMINTVxPGMIN QOPENFLWGETS WCLOSFLWAP __WhAhA h=M" ` g" T." )ThbӠ@PW.4 &PX< ThTX XhX@PWYhXXhX&X ! ("f"@PW~zhzwt?r" hn"lf" hg\ h@PWXIX XTX'fX8D6`h h5h THD` U"@PWژ q_1hf 1(hTHD@PX{XcXBhhhX hmhkX.hfXX%@PX0"H^;X"XX X"XX X`X ;X6Xf"@PX[  H   X hX " @PX `oX hXXX?XP X. @PXX, X* X( X& X$ X" X gX1 0XfXl XX ( 6jz$"@PXL XmXsXO XXXej_ Xh (X4 X1 )X.X4<< 6d&B.PASSW LIBRARY x999982081282< PPASSW @P@P AA@P @P @P  _@P &@PEX @P @P'HHHHHHHH@P PASSWORD = ########@P/$$PASSWD$$  @PV  @P @P+IIIIIIII@P @P$$$$NOTICE@P PAUSE @P ILLEGAL LOG-ON@P@P $$NOTICE CURRENTLY BEING UPDATED @PTT/Gب  (TGTT\@PT/VȮ 6\ȩd\/Vț #TVȕ@P= \ l\/V \V  T@Ph\'d\\+\@PT\   d\T4@PV̚ 3T/Vˤ\V%  @PTdTT\V   T/\T_@P @P @P \/\ ̝  d f. 1 dSddVdWTG@P8T/G̐ Y̊ !cT/X !T ? IX@PcB d KlTX  ̢l 1̜ hTVܝ 1@P l\ր@P\T/TTPPASSW PQ8STP PGMIN OPENFL9FILERRHXDEC CCSMVA1READR CCSCSTjWTREADGETS HCFORC PGMOUTCLOSFLCHAIN  PPASSW PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP  P%CFORC @PH"h"H`  g    g PCFORC PTSAREAP __wHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP <2 d B.TIME LIBRARY x999982081282< PTIME CCS 3.0 TIME CHECK @P;@P,@PMONDAY TUESDAY WEDNESDAY @PTHURSDAY FRIDAY SATURDAY @P&SUNDAY @P;hhhhhhhhhTT@Pf234578Tz h (hT@P~غ 1\-\.\+\/\0\1 hȨh\@Pآ 1T@P(/,5A2,X,A2,1H/,A2,1H/,A2,2X,I2,1H:,I2,1H:,I2,3X,3HID=,4A2) @PTTPTIME PQ8STP Q8QINInQ8QX |Q8QENDAYERTO h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hnPYMD1 PHFLOT 5Q8PKUPQ8PREPFLOAT @P *T __YMD1 @P@P @P @P@PW@P hVBœS  hO(hp8hڌI lH D#DlB> h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hnPYMD1 PHFLOT 5Q8PKUPQ8PREPFLOAT @P *T <Gr 3f-B.SPY LIBRARY x999982063082< PSPY @P\@PK@PY@P[2hhhhp8hhTFGTHIJTHKL@PMTRH@P(48HPORT USERID PROGRAM MESSAGE BUFFER  ) @P hhhh h"ș(hhT@h@ h\~d> h\~dR@PQ h\~dSdTp4AdU h\~dB uN dVیh\~h@PT~f 1 dW dX̷hj\~fh\@P n +1̳ 8TCCY̨ /TBCC '\CCYTZ.HT@PKU dZ h\@PV 1 dBh\@Pd 1TT~HK[MG P2@P @P(1X,I2,3X,4A2,2X,3A2,2X)@Pq@PTTPSPY PQ8STP Q8QINIEQ8QX KQ8QENDjTSUSERaNTSUSReTSPORT]LTSUSRiVDC PGMINTtPGMIN xWTREADlMEMORYCCSMVA+PFNDPGM6PGMOUTPSPY PJFNDPGM FIND PROGRAM FOR SECTOR ADDRESS @P hT  l"@P\  l h dhܜ  hn 1@P9H TTh\ h h̀PFNDPGM;PQ8PKUPAQ8PREP>NXTPGL P PNXTPGL RETURN NEXT PROGRAM IN LIBRARY @P@Pq@Ps @Pn`@Pc@Pt +d`dah [l !  dE@P hhTqnlcdT l hhT@Prm Z? <Ƚ ȿ ؼ 1 l̀hT@Pss l l̹ H TTh\hPNXTPGLPQ8PKUPQ8PREPFREAD DISP CCSGETCCSMVAP PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P P MEMORY @PHPMEMORYP __t +d`dah [l !  dE@P hhTqnlcdT l hhT@Prm Z? <Ƚ ȿ ؼ 1 l̀hT@Pss l l̹ H TTh\hPNXTPGLPQ8PKUPQ8PREPFREAD DISP CCSGETCCSMVAP PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P P MEMORY @PH<3+ Uj B.MOUN LIBRARY x999982111782< PdMOUN MOUNT DISK VOLUME FROM TERMINAL UTILITY @P@Pw@Pz )@P~@P/ # $@',.5<@P  @P, VOLUME = MM UNIT=@P6 XXXXXXXX MOUNTED ON DRIVE XX FROM TERMINAL XX, ID=XXXXXXXX @PY VOLUME XXXXXXXX NOT MOUNTED ISTAT=$XXXX @P# MOUNT UTILITY @P`hTrsTUtuvTtw#xy\tw,zw{y `\tw1z@Pw!y" T| T!}Ȯ  d! 3 #\| ! !@PT!Ȕ 1?Ȑ \ \\\T@P{Yz{To\oYTtwYy5Tvo\o~6~̚ 0 @P:dD\U{6{\{6{\tw6yv  \w6yTTPMOUN PQ8STP cPGMINTPGMIN WTREAD"SYSMSGCCSGETVOLUSECCSMVACCSHXAHXDEC -PGMOUTaPMOUN PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP *T __:dD\U{6{\{6{\tw6yv  \w6yTT<], @Uj;B.DL LIBRARY x999982112282< PDL XXX DL LISTING FROM PROGRAM LIBRARY SL-XXX @P@PQ@PV@PXP@P[ @P^@P_@P7 ENTER STARTING PROGRAM :@PN@P @P2 @P. @P`@P!`@P$@P_(h hhTOPT0456T T2TDDQT4R7SRDTU @P  hȥ  h hTZ!4T. hȴ h\@Pخ 1\3\4\2\f of0 ffKغ0 d dȳd0ȱd0 dd00dd0T? hr\@P hn\0d\? hf\ hb\0dȎdȌd0Ȋd0d"a N1TwC\6C\@P!CT!"bT!&Td"_d"^d"`TD"XDT1"PEFG\"PD1"TD @P0d"cG  l d d Hd"]d"\0 d l@PH4PSEDPRSPERRSETJDISPOSMCCSBLKOMEMORYZERO OPENFLCLOSFLDEFSETCCSMVAPGMIN P  P"dBUILD @P@P`&@Pe @Pl99P@PpFL @P BUILD @PENTER SCRNFILE DESCRIPTION -FOR OUTPUT@PENTER SCRNDESC DESCRIPTION -FOR INPUT @P+PAUSE LA@Pu d$d%T`T TabT1TNc'cT T@PH/\`\ab\\1Nc0c hT.e0f`00 Ȣd"\ )@PȜlؖȕ " dTH0//  ;TH0/ "]l\H/@PTH0/8 \"X`0i`̽l l dl d? d@ dATBj\H cTH@P!0/̻ " lll\Hc\H0/̫ "0 dT1Hk1/lddd d@PLTHk/T dTTc1 mT"^ T"_ TT8 @Pw(T3H// 1dndoTH1n/ !7\ 1TH1/ @P!200"`  T{cp+qTcr\ lT \@P@PTH/Tf/̾l\s/ \q/\t/@P@PHPBUILD PCHKFILDSPLA KEEPITLINOUT\GFILSRCCSMVAOPENI CLO CCSCSTOPENFLDELETEZERO CREATEGETFCB<PUPDFCBNCLEER UGET ZFLUSH bPRINTSjLISTS qBLDRECsWRITERzRREAD UPDRECINPUT NEXT CLOSFLERROR P P CLEER @PTTHPCLEER PSEDPRSCLRSCRP P"d8DELEET @P@P 'T0 4 5T1 4 5 TTT0 T T l@P- d0HPDELEET4PVERIFYPSTN LOKITM BLKITMCLRLINDISITM%DELITM)P P"dEDTITM @P@P6*,@P>2 =@PDA?#@@PITEM: TYPE[?] POSITION[????] LENGTH[??]@PCHNG TYPE: @P!CHNG POSITION: @P+CHNG LENGTH: @P0J T0 4 5T1 4 55  d 6 d 7d 8 0hPT6T@Pu 7T787T 6\9:9T;<hT;>?T;@ d@PT TA  hTBChȋ $T@P=l̤l̦ .̢ *̞ &\;>!D\;E7l\Ü \A  dB\@PB7ClC $\ ld00 7 6l 8   -T;>+DT;F9d@PT0 TA 1 lTB9Cl 1$T  d=  l̾@P?  l̹ ̶  ḻ ̮  Plļ %̣ !05h0wh  $D @PjdTx@Pq \ , l1T \ h ܀wh $G l\@P 9\ 9HT 9Hd0Id 6 0 8lTo61Tt 7\787T 6\9@P:9T; T5T= d0\5 \=\@P5w@PO@P]@P dHYPEDTITMPVERIFYPSTN QLOKITMUCCSPUTDIG4 CCSMVAmDIG2 LINOUTDSPLA INPUT CLRERRINPLENICNVRT&CMDERR1PEDTSTRyLASTC BLKITMADDITMDELITMDISITMP P"dFIDDLE @P@P@PP#@P FK@PFIDDLE@PENTER SCREEN NUMBER:@PPAUSE @P#TTT0  \\TTTN1'T\@PNT 0  hThT1 ohȲ \T@PpT63'& d00 d]0& " ȖhT160&T6̡ } !u n@PT T0 $1h\ \o lT$T0 d 4H0 d 500d 608d 7@Pd 80ˀh $h T>@P3 6 9o   lT  # d0 TmT& !TO"d@P0l  d0HPFIDDLEPCLRSCRDSPLA KEEPIT,GFILSR:CLOSEI,, @PSCREEN DESCRIPTION :@PPAUSE @P0e 8 3TTG0 TT0  dTT (h> @P(h l 1h9\ #$d 6 / $- 9h)\ *@P1+ \T% %Tk%& )\%./\%0 )\%1!\%2 \+o@P T]Te%3Ti0 8   $\%./Tq%00,  lT}(h@P4\#$l$ #\  l  d0 6  l ̿  l̺ ̷ @P_ PlT%1!\ $- h\1%2 \ 3T 4 5 4d 5dTT( I@PT44 0 d@P^@Pc@P d 70\ 4 5ll $5 dT$ 43 5 9d0 T1(   "T 9@P6d 6\\( \4  lT%T \%\@P@P d ll8 d @PO@PT@PY@P llHBPINSERTPCHKITMGETARG=ICNVRTCLRLINCLRERRDSPLA INPUT INPLENCCSMVADEFRDRCCSCSTLINOUTbCMDERRPSTN wPADDITMLASTC P P"dHKILL @P@P 7T0 3 hh0:K TT0 h@P.9 T lT lHPKILL DPVERIFY$LOKBLK BLKITMDELITM6RFRESH=P P"dLISTS @P@P?Kx1 Pl@P  @P,  @P0G UT1 ?@AhTC1T"cD d"Nh0 hh! & @P0r  o TFTF\1 ?@C\1C\"cDس\1@ @A\"c@PD0 dHPLISTS PCCSMVAMPRTVALWMPWRIX[DISITMSAVITMP P"dMOVEI @P@P#@P  TT s d 6 d 7d 8؀0h Ԁ0wh (@P4hRT@P: 90ŀh 0wh (h?\@PL \0ȱdȯ0 d " l\3 4 5T -T0 h lTȘlȗ  T @PwT 0 TT@P\ dT dHqPMOVEI PCHKITM^VERIFYxPSTN LOKITMCCSMVA6BLKITMdADDITMlCLRLINtDELITMDISITMRFRESHP P"dNEXT @P0  TT dT l dHPNEXT PKEEPITCLRSCRGET P P"dOPTION @P@PA@PF"$@PENTER DEFAULT OWNER NAME: @PENTER DEFAULT VOLUME NAME:@PAUTO PRINT? (Y/N) @P$AUTO LIST? (Y/N)@P,PAUSE BETWEEN BUILD SCREENS? (Y/N)@P=SYSVOL @PLTABTAC"T0D TE T"TEEE\AB\AF"XD \@PwE T=D"XD\AG\AH1D d"^ l\A$I\@PAGD d"_ l\A,J\1AKD 0d"` l@PH{POPTIONPLINOUTMINPUT SINPLEN^PGMIN cCCSMVA{P P"dPRINTS @P@P=1 @P?Kd **** lR@P0J  d"OT1"c= 3h\"c 1T?T1 @A@T B\"c@PuB\3"c\3"ch hjط )1ȹ1h\"cF\ G\"cF3T p3 h@P0h\ Gء !5Ț o !.T> 腆 1h$\ 1 2 2d 8> @PHdI\Fl 8TT1"cF@P \1F\"cF !Td 1G\"c1F\"cF lDf )11\"cF /l\@P1 "cܹ ;1 d0H,PPRINTSPMPWRIXCCSBLKCCSMVAhPRTVALpSORT2 DISITMP PQUITS @PTTTTHPQUITS PKEEPITCLRSCRFLUSH PGMOUTP P"dLRFRESH @P0"a0 ?lT0 0 1T33 p0 dT0L dd dd@P,h!   o TlػHPRFRESHHPCLRSCR SORT2 ZERO DISITM@P  P"dsSAVE @P@PW K@P\dPF @Ph@Pk@P)SAVE,<FILENAME>,,@P9CURRENT SCREEN DISCRIPTOR:@PFEDIT? (Y/N) @PLINVALID SCREEN NUMBER @P0l h0 hTT)W\X1 YTTT1NZ_Z "p8@P(hT[_0 lT l\ Y_\`9aTXb\cFdT@Pce1 00 Tb hTf\gd[ȅ \hLiṮ@P y\Y1 _\Y _ 3 lT3 3 T̕ aTyT33 p l@Pdj0!0 0  00 o Tj̮l!  ̼@PC lTj\ 30 \ T1k _̣ l0\ 3 \ T l\@PnHPSAVE nPCLRSCR DSPLA {GFILLNCLOSEOfCCSMVATMAKFL OPENO LINOUTINPUT EDTSTRICNVRTVALSCRDIG5 WRITE PSORT2 DISITM-SAVITMFP P"dTESTS @P@P0@P7(@P>P @PA1 Kd **** lR@P0000000000@P 9999999999@PPRINT? (Y/N)@PADVANCE FOR MORE DATA? (Y/N)@P#ENTER ACCOUNT NUMBER: @P.TEST@P0N T3 p0TT.0TTN11T1#2T 3T1@Py45 \T0 T1T6 " (( hXT0 d 2,\870€h 0̾ hT@P @P  l  l  l  l̚0 h̖0 ohT]@P0 28Ξd@0 h  (,1h\ 2@P 2@P@P@P@P\1?Tw11A 00 pT?B l1\? 1T@PCTf1 DEDTF\?F\?1\?1Gd lHnܛ )1Id@P\?J\K\?J $7$4d\ d8 (,h\@P=>E>\?J 1\K\?J\?J l̹n )1T?J /l\@P1h? ;1T[1LT1M0  ld0"aT@PS@P d@P@P@PHPTESTS PSORT2 UCLRSCR[DSPLA GFILLNcCCSMVALINOUTqZERO sINPUT wROPEN RREAD CLO CCSBLKCCSCSTDISITMMPCCSTIMqEDIT MPWRIXaPRTVALRFRESHP P"dUPDATS @P@PM$%@PR @P)ENTER NAME OF SCRNFILE TO UPDATE. @P;STRUCTURE ACTIVE. SAVE ? (Y/N) @PU d%d$ TM;NT1MO 00 T0 VT@P P\P)NT1TNMMT !7hT1Q '﨧@P& h\ȟ T1 $TS T1 #\TT@PH|PUPDATSPLINOUTaINPUT gSAVE xBLDRECGFILSRCCSMVAROPEN RREAD UPDRECERROR WRITERCLO P P"dWEEVE @P@P(@P, @PEDIT? (Y/N) @PSAVE FILE LIST? (Y/N) @PNO FILES SPECIFIED@PWEEVE WEEVE SOURCE FILE ? @P01 T0 `TTT(\)*T K hT, -T,@P1\. 00 T h0  1ȵ \)/\1)) @Pݜ T̪ T \)0 lHPWEEVE PKEEPIT6SEDPRS=CLRSCR?DSPLA AGWFILELLINOUTTINPUT ZEWSCRNkSWFILECOPWVEP P"dXTDMVE @P@P#@P  T d d0 " lT llԜ Ϝ @P50 h l h0h:K Tط hȲh!\ 謞 1Sȣ@P0` od0 4ȝ00 d 500 d 600 d 700d 8Ȏh0wh $h/T@P 90h 0wh $h \@P \T   d # n@P T 0 0l:K Tܬ dl윣8 @P\ܛd0 T0 dHPXTDMVEPVERIFYLOKBLKPSTN 'BLKITMKCCSMVAADDITMDELITMRFRESHP P"dADDITM @P@P#@P lsT1 mT p 8   ( hX ( hUT \9~ 9@P1} ( hHT1 9}hʄ0d "Td !:0 4f o 5f  6f  7f @P\̽f fw0ȡf h\ 91}ȔlTl @PT\ H TThsPADDITMPQ8PKUPQ8PREPVALITMLOKITM CCSMVA+LASTC 7COLLECCDISITMvERROR P P"dBLDREC @P@P@P @P T0 T0"\ h0"\ Ah1T d h hh0!n8 @P8 0c o0 \hh hW ȈSfȶ hȭ  !MȪ@m e@P0c e00e0  . AhA菎h !%h0h @PwhT @P 0f n@P nT l @ HHVPBLDRECPVALSCRCCSBLKICNVRT!CCSMVAERROR P P"d'BLKITM @PP@P@P0> "7 2 2   o d"a1T 8 @P0h"! ,!<Nf@PF0 h0 h0 ohT@PW @PY h !؟ !ؚ0܀ h0؀ oh\@Ps ̀ h ɀ hŀ oh\@P @P d " l̰ h̬ oh\@P sθl ! 왞!̕ hE0 oh\@P X0 odl 6TH0 l !ܸ ܞ!ܳ؀ hԀ ohTT@P ,0ɀ h 0ŀ h0 oh\@P @PI0̵ h0̱ oh\@P  @P  @P T\HTTh%hhhPBLKITMPQ8PKUPQ8PREPCCSBLK)DSPLA CLRLINERROR  P P"dCHKFIL @P@Pbj hT !G .Ȍ :ȑ 6Ȟ țȗ@P+@P  "d"] d# l l"   lTf  \g@P\hHTTh\h\hh\hhPCHKFILPQ8PKUPQ8PREPGETFCBlERROR P  PUCHKNAM @P hh hT *  T\ h!\C ,՘ @P/ h\C h \C 1Ȁ@PDH TThhhhhhPCHKNAMFPQ8PKUPLQ8PREPICCSGET CCSPUTP P"dCHKITM @P@P h0 8 " " 4 " "0 5 " P" h"! @P2, &Om0 6 " @"d Q"0 7 @P] " "h !ؕ !ؑȐd Q"n "n،d"n̼ @P"n P"n̲d Q"n̽ "n̸d"n̝ "n "n 5 @Pd Q"n̜ "n̗d"n 6 "n "nd ! !ӌ@Pd Q"n 7 "nd"n0 4 x̸ t pt !k !g̾@P l ! !̝d Q!W !Snjd!LP̢ G 5d Q!@D̖ !;@P4 @ 6!6d Q!0̤ , dT 9d  T 9@P>@P@\@P\ n 7 n n@Pn@Pn@Pn@Pn@P$n@P)n@PGn@PLn@PSn@PYn@P`n@Pen@Pn d@P[s@Ps HTTPCHKITMvPQ8PKUP|Q8PREPyICNVRTGDIG2 XP P"dCLOSEI @PT60& d]0 d HPCLOSEI PCLO P P"d!CLOSEO @P T3w 00^^ $T0^ lT0w^HPCLOSEOPPUTS ERROR CLO P  PCLO @PTTH TThh\hPCLO PQ8PKUPQ8PREPCLOSFLZERO P P"dCCOLLEC @PTx3 h0h!+0 #w hh whT @P-@P0n̎hd0HPCOLLEC?PSORT CCSMVA)P P"dyCOPWVE @P@P+( P@P2d@P4 &@P=@P?L@PENTER SCRNDESC FILE NAME FOR OUTPUT TO. @PCOPYING ???????? / ???????? / ????????@PBTTT+,TTN1-_0-g0 \1"X.g.T/0 @PmT  hT1L2 h"O (h\@P.'.\"P1.'5.T/. d30 d4 d5T36& d00]d \16-T386'&@P& 11\"T.'5.\/. lT̡ p1TO'.5.\'5.6.\1'7.@P8.TG+9T d:T }̴ S  d;1T ;=>d<> @P )0L # n1 lT1(\(=? @?T G1T AA :\ @P5AA:̯ \̮ ,] TC3-T41 0̽ l\10 \̐ @P`̳ l\1 0\ TE\\@Plr@Psr@PrHPCOPWVEtPCLOSEIJCLOSEOmLINOUTGFILSRMCCSMVAPMAKFL dOPENO nZERO wCCSBLKCLO OPENFLOPENI FLUSH READ PICNVRTDIG5 WRITE $CCSCST*P P"dDDELITM @P0 !0& 1   00 o Tnn f08 @P+l T\ H TThhhPDELITM8PQ8PKUP>Q8PREP;BLKITMERROR .P PDIG1 @PT l@P H TTh\hPDIG1 PQ8PKUPQ8PREP DIGIT P  P8DIG2 @P**@P @Pdl" c !  !Thh\)"p8hTh\Ȉl@P* H TTh\hPDIG2 ,PQ8PKUP2Q8PREP/DIGIT MOD P PSDIG4 @P'@Pd@P'@P ** !2 !.Thh%\<"p8hT\ hT @P1T 1@P=llHTTh\hhh hPDIG4 CPQ8PKUPIQ8PREPFMOD DIG2 CCSGET)CCSPUT2P PHDIG5 @P@Pd@P'@P ** !%Thh\/"p8hp8hT\\T@P0lllHTTh\hh h hPDIG5 7PQ8PKUP=Q8PREP:MOD DIG2 CCSPUT*P PDIGIT @P *h 6 3 0h@P HTThPDIGIT PQ8PKUPQ8PREPP P"dDISITM @P@Pj}}@ {}@PoP@P{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}@P)mm/dd/yy@P-9999999.99- @P3999/999-9999@P9999-99-9999 @P?hhmm@PAmm/dd/yy ac rs lt coll *********************** comment ************************ @P0p9 " 3 2.00  00 o 00d"a h"!@P ,(?q@P0 h0h 0whT@P @P d 2h !ؚ ڞ!ؕ\)i1 iil " "@P h h\1 ̲ h\k @P @Pld0 mlγl}ή lΫ " l h\-1i i̵lgΗl !ܫ@P1 0 !ܥT3i1 i̜d 2M odnl 9TiAoi\Ao o@P\ PlSl ! ž!\9i1 il̴0 h\?@P} jβl '\A1o o Pl0"N "O 0 h0 oh\@P8 2 @Pv@P|@PT@P@P@P\jHTThhlhhhPDISITMPQ8PKUPQ8PREPCCSMVA8DSPLA MERROR P PEDIT B50 F CCS CCS 3.0 PSrPD SL-149@P @P9 -0@P99/99/9999999.999/999-9999-99-9999@P/ /"+ "&h h hh!+ΈhT`.ۘ   hT@PZ.`@Pbh\`.h\.`ػػ@Pt V hȝ!h\`.Ȩ ׈h\`؜h\,. 1@P I.8 l\., \,,\, \, l\.,\@P,#H TTh\h\hhhhhhhhhhh\hu\hp>PEDIT PQ8PKUPQ8PREPCCSGETNCCSPUTZP P"dNEDTSTR @P@P @PEDIT:  @P TTT 0 Td 1 hܘ?1T  @P6T  H TThh\hhPEDTSTR@PQ8PKUPFQ8PREPCLINOUT DSPLA INPUT INPLEN#CCSGET/CCSPUT7P P"dEOF @P hd]@P l h H TTh\PEOF PQ8PKUPQ8PREPP P"d.ERROR @POd  lTT1TTd"a H TTh\@P+hPERROR "PQ8PKUP(Q8PREP%CLRLIN DSPLA FLUSH ERRMSGP P"doEWSCRN @P@PP@P @P @P2@P@P@P@P@P@P@P d 40 d 5 " l3T 4 51 hTh  2 l 1[ hȘ@P@!UT  Aȼ , !( !$ 1! T1 5 !̲ h%p8(@Pk h\1 5 h (hT @P|ܝ P1 lܓ  4" l @P l " l   " lpTT1  l ,@Ph00 3 dd d!) ,h  ,0h ,hT@P@P  ,hnܡ c1 d l ,dθ    @P,h ,0hT@P@P ,l̙n d1d0 17 $lT1 l!" lT^@PH d0 4̻ "p4 $ d 5 ,;h\ 4 5@P`ܦ1T HPEWSCRNjPINPUT !INPLEN(CCSGETCMOD FCCSPUTxCLRSCRDSPLA 7CCSCSTCCSMVACCSBLKdP P"dDGETARG @P@P,@P' Ah%$ 1 h1T3%$l "lT @P,T lH TThh\h\hPGETARG5PQ8PKUP;Q8PREP8SCAN CCSMVA#CCSBLK-P P"d:GFILLN @P@P0%0$ 1(1TN 1\R 1T"TR\V0TN08N @P.TTHPGFILLN6PGETARG CCSMVACHKNAM'CMDERR0GFILSR2P P"dGFILSR @P@P @P *2@PFILE NAME?@POWNER ID? @P VOLUME? @PTTTTN0 Td 10N 0 T@PC\1R \ T1"TR\R\ \V @PnT0NĜ \THPGFILSR~PFLUSH CLRLINDSPLA INPUT %INPLEN0LINOUTBCCSMVAUCHKNAMpCMDERRzP P"dGWFILE @P@PdP2@P" @P#00->#19 #20->#39 #40->#59 #60->#79 #80->#99 @P% dTT (ho (hmT1N'T fT d0 (hUT (hN@PP\ T1 T1T   !ȸ 07 ߔ0  1)9T"@P{ d 4p8(0 d 5ܾ ,1h\ $@P$ 0,h\ 4 5@P$@P dT+HzPGWFILEPGFILLN)CLOSEICCSMVA3OPENI ;CLRSCRACCSBLKJDSPLA XREAD ^CCSCST`MOD xP P"dKEEPIT @P@PA45S R D $@P'STRUCTURE ACTIVE: SAVE, RETAIN, OR DISCARD? (S/R/D) @P0M 00"^ T0"_ TTA'BTAC1 0@Px@] s$d%d (h( (h&T1 llT@P Rll (h (h \@PT 30 pT1HH d0 l ddI dJ dKdL!@P   o TLHOPKEEPITPPRINTSZLISTS aLINOUTcINPUT iCCSMVASAVE SORT2 LOKITMDELITMP P2LASTC @P @P h 1 h! hT @P h H TTh\hPLASTC &PQ8PKUP,Q8PREP)CCSGETP PLINOUT @PTTHTThh\hh\h\hPLINOUT PQ8PKUPQ8PREPCLRLINDSPLA P P"dLOKBLK @P@PJ1 2 3 @P0 TT Tdd0\ \\ \ ll@P=d "Ƚlȼ "ȸl0ȷdȵ "ȱlȰ "Ȭlȥh "ȡhȩ "Ȝh@Phțh "ȗhȝ "ȒhT3L d0 Qh d dd0!50 o !@P,0 !% ! ! #lۜ #l fK@Pܼ̹ d̸d0 d0H=PLOKBLKPRFRESHDSPLA PSTN !ZERO vP P"d=LOKITM @P l 0 h0 !h!l 0 o @P' lhH TTh\h\hPLOKITM/PQ8PKUP5Q8PREP2P P"drMAKFL @P@P   T1wT1N_T1_'0g T3Tw_08^^@P. $T^\w  h%\ka"dk d0mה \"X1gTw3_^ @PY#\01^\w@Pd H TTh\hPMAKFL fPQ8PKUPlQ8PREPiZERO CCSMVA CCSCSTCLOSEI%DELETE'ERROR 4CREATESP P"dNEWCMD @P@P)KF@P.,,@PCMD: @P',@P00 T 0ld dddd0 d"Nd00"O 0  lT) *T)@P1[+,hT T-d$ 1 d%T13'%$1T. h \@P/.1.@P HTThPNEWCMDPQ8PKUPQ8PREPCMDERR5DSPLA SINPUT YCLRERR`INPLENhSCAN uCCSMVA{P PCMDERR @PL@PERROR @PTHPCMDERRPDSPLA P P CLRERR @PLTHPCLRERR PCLRLINP P"d#OPENI @P d04T63'& d00]d 0 T36'0& THPOPENI PCHKFILOPE CLOSEIP P"dOPENO @P dl3Tw_0^ d 3HPOPENO POPE P P4OPE @PTT llT $T@PHTThhh\h h h\hhhPOPE PQ8PKUP$Q8PREP!CLO ZERO OPENFLERROR P P,PRTVAL @P  1 Ah h< hT@Pn@PH TT h\hPPRTVALPQ8PKUP%Q8PREP"VDC P P"dPSTN @P7A@P=P@P+@P,@P-@P.@P/LOCATE@P3 @PAT78/90hh h  hhll h " l P" Pl " l @Pl" lhT/T=hT>d 1% hȶ!T?@ȯ  l@P " l P! P" l?*,  d<- .  @P )l > 2 lܣ " l " lT78Ts3HT@PThhh\h~hhEPPSTN PQ8PKUPQ8PREPDSPLA BLPSTN INPUT xINPLENCCSGETCLRLINP PLLPSTN @P L.A@PLINE ??, COLUMN ??@PT T   \ \  TT\H T@PATh\h\hPLPSTN >PQ8PKUPDQ8PREPAHEXDECCCSMVACLRLIN-DSPLA 1P P"dlREAD @P@PP@P@P@P0  h 10] G h3T6&&- !80Dh (( h"![@P03  ((h0  (([hT@PJ ܹ@PR l\1 ܭ hȤlT&HPREAD hPGETS CCSMVAHERROR bP  PZROPEN @P@PT l!l!l!hTT 1 d1 lT@P/T \HTThhhhh\hh h h h\hhhhhPROPEN =PQ8PKUPCQ8PREP@CHKFIL0CLO ZERO OPENFLERROR (P P?RREAD @P@P hT 1 d1 lTTHT@P1Thh\h\h\hhPRREAD -PQ8PKUP3Q8PREP0READR ERROR #CLO 'P P"dSAVITM @P E)(@x "p 2j   o  aZ o@P+hT@P/ R0 h\@P6 K0 h\@P= D0 hT@PE <0hT@PM T1 ,0h(0 wh\@Pb 0  hwh\@Pz d  @PT\H TThhhmPSAVITMPQ8PKUPQ8PREPDIG2 -DIG4 CDIG1 KCCSMVAOERROR P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PTSORT2 @P/ h- 10) hh!& hh!@ $ מ  $T@P0р@P8@HHTT h\ h\h\hPSORT2 ?PQ8PKUPGQ8PREPDSWITCH/P P@SORT @P$ h" 1$ hh! hh! $T܀@P,H TT h\h\hPSORT 1PQ8PKUP7Q8PREP4SWITCH$P  P"dRSWITCH @P<`0 oh8mn0 hmn hm0n hmnhmn0whm@P,n0hmnKhmn@P?@H H TTh\hPSWITCHCPQ8PKUPKQ8PREPHP P"d?SWFILE @PdP@PT0 dTT0 %T 1T  h! 0(ۀhT@P. T\HPSWFILE;PGFILSRCLOSEO MAKFL OPENO CCSBLKCCSMVA,WRITE 4P P"d*VALITM @P@PTh  h h  hT d0 HTThPVALITM PQ8PKUP&Q8PREP#CHKITMERROR P P"dVALSCR @P@P,@P/@P1k,@PERROR - DATA EXTRACTION EXCEEDS RECORD SIZE @PERROR - MULTIPLE TYPE 5 ITEMS @P06 " 3T p3 hhh h h0h!?00  7 o@P0a 00 0 0 hȳ "ȶhȮ豞 #hȦ  hȡ  h@PӘ #hؗ T hT1 ./0d+1d- 2l& ) d@PT34(  7 l\,5') 3 lTHWPVALSCRPSORT2 BCLRSCRICNVRTLINOUTFLUSH P P0VERIFY @P@P @PVERIFY (Y/N) @P @P T h T @P H TThh\hPVERIFY#PQ8PKUP)Q8PREP&DSPLA INPUT P P"d0WRITE @PP -T3w 00^^ ! l (,hT @P"T^HPWRITE ,PPUTS CCSMVAERROR &P P1BLKSIO BUFFERED WTREAD INTERFACE SUMMARY-***@PP@P/ h  T0 h Xx hs h hn Xm Xxhq@PZhn X^ Xjd 2 1T_ 2 1N[ !JU Q ȶ 3XH>G H:@P  Ȣ h Ph'6#/ȑ,h ! PhX h"h @Py1 Hh h l X@P X h@ h?XR "  2 2  " P" Ȍ hh$ 2 Ph T9@P# 1H ! X Xl X XlPCLRLINPCLRSCREDISPOS1DSPLA _FLUSH 5INPLEN INPUT TERMCH(PWTREADP PDEFFIO RPTTBL FILE ACCESS INTERFACE SUMMARY-***@PRPTTBL CCS20 @P( HHX, jT j X h hX6TS12 @PSXX hh T h X bXzhyhTpqlq4" 1l @P~Hi jT"  hX X XRLh IjTnS64@P$ i, T" ^l-/@P X X& hTS64% A TS" 5l@P hH h " jt X X 'jPTSSl64"@P m Xc XhTS$64) S lll h\SR}@P>Al h\SR~AlȤ l@P} HTTPDEFACCDEFCLOYDEFCMPADEFDELDEFOPE}DEFRDRbDEFSET(DEFUPDDEFWTRPWRITERUPDRECREADR !PGMOUTPGMIN 3OPENFLICNVRT5FILERRDELRECCOMFILICLOSFL[P PwHEXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P @P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHEXDECcPQ8PKUPkQ8PREPhP PSYSMSG DECK-ID A33 ITOS 2.0 ( 132 ) SUMMARY-***@P h% hh bh hHJ "hF!dhEH4  jMTpb_5@P+"Tp`_+!wTp_ H!H! .X H   #3T Xs H @PV X}$$SYMSGF$$ \"Xu HM HXK  X@P\Xr H> H X<  X H,X-/ H(X8 \ȵ" \@P]T8p_ ȮX6 wf" tf"\7 h H ! qH  H@PHa2Ƞ(h!n 8 H X X' hdLH 1  :X@P/ H"A HB0Fh  0X/ ^ 00j qa! )"@P- hh! u  HTLD\fHH@PXSYSTEM MESSAGE XXXXUSER MESSAGE XXXX`P`P(@P Hh j PSYSMSG ERRSETERRMSGPREADR /CLOSFLOPENFL&P P MEMORY @PHPMEMORYP P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO PQ8PKUPQ8PREPP PISHIFT @PH"h"hC PISHIFTP PHMPWRXX UNIT RECORD FUNCTION PROCESSOR SUMMARY-***@P h  h  h  ɀhHhh H hT+@@@P+@ h ɀhHhhhhPMPWRIX MPREDXMPWRIUMPREDUMPMOTN3P PMOD @PH"h"h <PMOD P PVDC VALIDATE TWO DISPLAYABLE CHARACTERS @P H" 2 1 h"Ƞ 2 1 ȸPVDC P  P RAO @PH""PRAO P PICNVRT @P-09 ,.+-@P4@P@P@P@ lhh h T= u@PY "\=hǘ 6Ҙ 2h̘ hƘ ȼh ȷhȺ@P Ȳhȴ ȭh (hh (,hh"! ( @P=-h $l d;>dWd< dldH@PTThlh~\hhhz\hm\hihOPICNVRTPQ8PKUPQ8PREPCCSGETLP __O P PICNVRT @P-09 ,.+-@P4@P@P@P@ lhh h T= u@PY "\=hǘ 6Ҙ 2h̘ hƘ ȼh ȷhȺ@P Ȳhȴ ȭh (hh (,hh"! ( @P=-h $l d;>dWd< dldH@PTThlh~\hhhz\hm\hihOPICNVRTPQ8PKUPQ8PREPCCSGETL(at W|$SEDHELP$$ P032883(* SCRNED - SCREEN EDITOR SCRNED IS AN EDITOR FOR CCS 3.0 SCREEN DESCRIPTION RECORDS. BUILD - Build a SCRNFILE from a SCRNDESC. CLEAR - Clear screen AND work data structures. DELETE - Delete an item from the work area. EDIT - Edit an item in the work area. FIDDLE - Extract screen from a SCRNFILE. GET - Get a screen description record file into the work area. HELP - H E L P !! INSERT - Insert a new items into the work area. KILL - Block delete. LIST - List the SCRNDESC file defined by the current work area. MOVE - Move an item on the screen. NEXT - Get the next screen from a SCRNDESC file. OPTION - Set default options. PRINT - Print the screen as it appears. QUIT - Quit, terminate, end, stop, halt, cease, exit, etc. REFRESH - Refresh the screen display. SAVE - Save the work area as a new SCRNDESC file. TEST - Display screen with test data. UPDATE - Replace a record in a SCRNFILE. WEAVE - WEAVE together SCRNDESC files. XTDMVE - Block move. Z - A short QUIT. ? - A short way to enter HELP. NOTE: All commands are unique to 1 character and may be entered by the first character of the command name ( e.g. CMD: H(CR) is sufficient to execute HELP ) + - Misc useful information about operation of the screen editor * - Exit HELP *+ A POSITIONING SEQUENCE DETERMINS A SCREEN LOCATION. THE ENTRY MAY CONTAIN ANY DISPLAYABLE CHARACTER, RIGHT ARROW, OR UP ARROW. THE TERMINATION CHARATER CARRIAGE RETURN TERMINATES THE SEQUENCE, RESET RETURNS TO THE HOME POSITION, LINE FEED MOVES DOWN ONE LINE, AND RUBOUT DISCARDS A NON-NULL ENTRY AND RETURNS TO THE LEFT EDGE ON NULL INPUT. BLOCK DETERMINATION CONSISTS OF A SERIES OF THREE POSITIONING SEQUENCES. THESE POSITIONING SEQUENCES DETERMINE MINIMUM AND MAXIMUM COLUMNS AND LINES. ANY ITEM WHOSE FIRST CHARACTER IS WITHIN THESE BOUNDRIES IS INCLUDED IN THE BLOCK. ANY ITEM WHOSE FIRST CHARACTER DOES NOT FALL WITHIN THESE BOUNDRIES IS  NOT INCLUDED IN THE BLOCK. FILE DESCRIPTIONS ARE: FILENAME MUST BE ENTERED, NO DEFAULTS OWNER MAY DEFAULT. THE DEFAULT IS (USUALLY, SEE WEEVE) THE OWNER NAME SET BY OPTION ( INITIALLY, THIS IS THE LOGIN USERID ). VOLUME MAY DEFAULT. THE DEFAULT IS SET BY OPTION ( INITIALLY IT IS SYSVOL ) *? SEE HELP DOCUMENTATION *BUILD BUILD - BUILD SCRNFILE FROM SCRNDESC Build BUILD READS A SCRNDESC FILE AND GENERATES A NEW SCRNFILE FILE ( NOTE: THE OLD SCRNFILE FILE IS DELETED AND A NEW ONE IS CREATED, SIZED TO 100 SCREENS ) AS EACH SCREEN DESCRIPTION IS PROCESSED: 1. THERE IS A PAUSE FOR EACH ITEM VALIDATION ERROR; 2. THE SCREEN DISCRIPTION CARD IS DISPLAYED; 3. A WRITE IS ATTEMPTED TO THE SCRNFILE; 4. IF THE WRITE FAILS, THE AN UPDATE IS ATTEMPTED; 5. IF THE BUILD PAUSE FLAG ( SEE OPTIONS ) IS SET, THE  A PAUSE OCCURS. *CLEAR CLEER - CLEAR WORKING STRUCTURE AND DISPLAY. Cleer CLEER CLEARS THE CURRENT WORK AREA AND RESETS THE EDITOR TO ITS INITIAL STATE. *DELEET DELEET - DELETE AN ITEM. Delete DELEET REMOVES A SINGLE ITEM FROM THE WORKING STRUCTURE. THE ITEM IS SELECTED WITH A POSITIONING SEQUENCE. THE ITEM IS BLANKED FROM THE DISPLAY AND THEN VERIFICATION IS REQUESTED. 'Y' IS THE ONLY CONFIRMING RESPONSE. *NOTE* DUE TO THE DISPLAY ORDER OF SOME ITEMS, A REFRESH MAY BE REQUIRED TO DISPLAY THE CORRECT CONTENTS OF THE WORKING STRUCTURE. *EDIT EDIT - EDIT ALL TYPES Edit  EDIT PERFORMS A POSITIONING SEQUENCE TO LOCATE THE ITEM. IF A ACTIVE ITEM IS SELECTED, THEN THE EDIT SEQUENCE IS INITIATED. THE EDIT SEQUENCE IS: 1. THE ITEM TYPE, DELQMAST POSITION, AND ITEM LENGTH ARE DISPLAYED; 2. THE ITEM TYPE MAY BE CHANGED ( DEFAULT IS NO CHANGE ); 3. THE DELQMAST POSITION MAY BE CHANGED ( DEFAULT IS NO ); 4. THE ITEM LENGTH MAY BE CHANGED ( DEFAULT IS NO CHANGE ); 5. THE DESCRIPTION STRING ( TYPES 0 AND 8 ) OR THE COMMENT STRING ( TYPES 1, 2, 3, 4, 5, 6, 7, 9 ) MAY BE EDITED; 6. THE ITEM TYPE, DELQMAST POSITION, AND ITEM LENGTH ARE REDISPLAYED, AND THE NEW ITEM IS VALIDATED; 7. THE OLD ITEM IS BLANKED; 8. THE NEW ITEM IS DISPLAYED; 9. VERIFICATION IS PERFORMED; 10. IF NOT CONFIRMED, THE NEW ITEM IS REMOVED AND THE OLD ITE IS REDISPLAYED; *NOTE* DUE TO ITEM DISPLAY ORDER, A REFRESH MAY BE REQUIRED TO DISPLAY THE WORKING STUCTURE ENTIRELY ( ITEM OVERLAP ). *FIDDLE FIDDLE - FIDDLE EXISTING SCRNFILE SCREEN Fiddle  FIDDLE PERMITS READ ACCESS TO A SCRNFILE FILE. THE USER IS PROMPTED FOR THE SCRNFILE FILE DESCRIPTION AND THE SCREEN NUMBER. IF THE SPECIFIED SCREEN CAN BE READ, THEN IT IS PROCESSED INTO THE WORKING STRUCTURE. *GET GET - GET SCRNDESC FILE SECTION INTO EDITOR Get Get,,, GET ACCESSES THE SPECIFIED SCREEN DESCRIPTION RECORD FILE AND BUILDS THE CORRESPONDING WORKING STRUCTURE. EACH ITEM IS VALIDATED BEFORE IT IS ADDED TO THE WORKING STRUCTURE AND ERRONEOUS ITEMS ARE DISPLAYED WITH INDICATION ( ^ ) OF THE ERROR. THE FILENAME/OWNER/VOLUME WILL BE PROMPTED IF THE FILENAME IS NOT SPECIFIED ON THE COMMAND LINE. THE DEFAULT OWNER IS THE LOGON USERID IF THERE IS NO DEFAULT OWNER SELECTED BY OPTIONS. THE DEFAULT VOLUME NAME IS SYSVOL UNLESS SET BY OPTIONS. THE USER IS REQUESTED TO VERIFY THE RECORD ( BASED ON THE FIRST CARD OR THE DESCRIPTION ) BEFORE THE FILE IS PROCESSED. *HELP HELP - HELP THE NEEDY. Help  Help, ? ?, THE SELECTION IS PROCESSED AS: 1. * -EXIT HELP ROUTINE 2. -DISPLAY DEFAULT INFORMATION ( BLANK OR NULL ) 3. OTHER SCAN THE HELP FILE FOR A RECORD BEGINNING WITH A * AND THE CHARACTER ( E.G. *I FOR SELECTION I ) -IF SUCH A CARD IS FOUND, THEN DISPLAY THE TEXT UNTIL A CARD WITH * IN COLUMN 1 IS ENCOUNTERED. -IF NO SUCH CARD IS FOUND, THEN REPROMPT FOR A NEW SELECTION. *INSERT INSERT - ENTER NEW ITEMS FROM TERMINAL Insert Insert, INSERT ALLOWS THE ENTRY OF ANY TYPE ITEMS. THE DEFAULT TYPE IS 0. IF THE TYPE IS 0 OR 8, THEN THE TEXT IS ENTERED AFTER A POSITIONING SEQUENCE. IF THE TYPE IS 1, 2, 3, 4, 5, 6, 7, OR 9, THEN THE USER IS PROMPTED FOR THE ASSOCIATED POSITION IN THE FILE, LENGTH FROM THE FILE, AND COMMENT AND LOCATES THE ITEM ON THE  SCREEN WITH A POSITIONING SEQUENCE. TO EXIT: 1. FOR TYPES 0 AND 8, ENTER A RESET TO A POSITIONING SEQUENCE; 2. FOR TYPES 1, 2, 3, 4, 5, 6, 7, AND 9, ENTER A RESET TO THE PROMPT FOR POSITION IN FILE. EACH ITEM IS VALIDATED BEFORE BEING ENTERED INTO THE WORKING STRUCTURE. *NOTE* ALL NUMERIC PARAMETERS ARE RESTRICTED TO A MAXIMUM OF 8 CHARACTERS. *KILL KILL - KILL OFF A BLOCK OF ITEMS Kill KILL PERFORMS BLOCK MMODE DELETION OF SCREEN ITEMS. A SERIES OF 3 POSITIONING SEQUENCES IS REQUIRED TO DESCRIBE A RECTANGLE ON THE SCREEN. ALL ITEMS THAT BEGIN WITHIN THE SPECIFIED RECTANGLE ARE BLANKED FROM THE DISPLAY AND THE USER IS PROMPTED TO VERIFY THE ACTION. IF DENIED, THEN THE ITEMS ARE REDISPLAYED. IF ACCEPTED, THEN THE ITEMS ARE DELETED FROM THE WORKING STRUCTURE. *LIST LIST - LIST SCRNDESC IMAGE.  List LIST PRODUCES A LISTING OF THE SCRNDESC FILE AS DEFINED BY THE CURRENT WORK AREA. *MOVE MOVE - MOVE ITEM. Move MOVE AN ITEM ABOUT ON THE SCREEN. THE USER IS REQUIRED TO ENTER TWO POSITIONING SEQUENCES, FIRST TO SELECT AN ITEM AN THEN TO INDICATE THE NEW POSITION. THE ITEM IS BLANKED FROM THE OLD POSITION AND DISPLAYED AT THE NEW POSITION BEFORE VERIFICATION. IF THE REPOSITIONING IS NOT VALID OR NOT CONFIRMED, THEN THE MOVE IS RESTARTED ( BOTH POSITIONING SEQUENCES ). *NEXT NEXT - GET NEXT SCREEN DESCRIPTION Next NEXT PERMITS STEPPING THROUGH A SCRNDESC FILE ONE SCREEN AT A TIME. THE SEQUENCE MUST BE INITIALIZE BY A PRIMARY GET CALL. FOR THE REMAINING SCREEN DESCRIPTIONS IN THE FILE, NEXT WILL DISPLAY THE SCREEN DESCRIPTION HEADER CARD AND PROMPT FOR  VERIFICATION. IF THE SCREEN IS SELECTED, THE IT IS PROCESSED INTO THE WORKING STRUCTURE. IF THE SCREEN IS NOT SELECTED, THEN THE SCRNDESC FILE IS SLEWED TO THE NEXT SCREEN. IF THERE ARE NO MORE SCREENS REMAINING IN THE FILE, THEN THE USER IS RETURNED TO COMMAND MODE. *OPTION OPTION - SET OPTIONS Option OPTION ALLOWS FOR SOME STANDARD DEFAULTS 1. OWNER NAME ON FILE ACCESS ( LOGIN USERID ) 2. VOLUME NAME ON FILE CREATION ( SYSV ( SYSVOL ) 3. AUTO PRINT OF SCREENS BEFORE DISCARDING ( NO ) 4. AUTO LIST OF SCREENS BEFORE DISCARDING ( NO ) 5. PUASE BETWEEN SCREENS DURING BUILD PROCESS ( NO ) 6. CCS / ITOS 2.0 SYSTEM TOGGLE ( CCS ) *PRINT PRINT - PRINT SCREEN. Print PRINT A ONE PAGE IMAGE OF THE SCREEN AS IT IS DISPLAYED. *QUIT  QUIT - TERMINATE PROCESSING. Quit QUIT TERMINATES THE EDIT SESSION AND CHECKS THAT ANY ACTIVE WORK STRUCTURE IS NOT IGNORED. *RFRESH RFRESH - REFRESH DISPLAY. Rfresh RFRESH REPAINTS THE ENTIRE DISPLAY FOR NEATNESS. AS A SIDE EFFECT THE WORKING STRUCTURE IS CLEANED UP. *SAVE SAVE - SAVE SCRNDESC RECORD. Save Save,,, SAVE THE WORKING STRUCTURE AS A SCRNDESC RECORD. THE SCREEN DESCRIPTION RECORD ( FIRST CARD ) MAY BE EDITED BEFORE THE SCREEN WORKING AREA IS SAVED. THIS ALLOWS THE SCREEN NUMBER AND/OR COMMENT TO BE CHANGED. *TEST TEST  Test DISPLAY ACTIVE PORTION OF THE SCREEN WITH LIVE DATA. *UPDATE UPDATE - UPDATE A SCRNFILE RECORD Update UPDATE PERMITS SCREEN ADDITION/UPDATE IN A SCRNFILE FILE. THE USER IS FORCED TO SAVE THE SCREEN IN A SCRNDESC-TYPE FILE BEFORE THE UPDATE PROCESS IS BEGUN ( BECAUSE THE UPDATE MAY BE TO THE ACTIVE SCRNFILE THAT THE COLLECTORS ARE USING ). AN EARLY ERROR RETURN ( BEFORE THE FILE PROMPT ) INDICATES THAT THE CURRENT SCREEN CANNOT BE BUILT INTO A SCRNFILE FILE RECORD. *WEEVE WEEVE - WEAVE SCREEN DESCRIPTIONS Weeve WEEVE PROVIDES A MEANS TO CONCATONATE SCRNDESC FILES. THIS ALLOWS FOR SCREENS TO BE SAVED TO INDIVIDUAL FILES AND THEN COMBINED INTO A SINGLE FILE FOR BUILD PROCESSING. IF THE ARE DUPLICATE SCREEN DEFINITIONS, ONLY THE FIRST OCCURANCE IS COPIED ONTO THE DESTINATION FILE.  THE USER IS PROMPTED FOR TWO FILE NAMES: 1. THE FILE CONTAINING THE NAMES OF THE SOURCE SCREEN DESCRIPTIONS; 2. THE DESTINATION FILE. THE USER MAY EDIT THE LIST OF SOURCE FILES UNDER THE FOLLOWING CONSTRAINTS: 1. AT MOST 100 FILE NAMES ARE PERMITTED; 2. AT MOST 1 FILE NAME MUST REAMIN AT COMPLETION; 3. A FILE NAME MAY BE REMOVED BY EDITING IT TO BLANKS; 4. ANY FILE NAME WITH TWO LEADING BLANKS IS CONSIDERED TO BE REMOVED FROM THE FILE LIST; 5. THE FILE NAME "END " SHOULD NOT BE USED. THE EDIT IS PERFORMED BY POSITIONING ONTO THE DISPLAYED LIST AND ENTERING CHANGES. THE EDIT IS TERMINATED BY ENTERING A RESET. NEW FILES MAY BE ENTERED BY EDITING A BLANK ( DISCARDED ) NAME FIELD TO NONBLANK. DURING THE COPY PHASE, THE FILES ARE ACCESSED UNDER THE FOLLOWING RULES: 1. THE OWNER NAME THAT IS THE LOGON USERID IS USED AND A VOLUME SEARCH IS PERFORMED. 2. IF 1. FAILS, THEN THE DEFAULT OWNER NAME SET BY OPTIONS IS USED FOR THE FILE OWNER AND A VOLUME SEARCH IS  PERFORMED. 3. IF BOTH 1. AND 2. FAIL TO ACCESS A FILE, THEN THE FILE CANNOT BE LOCATED AND THE COPY IS TERMINATED WITH ERROR. *XTDMVE XTDMVE - BLOCK MOVE Xtdmve XTDMVE PERMITS RELOCATION OF A GROUP OF ITEMS ON THE DISPLAY. THE USER PERFORMS A SERIES OF 3 POSITIONING SEQUENCES TO DESCRIBE A RECTANGLE ON THE DISPLAY AND THE 1 MORE POSITIONING SEQUENCE TO RELOCATE THE ITEMS WHICH BEGIN WITHIN THE DESCRIBED AREA. NOTE: THE ITEMS NEED NOT BE ENTIRELY CONTAINED IN THE AREA AND JUST BECAUSE PART OF AN ITEM IS IN THE AREA DOES NOT INSURE THAT IT WILL BE MOVED. THE USER IS PROMPTED TO VERIFY THE RELOCATION. *Z SAME AS QUIT COMMAND. SEE QUIT DOCUMENTION FOR DETAILS. __ DURING THE COPY PHASE, THE FILES ARE ACCESSED UNDER THE FOLLOWING RULES: 1. THE OWNER NAME THAT IS THE LOGON USERID IS USED AND A VOLUME SEARCH IS PERFORMED. 2. IF 1. FAILS, THEN THE DEFAULT OWNER NAME SET BY OPTIONS IS USED FOR THE FILE OWNER AND A VOLUME SEARCH IS (!# !$SEDMSGF$$ P032883(ITEM COUNT RANGE ERROR ##### NOT IN RANGE RRECLN = ##### 00001HALF MARKED ITEM ENCOUNTERED 00002STRING BUFFER OVERFLOW 00003ITEM INDEX ERROR 00004FM ERROR OPENFL, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00005FM ERROR CLOSFL, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00006FM ERROR GETS , ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00007FM ERROR PUTS , ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00008FM ERROR CREATE, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00009FM ERROR DELETE, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00010FM ERROR UPDFCB, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00011SCRNDESC CARD ##### INVALID 00012FM ERROR WRITER, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00013FM ERROR READR , ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00014FM ERROR UPDREC, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00015SCREEN TOO LARGE FOR SCRNFILE RECORD SIZE 00016INVALID ITEM DESCRIPTION 00017FM ERROR GETFCB, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00018FILE FORMAT ERROR ( SCRNDESC ), FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00019FILE FORMAT ERROR ( SCRNFILE ), FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00020INVALID FILE NAME @@@@@@@@ @@@@@@@@ @@@@@@@@ 00021ITEM LIST OVERFLOW 00022UNEXPECTED EOF, STAT $$$$, FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00023_  __RROR CREATE, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00009FM ERROR DELETE, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00010FM ERROR UPDFCB, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00011SCRNDESC CARD ##### INVALID 00012FM ERROR WRITER, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00013FM ERROR READR , ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00014FM ERROR UPDREC, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00015SCREEN TOO LARGE FOR SCRNFILE RECORD SIZE 00016INVALID ITEM DESCRIPTION 00017FM ERROR GETFCB, ISTAT $$$$ FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00018FILE FORMAT ERROR ( SCRNDESC ), FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00019FILE FORMAT ERROR ( SCRNFILE ), FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00020INVALID FILE NAME @@@@@@@@ @@@@@@@@ @@@@@@@@ 00021ITEM LIST OVERFLOW 00022UNEXPECTED EOF, STAT $$$$, FILE @@@@@@@@ @@@@@@@@ @@@@@@@@ 00023_ (L | *R LIBRARY P(*JOB 00010*K,L14 00020*LIBEDT 00030*R,REBINP,F 00040*R,DTLLST,F 00050*Z 00060*Z 00070*R,LMNENT,F 00080*R,CHGREC,F 00090*R,DL1246,F 00100*R,DTL124,F 00110*R,REBTP1,F 00120*R,DMPSUM,F 00130*R,REBTAP,F 00140*R,CHGKEY,F 00150*R,CCSXTR,F 00160*R,LTRPRX,F 00170*R,DBTREB,F 00180*R,DMPGRP,F 00190*R,MPSLOD,F 00200*R,CACTF,F 00210*R,MPSDMP,F 00220*R,UTFMTB,F 00230*R,LOAD,F 00240*Z 00250*Z 00260_ __EBINP,F 00040*R,DTLLST,F 00050*Z 00060*Z 00070*R,LMNENT,F 00080*R,CHGREC,F 00090*R,DL1246,F 00100*R,DTL124,F 00110*R,REBTP1,F 00120*R,DMPSUM,F 00130*R,REBTAP,F 00140*R,CHGKEY,F 00150*R,CCSXTR,F 00160*R,LTRPRX,F 00170*R,DBTREB,F 00180*R,DMPGRP,F 00190*R,MPSLOD,F 00200*R,CACTF,F 00210*R,MPSDMP,F 00220*R,UTFMTB,F 00230*R,LOAD,F 00240*Z 00250(~). ~z75TFDAYS RWE P( SUBROUTINE DAYS( BUF1,BYT1,BUF2,BYT2,ASCDAY,DCALC ) 00010 + /CALCULATE DAYS DIFFERENCE FOR TWO DATES (RWE) 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 01/13/84 ************ PROGRAMMER : RWE 000901 00100C**** THIS SUBROUTINE WILL CALCULATE THE NUMBER OF DAYS DIFFERENCE 00110C**** FOR TWO DATES. 001201 00130C**** PARAMETERS... 00140C**** 00150C**** BUF1 - BUFFER CONTAINING THE FIRST DATE (PAST DATE) 00160C**** BYT1 - CHARACTER INDEX OF DATE STARTING POSITION IN BUF1 00170C**** BUF2 - BUFFER CONTAINING THE SECOND DATE (LATEST DATE) 00180C**** BYT2 - CHARACTER INDEX OF DATE STARTING POSITION IN BUF2 00190C**** ASCDAY- 3 WORD BUFFER TO RECEIVE # OF DAYS IN ASCII 00200C**** ZERO FILLED RIGHT ADJUSTED. 00210C**** DCALC- FLAG FOR # OF DAYS DIFFERENCE CALCULATION 00220C**** 0 = TOTAL DAYS DIFFERENCE 00230C**** NOT 0 = TOTAL WEEKDAYS DIFFERENCE - NO WEEKEND DAYS 002402 00250 INTEGER BUF1(1),BYT1,BUF2(1),BYT2,ASCDAY(3),DCALC 00260 1, DATE1(3),DATE2(3),DELTA,T1,T2,T3,NDAYS 00270 2, INYR1,INMO1,INDY1,IDYYR1,IDYWK1 00280 3, INYR2,INMO2,INDY2,IDYYR2,IDYWK2 002901 00300 REAL DYCT1,DYCT2 003102 00320C****** START PROGRAM 003301 00340 NDAYS = 0 003501 00360C**** GET FIRST DATE & DO CALC 00370 CALL CCSMVA(BUF1,BYT1,06,DATE1,01,06) 00380 IF ( IDATVR( DATE1, 1 ) .LT. 0 ) GO TO 200 00390C 00400 INMO1 = ICCSAD(DATE1(1)) 00410 INDY1 = ICCSAD(DATE1(2)) 00420 INYR1 = ICCSAD(DATE1(3)) 004301 00440 CALL YMD1 (INYR1,INMO1,INDY1,DYCT1,IDYYR1,IDYWK1) 004501 00460C**** GET SECOND DATE & DO CALC 00470 CALL CCSMVA(BUF2,BYT2,06,DATE2,01,06) 00480 IF ( IDATVR( DATE2, 1 ) .LT. 0 ) GO TO 200 00490C 00500 INMO2 = ICCSAD(DATE2(1)) 00510 INDY2 = ICCSAD(DATE2(2)) 00520 INYR2 = ICCSAD(DATE2(3)) 005301 00540 CALL YMD1 (INYR2,INMO2,INDY2,DYCT2,IDYYR2,IDYWK2) 005502 00560C******* CALCULATE DAYS DIFFERENCE 005701 00580 DELTA = DYCT2 - DYCT1 00590 T1 = DELTA/7 00600 T2 = DELTA - ( T1 * 7 ) 00610 T2 = T2+IDYWK1 00620 IF( DCALC.EQ.2 .AND. IDYWK1.GE.6 ) T2 = T2+1 00630 T3 = 0 00640 DO 150 IL = IDYWK1,T2 00650 IF (IL.EQ.06. OR .IL.EQ.07) T3=T3+1 00660 150 CONTINUE 00670 NDAYS = DELTA - ( T1*2 )-T3 00680 IF ( DCALC .EQ. 0 ) NDAYS = DYCT2 - DYCT1 00690C*** IF ( NDAYS .LT. 0 ) NDAYS = 0 007001 00710C**** NOW CONVERT DAYS TO ASCII 007201 00730 200 CALL HXDEC(NDAYS,ASCDAY) 007401 00750 RETURN 00760 END 00770_   __ (]k ]~-'TFREALN RWE P( SUBROUTINE REALN ( INBF, NCH, ROUT, I2WRD ) 00010 1 /CONVERT ASCII TO REAL - 2 WORD INTEGER SL-*** 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 06/03/83 ************ PROGRAMMER : RWE 000901 00100 INTEGER INBF(1),I2WRD(1),R9SW,RPGSW 00110 DOUBLE PRECISION IDBL,JWK,JXP,J,J10,R2 00120 DATA R9SW /$E3/ 001301 00140C**** CLEAR FTN SCRATCH - DUE TO FTN BUG. 06/83 00150C** 00160C** ENA 0 / STA $C9 00170 ASSEM $0A00, $60C9 00180C*** LDQ LDA STA 00190 ASSEM $E400,+R9SW,$C622,$6400,+RPGSW 002001 00210 J = 0 00220 J10 = 10 00230 ROUT = 0.0 00240 IDBL = 0 00250 DO 100 I = NCH, 1, -1 00260 CALL CCSGET (INBF, I, IWK) 00270 IWK = AND (IWK, $F) 00280 JWK = IWK 00290 JXP = J10**J 00300 IDBL = (JWK * JXP) + IDBL 00310 J = J + 1 00320 100 CONTINUE 00330 ROUT = IDBL 00340 I2WRD(1) = 0 00350 I2WRD(2) = 0 00360 RTMP = ROUT 00370 200 IF ( RTMP.LT.32768.0 ) GOTO 300 00380 IDIV = RTMP/32767.0 00390 I2WRD(1) = IDIV 00400 R2 = IDIV*32767.0 00410 RTMP = RTMP - R2 00420 300 CONTINUE 00430 I2WRD(2) = RTMP 004401 00450C**** RESTORE RPG EXTERNAL SWITCH SETTINGS !! 004601 00470 ASSEM $C400,+RPGSW,$E400,+R9SW,$6622 004801 00490 RETURN 00500 END 00510_  __ ($ $TFYMD1 RWE P,042882( SUBROUTINE YMD1(IYR,IMO,IDYMO,DYCT,IDYYR,IDYWK) 00010C-----INPUTS IYR - YEAR ( 1 TO 99 ) 00020C IMO - MONTH( 1 TO 12 ) 00030C IDYMO - DAY OF MONTH ( 1 TO 31 ) 00040C-----OUTPUTS DYCT - DAY OF CENTURY (FROM JAN 1, 1901) 00050C IDYYR - DAY OF YEAR ( 1 TO 366 ) 00060C IDYWK - DAY OF WEEK ( 1 TO 7, MON IS 1 ) 00070C 00080 LEAPYR = 2 00090 IF ((IYR/4*4).EQ.IYR) LEAPYR = 1 00100 IMT = IMO*275 00110 IMT = IMT/9 00120 IDYYR = IMT+IDYMO-30 00130 IF (IMO.GT.2) IDYYR = IDYYR-LEAPYR 00140 YR=IYR-1 00150 DYYR=IDYYR 00160 TDYCT=YR*1461 00170 DYCT = TDYCT/4+DYYR 00180 DYCT2= DYCT 00190 DNUM=05*1000 00200 DMINUS=7*343 00210 IL = 0 00220 5 IF(DYCT2.LT.DNUM )GO TO 6 00230 IL = IL+1 00240 DYCT2=DYCT2-DMINUS 00250 GO TO 5 00260 6 CONTINUE 00270 IDYCT=DYCT2 00280 DYCT = IL * DMINUS + IDYCT 00290 IDYWK = IDYCT-IDYCT/7*7+1 00300 RETURN 00310 END 00320_ __ IMT = IMT/9 00120 IDYYR = IMT+IDYMO-30 00130 IF (IMO.GT.2) IDYYR = IDYYR-LEAPYR 00140 YR=IYR-1 00150 DYYR=IDYYR 00160 TDYCT=YR*1461 00170 DYCT = TDYCT/4+DYYR 00180 DYCT2= DYCT 00190 DNUM=05*1000 00200 DMINUS=7*343 00210 IL = 0 00220 5 IF(DYCT2.LT.DNUM )GO TO 6 00230 IL = IL+1 00240 DYCT2=DYCT2-DMINUS 00250(/ /TFYMD3 RWE P^( SUBROUTINE YMD3(IYR,IMO,IDYMO,DYCT,IDYYR,IDYWK) 00010C-----INPUTS DYCT - DAY OF CENTURY (FROM JAN 1, 1901) 00020C-----OUTPUTS IYR - YEAR ( 1 TO 99 ) 00030C IMO - MONTH( 1 TO 12 ) 00040C IDYMO - DAY OF MONTH ( 1 TO 31 ) 00050C IDYYR - DAY OF YEAR ( 1 TO 366 ) 00060C IDYWK - DAY OF WEEK ( 1 TO 7, MON IS 1 ) 000701 00080 IMD = DYCT/1461 00090 TDYCT= DYCT-IMD+364 00100 IYR = TDYCT/365 00110 YR = IYR-1 00120 TYDCT = YR*1461 00130 DYCT2 = TYDCT/4 -0.5 00140 DYYR = DYCT - DYCT2 00150 IDYYR = DYYR 00160 LEAPYR = 2 00170 IF ((IYR/4*4).EQ.IYR) LEAPYR = 1 00180 IF (LEAPYR.EQ.1) IDYYR = IDYYR+1 00190 ITEMP = IDYYR 00200 IF (ITEMP.GT.(61-LEAPYR)) ITEMP=ITEMP+LEAPYR 00210 IMO =(ITEMP*9+269)/275 00220 IDYMO= ITEMP-IMO*275/9+30 00230 DYCT2 = DYCT 00240 DNUM = 20*1000 00250 DMINUS= 7*343 00260 5 IF(DYCT2.LT.DNUM) GO TO 10 00270 DYCT2 = DYCT2-DMINUS 00280 GO TO 5 00290 10 CONTINUE 00300 IDYCT = DYCT2 00310 IDYWK= IDYCT-IDYCT/7*7+1 00320 RETURN 00330 END 00340_ __ IDYMO= ITEMP-IMO*275/9+30 00230 DYCT2 = DYCT 00240 DNUM = 20*1000 00250( TFBHXDECRWE P999999( SUBROUTINE BHXDEC (NUM,IOUT) * /HEX TO DECIMAL W/LEADING BLANKS C BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. N=NUM DO 8 JK=1,3 8 IOUT(JK)= $2020 IF(N.EQ.0) IRIGHT(3)=$30 IF(N.GE.0) GO TO 50 C MINUS NUMBER N=-N ILEFT(1)=$2D 50 CONTINUE I=5 55 CONTINUE IF(N.EQ.0) GO TO 200 N1=(N/10)*10 N2=N-N1+$30 I1=I/2+1 IF(AND(I,1).EQ.0) GO TO 100 IRIGHT(I1)=N2 GO TO 110 100 ILEFT(I1)=N2 110 CONTINUE N=N/10 I=I-1 IF(I.GT.0) GO TO 55 200 CONTINUE RETURN END __ DO 8 JK=1,3 8 IOUT(JK)= $2020 IF(N.EQ.0) IRIGHT(3)=$30 IF(N.GE.0) GO TO 50 C MINUS NUMBER N=-N ILEFT(1)=$2D 50 CONTINUE I=5 55 CONTINUE IF(N.EQ.0) GO TO 200 N1=(N/10)*10 N2=N-N1+$30 I1=I/2+1 IF(AND(I,1).EQ.0) GO TO 100 IRIGHT(I1)=N2 GO TO 110 100 ILEFT(I1)=N2 (A\ A~3TFHXDEC RWE P042882( SUBROUTINE HXDEC (NUM,IOUT) 00010 * /DECK-ID E27 ITOS 2.0 SUMMARY-132 00020C CONVERT HEX TO DECIMAL ASCII 00030C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 2.0 00040C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION 1978 00060C 00070C** FUNCTION 00080C -------- 00090CS3 HXDEC CONVERTS A HEXADECIMAL NUMBER INTO AN ASCII 00100C DECIMAL NUMBER. 00110CS5 GENERAL DESCRIPTION 00120C ------------------- 00130CS3 HXDEC BLANKS OUT THE OUTPUT BUFFER, IOUT. THE 00140C SUBROUTINE THEN TESTS THE HEX NUMBER FOR ZERO. IF 00150C THE NUMBER IS ZERO, AN ASCII ZERO IS MOVED TO THE 00160C RIGHT BYTE OF THE THIRD WORD OF IOUT. IF THE 00170C NUMBER IS NOT ZERO AND IS NEGATIVE AN ASCII MINUS 00180C SIGN IS PLACED IN THE LEFT BYTE OF THE FIRST WORD 00190C OF IOUT AND THE HEX NUMBER IS COMPLIMENTED. AT 00200C THIS POINT ANOTHER TEST FOR ZERO IS MADE. IF THE 00210C NUMBER IS ZERO, NO CONVERSION TAKES PLACE, 00220C OTHERWISE THE HEX NUMBER IS CONVERTED TO AN ASCII 00230C DECIMAL NUMBER. 00240CE ENTRY/EXIT 00250C ---------- 00260CS3 HXDEC IS ENTERED WITH THE HEX NUMBER IN NUM AND 00270C EXITS WITH THE CONVERTED NUMBER IN IOUT. 00280C 00290 BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) 00300 DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) 00310C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. 00320 N=NUM 00330 DO 8 JK=1,3 00335 8 IOUT(JK)= $3030 00340 IF(N.EQ.0) IRIGHT(3)=$30 00350 IF(N.GE.0) GO TO 50 00360C MINUS NUMBER 00370 N=-N 00380 ILEFT(1)=$2D 0039050 CONTINUE 00400 I=5 0041055 CONTINUE 00420 IF(N.EQ.0) GO TO 200 00430 N1=(N/10)*10 00440 N2=N-N1+$30 00450 I1=I/2+1 00460 IF(AND(I,1).EQ.0) GO TO 100 00470 IRIGHT(I1)=N2 00480 GO TO 110 00490100 ILEFT(I1)=N2 00500110 CONTINUE 00510 N=N/10 00520 I=I-1 00530 IF(I.GT.0) GO TO 55 00540200 CONTINUE 00550 RETURN 00560 END 00570_ __ CONTINUE 00400 I=5 0041055 CONTINUE 00420 IF(N.EQ.0) GO TO 200 00430 N1=(N/10)*10 00440 N2=N-N1+$30 00450 I1=I/2+1 00460 IF(AND(I,1).EQ.0) GO TO 100 00470 IRIGHT(I1)=N2 00480 GO TO 110 00490(( #2TFICHKZBRWE P( INTEGER FUNCTION ICHKZB(IBUF,ISTRT,IBYTS) 00010 1 /CHECK FIELD FOR ZERO OR BLANK (RWE) SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 04/28/83 ************ PROGRAMMER : RWE 000901 00100C**** THIS FUNCTION WILL CHECK A FIELD TO SEE IF IT IS ZERO 00110C**** OR BLANK, EVEN IF THE ZEROS AND BLANKS ARE INTERMIXED, 00120C**** THE FUNCTION STILL RETURNS A VALUE OF TRUE. 001301 00140C* VARIABLES : IBUF - BUFFER CONTAINING THE FIELD TO CHECK. 00150C* ISTRT - STARTING BYTE WITHIN IBUF. 00160C* IBYTS - NUMBER OF BYTES TO CHECK. 001701 00180C**** RETURN VALUES : ICHKZB = 0 IF TRUE. 00190C* ICHKZB = 1 IF FALSE. 002001 00210 INTEGER IBUF(1),ISTRT,IBYTS,IEND,ICH 002201 00230 ICHKZB = 0 00240 IF(IBYTS.EQ.0) RETURN 00250 IEND = ISTRT + IBYTS -1 002601 00270 DO 20 I = ISTRT, IEND 00280 CALL CCSGET(IBUF, I, ICH) 00290 IF ( ICH.NE.$20 .AND. ICH.NE.$30 ) GO TO 40 00300 20 CONTINUE 00310 RETURN 00320 40 ICHKZB = 1 00330 RETURN 00340 END 00350__* THIS FUNCTION WILL CHECK A FIELD TO SEE IF IT IS ZERO 00110C**** OR BLANK, EVEN IF THE ZEROS AND BLANKS ARE INTERMIXED, 00120C**** THE FUNCTION STILL RETURNS A VALUE OF TRUE. 001301 00140C* VARIABLES : IBUF - BUFFER CONTAINING THE FIELD TO CHECK. 00150C* ISTRT - STARTING BYTE WITHIN IBUF. 00160C* IBYTS - NUMBER OF BYTES TO CHECK. 001701 00180C**** RETURN VALUES : ICHKZB = 0 IF TRUE. 00190C* ICHKZB = 1 IF FALSE. 002001 00210 INTEGER IBUF(1),ISTRT,IBYTS,IEND,ICH 002201 00230 ICHKZB = 0 00240 IF(IBYTS.EQ.0) RETURN 00250(  TFMOD RWE Pd999999042684( INTEGER FUNCTION MOD( NUM,MD ) 00010 1 / MOD FUNCTION 000201 00030 INTEGER NUM,MD,I,J 000401 00050 I = NUM/MD 00060 J = I * MD 00070 MOD = NUM-J 00080 RETURN 00090 END 00100_ __™řș˙ΙљԙיڙݙINPUT RECORD FROM.SELECT RECORD FROM. CONTROL BREAKS. TOTAL CALCULATION.TOTAL OUTPUT. OVERFLOW OUTPUT.GET INPUT FIELDS. DETAIL CALCULATION. DETAIL OUTPUT.PRINT RECORD ON.WRITE RECORD ON.ADD RECORD TO.UPDATE RECORD ON. LAST RECORD CALCULATION.(1G 1dTFSTIME RWE Ph( SUBROUTINE STIME 00010 1 /CCS 3.0 TIME CHECK SUBROUTINE 00020C 00030C 00040 INTEGER ID(4),LU(1),MODE(1),PORT(1) 00050 INTEGER DY(5,7),MO(5),TU(5),WE(5),TH(5),FR(5),SA(5),SU(5) 00060 EQUIVALENCE (DY(1,1),MO(1)),(DY(1,2),TU(1)),(DY(1,3),WE(1)) 00070 EQUIVALENCE (DY(1,4),TH(1)),(DY(1,5),FR(1)) 00080 EQUIVALENCE (DY(1,6),SA(1)),(DY(1,7),SU(1)) 00090 DATA MO/'MONDAY '/,TU/'TUESDAY '/,WE/'WEDNESDAY '/ 00100 DATA TH/'THURSDAY '/,FR/'FRIDAY '/,SA/'SATURDAY '/ 00110 DATA SU/'SUNDAY '/ 00120C 00130 EXTERNAL AYERTO,AMONTO,ADAYTO,HORTO,MINTO,SECON 00140 EXTERNAL YERTO,MONTO,DAYTO 00150 IYR=AND(AYERTO,$FFFF) 00160 IMN=AND(AMONTO,$FFFF) 00170 IDY=AND(ADAYTO,$FFFF) 00180 IHR=AND(HORTO,$FFFF) 00190 IMI=AND(MINTO,$FFFF) 00200 ISC=AND(SECON,$FFFF) 00210 INYR=AND(YERTO,$FFFF) 00220 INMO=AND(MONTO,$FFFF) 00230 INDY=AND(DAYTO,$FFFF) 00240C 00250 CALL PGMIN(ID,LU,MODE,PORT) 00260C 00270 CALL YMD1(INYR,INMO,INDY,DYCT,IDYYR,IWK) 00280C 00290 WRITE(5,100)(DY(M,IWK),M=1,5),IMN,IDY,IYR,IHR,IMI,ISC, 00300 + (ID(I),I=1,4) 00310 100 FORMAT(/,5A2,X,A2,'/',A2,'/',A2,2X,I2,':',I2,':',I2,3X,'ID=',4A2) 00320C 00330C 00340 RETURN 00350 END 00360_ 00370 00380 00390 00400 00410 00420 00430 00440 00450 00460 00470 00480 00490__ 00250(3 3TFTIMDIFRWE P999999( SUBROUTINE TIMDIF(TRAN,RECV,DIF,TOTMIN ) 000101 00020 INTEGER TRAN(3), RECV(3), DIF(4), TOTMIN 00030 INTEGER H1,H2,H3, M1,M2,M3, S1,S2,S3 00040 INTEGER T, C 000501 00060 T(JCH)=(JCH/$0100-1R0)*10+AND(JCH-1R0,$00FF) 00070 C(NUM)=(NUM/10+1R0)*$0100+MOD(NUM,10)+1R0 000801 00090 DO 100 I=1,6 00100 CALL CCSGET(TRAN,I,ICH) 00110 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,TRAN) 00120 CALL CCSGET(RECV,I,ICH) 00130 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,RECV) 00140 100 CONTINUE 001501 00160 H1=T(TRAN(1)) 00170 M1=T(TRAN(2)) 00180 S1=T(TRAN(3)) 001901 00200 H2=T(RECV(1)) 00210 M2=T(RECV(2)) 00220 S2=T(RECV(3)) 002301 00240 ITIME=H1*60+M1 00250 JTIME=H2*60+M2 00260 IF ( ITIME.LT.JTIME ) GOTO 200 00270 IF ( (S1.LE.S2) .AND. (ITIME.EQ.JTIME) ) GOTO 200 00280 H2=H2+24 002901 00300 200 S3=S2-S1 00310 IF ( S3.GE.0 ) GOTO 220 00320 S3=S3+60 00330 M2=M2-1 003401 00350 220 M3=M2-M1 00360 IF ( M3.GE.0 ) GOTO 240 00370 M3=M3+60 00380 H2=H2-1 003901 00400 240 H3=H2-H1 00410 TOTMIN = H3*60+M3 00420 DIF(1)=C(H3) 00430 DIF(2)=2H: 00440 DIF(3)=2H : 00450 CALL CCSMVA( C(M3),1,2,DIF,4,2 ) 00460 DIF(4)=C(S3) 00470 RETURN 00480 END 00490_  __ IF ( ITIME.LT.JTIME ) GOTO 200 00270 IF ( (S1.LE.S2) .AND. (ITIME.EQ.JTIME) ) GOTO 200 00280 H2=H2+24 002901 00300 200 S3=S2-S1 00310 IF ( S3.GE.0 ) GOTO 220 00320 S3=S3+60 00330 M2=M2-1 003401 00350 220 M3=M2-M1 00360 IF ( M3.GE.0 ) GOTO 240 00370 M3=M3+60 00380 H2=H2-1 003901 00400 240 H3=H2-H1 00410 TOTMIN = H3*60+M3 00420 DIF(1)=C(H3) 00430 DIF(2)=2H: 00440 DIF(3)=2H : 00450 CALL CCSMVA( C(M3),1,2,DIF,4,2 ) 00460 DIF(4)=C(S3) 00470 RETURN 00480 END 00490_ (b {WSI. WEAVE P042882(*JOB,, INSTALL CORRECTIONS ##/##/## # 00010*K,L14 00020$$TWABSOIN,WEAVE,,@@@@@@@@,&&&&&&&& @&00030*CTO, 00040*CTO, INSTALL C O M P L E T E !!! 00050*Z 00060_ __h" @$T hh $@ D  h TX hh hyӠ"=hhҐhhTh Tؿȷ/ @ TȶT @T ON OFF (1;BJRYbnxz}™řș˙ΙљԙיڙݙINPUT RECORD FROM.SELECT RECORD FROM. CONTROL BREAKS. TOTAL CALCULATION.TOTAL OUTPUT. OVERFLOW OUTPUT.GET INPUT FIELDS. DETAIL CALCULATION. DETAIL OUTPUT.PRINT RECORD ON.WRITE RECORD ON.ADD RECORD TO.UPDATE RECORD ON. LAST RECORD CALCULATION.({/ ~ TWRPGIN WEAVE P999999(*CTO, INSTALLING @@@@@@@@ FROM B.@@@@@@@@, &&&&&&&& FILE @& *OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,R @& *REW,21,7 *K,L14 *LIBEDT *K,I21,P8 *P,F,2,RPGFIL *K,I13 *K,I8 *N,@@@@@@,,,B @ *Z *CLOSE *CTO, PROGRAM @@@@@@@@ HAS BEEN INSTALLED @ *CTO, __ __h" @$T hh $@ D  h TX hh hyӠ"=hhҐhhTh Tؿȷ/ @ TȶT @T ON OFF (1;BJRYbnxz}™řș˙ΙљԙיڙݙINPUT RECORD FROM.SELECT RECORD FROM. CONTROL BREAKS. TOTAL CALCULATION.TOTAL OUTPUT. OVERFLOW OUTPUT.GET INPUT FIELDS. DETAIL CALCULATION. DETAIL OUTPUT.PRINT RECORD ON.WRITE RECORD ON.ADD RECORD TO.UPDATE RECORD ON. LAST RECORD CALCULATION.(- ^TWDUMMY WEAVE PF(?????? DCK/ I=13,H ? 00010?????? HOL/ ? 00020 SUBROUTINE ?????? ? 00030 1 /A01 F CCS CCS 3.0 DUMMY SL-173 00040 RETURN 00050 END 00060 END/ 00070_ __ __h" @$T hh $@ D  h TX hh hyӠ"=hhҐhhTh Tؿȷ/ @ TȶT @T ON OFF (1;BJRYbnxz}™řș˙ΙљԙיڙݙINPUT RECORD FROM.SELECT RECORD FROM. CONTROL BREAKS. TOTAL CALCULATION.TOTAL OUTPUT. OVERFLOW OUTPUT.GET INPUT FIELDS. DETAIL CALCULATION. DETAIL OUTPUT.PRINT RECORD ON.WRITE RECORD ON.ADD RECORD TO.UPDATE RECORD ON. LAST RECORD CALCULATION.(}7 y TWB.JOB WEAVE Px042882(*JOB,,TWB.JOB @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.@@@@@@@@ , &&&&&&&& @&00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,W @&00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120_ __,,TWB.JOB @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.@@@@@@@@ , &&&&&&&& @&00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,W @&00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120_ ( wyTWFBEND WEAVE PZ042882( END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*EOF 00050*CLOSE 00060*K,I13,L14 00070*Z 00080*Z 00090_ __ ( wyTWABEND WEAVE P042882( END/ 00010*REW,7 00020*K,I7,P21,L14 00030*ASSEM 00040*EOF 00050*CLOSE 00060*K,I13,L14 00070*Z 00080*Z 00090_ __ ( wy TWBNJOB WEAVE Px042882(*JOB,, @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BN@@@@@@@@, &&&&&&&& @&00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BN@@@@@@,OW=&&&&&&&&,LU=21,W @&00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120_ __,, @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BN@@@@@@@@, &&&&&&&& @&00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BN@@@@@@,OW=&&&&&&&&,LU=21,W @&00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120_ ( wyTWFBINS WEAVE PP042882( END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*REW,7,20 00050*K,I13,L2 00060*CSY,I20,P7 00070*COSY 00080_ __ ( wyTWABINS WEAVE P042882( END/ 00010*REW,7 00020*K,I7,P21,L14 00030*ASSEM 00040*REW,7,20 00050*K,I13,L2 00060*CSY,I20,P7 00070*COSY 00080_ __ ( z8 TWBF.JOBWEAVE Px(*JOB,, @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.@@@@@@@@ @ 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,W @&00080*OPEN,FN=DCOSY,OW=CCS149,LU=22,W 00081*OPEN,FN=L14,OW=CCS149,LU=23,W 00082*REW,20,21,22,23 00090*K,I13 00100*CSY,I20,P22 00110*COSY 00120_ __ (l gWSI.BN WEAVE P<(*JOB,, INSTALL CORRECTIONS ##/##/## # 00010*K,L14 00020$$TWRELOIN,WEAVE,,@@@@@@@@,&&&&&&&& @&00030*CTO, 00040*CTO, INSTALL C O M P L E T E !!! 00050*Z 00060_ __ __ (|s epWSRELOINWEAVE P999999092082($$TWRELOIN,WEAVE,,@@@@@@@@,&&&&&&&& @&00010*Z 00020 __, 00040*CTO, INSTALL C O M P L E T E !!! 00050*Z 00060_ __ __ ( dc TWABSOINWEAVE P042882(*CTO, INSTALLING @@@@@@@@ FROM B.@@@@@@@@, &&&&&&&& FILE @&00020*OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,R @&00030*REW,21 00040*K,L14 00050*LIBEDT 00060*K,I21,P8 00070*P,F,2 00080*K,I8 00090*N,@@@@@@,,,B @ 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM @@@@@@@@ HAS BEEN INSTALLED @ 00140*CTO, 00150_ __ __ ( WSI.RPG WEAVE P999999(*JOB,, INSTALL CORRECTIONS ##/##/## # 00010*K,L14 00020$$TWRPGIN,WEAVE,,@@@@@@@@,&&&&&&&& @&00030*CTO, 00040*CTO, INSTALL C O M P L E T E !!! 00050*Z 00060__,2 00080*K,I8 00090*N,@@@@@@,,,B @ 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, PROGRAM @@@@@@@@ HAS BEEN INSTALLED @ 00140*CTO, 00150_ __ __ (K ^v TWRELOINWEAVE P042882(*CTO, INSTALLING @@@@@@@@ FROM BN@@@@@@@@, &&&&&&&& FILE @&00010*OPEN,FN=BN@@@@@@,OW=&&&&&&&&,LU=21,R @&00020*REW,21 00030*K,L14 00040*LIBEDT 00050*K,I21,P8 00060*L,@@@@@@ @ 00070*Z 00080*K,I13 00090*CLOSE 00100*CTO, SUBROUTINE @@@@@@@@ HAS BEEN INSTALLED @ 00110*CTO, 00120_ __ __ ( p [TW@PRTUSWEAVE Pd(INPUT=PROC 00010WEAVE 00020@@@@@@@@,&&&&&&&& @&00030Q.PRINT,DOCS 00040INPUT=PROC 00050UNSEQ 00060Q.PRINT,DOCS,,U 00070INPUT=PROC 00080PRINT 00090Q.PRINT,DOCS,,00001,T 00100_ __ __ __ ({ ATWFFBINSWEAVE PP( END/ 00010*REW,22 00020*K,I22,P21,L23 00030*FTN 00040*REW,22,20 00050*K,I13,L2 00060*CSY,I20,P22 00070*COSY 00080_ __ __ __ ({# ATWFFBENDWEAVE P( END/ 00010*REW,22 00020*K,I22,P21,L23 00030*FTN 00040*EOF 00050*CLOSE 00060*K,I13,L14 00070*Z 00080*Z 00090_ __ __ __ ({, ATWAFBINSWEAVE PP( END/ 00010*REW,22 00020*K,I22,P21,L23 00030*ASSEM 00040*REW,22,20 00050*K,I13,L2 00060*CSY,I20,P22 00070*COSY 00080_ __ __ __ __ (] TWABINSLWEAVE P999999( END/ 00010*REW,7 00020*K,I7,P21,L14 00030*ASSEM 00040*REW,7,20,22 00050*K,I13,L14 00060*CSY,I22,P7 00070*COSY 00080__ __ __ __ __ ( mj ~TWB.JOBLWEAVE P999999(*JOB,,TWB.JOBL @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.@@@@@@@@ , &&&&&&&& @&00050*K,L2 00060*OPEN,FN=C.LAAP31,OW=LA173,LU=20,R 00070*OPEN,FN=C.CCSAP,OW=CCS149,LU=22,R 00080*OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,W @&00090*REW,20,21,7 00100*K,I13 00110*CSY,I22,P7 00120*COSY 00130__ __ __ __ __ (G1 {TWB.RJOBWEAVE P999999(*JOB,,TWB.RJOB @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.@@@@@@@@ , &&&&&&&& @&00050*K,L2 00060*OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,W @&00070*REW,21 00080*K,I13,L14,P21 00090*RPGII 00100$$TR@@@@@@,&&&&&&&&,80 &@ 00110*RBDPCH 00130*EOF 00140*CTO, 00150*CTO, @@@@@@@@ COMPILE COMPLETE READY FOR INSTALL.... @ 00160*CTO, 00170*Z 00180*Z 00190__ __ __ __ (% TW@PRINTWEAVE P999999(INPUT=PROC 00010PRINT 00020@@@@@@@@,&&&&&&&&,,00001,P @&00030__, 00040*CTO, IS NOW BEING COMPILED TO B.@@@@@@@@ , &&&&&&&& @&00050*K,L2 00060*OPEN,FN=B.@@@@@@,OW=&&&&&&&&,LU=21,W @&00070*REW,21 00080*K,I13,L14,P21 00090*RPGII 00100$$TR@@@@@@,&&&&&&&&,80 &@ 00110*RBDPCH 00130*EOF 00140*CTO, 00150*CTO, @@@@@@@@ COMPILE COMPLETE READY FOR INSTALL.... @ 00160*CTO, 00170*Z 00180*Z 00190__ __ __ __ (] TWFBINSLWEAVE P999999( END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*REW,7,20,22 00050*K,I13,L14 00060*CSY,I22,P7 00070*COSY 00080__13,L14,P21 00090*RPGII 00100$$TR@@@@@@,&&&&&&&&,80 &@ 00110*RBDPCH 00130*EOF 00140*CTO, 00150*CTO, @@@@@@@@ COMPILE COMPLETE READY FOR INSTALL.... @ 00160*CTO, 00170*Z 00180*Z 00190__ __ __ __ (  TWBNJOBLWEAVE P(*JOB,,TWBNJOBL @@@@@@@@ INSTALL ##/##/## #@ 00010*K,L14 00020*CTO, @@@@@@@@ WEAVED AS OF ##/##/## #@ 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BN@@@@@@@@ , &&&&&&&& @&00050*K,L2 00060*OPEN,FN=C.LAAP31,OW=LA173,LU=20,R 00070*OPEN,FN=C.CCSAP,OW=CCS149,LU=22,R 00080*OPEN,FN=BN@@@@@@,OW=&&&&&&&&,LU=21,W @&00090*REW,20,21,7 00100*K,I13 00110*CSY,I22,P7 00120*COSY 00130_ __ 00180*Z 00190__ __ __ __ (B_- BU.*TB. CCS149 P00O!h)h/)h-)h+00h#h#h# h$h zV[s` pCX X_X000000082784($$TW*TBN,CCS149,,CCSADD,CCS149 $$TW*TBN,CCS149,,CCSDVD,CCS149 $$TW*TBN,CCS149,,CCSEAC,CCS149 $$TW*TBN,CCS149,,CCSMTP,CCS149 $$TW*TBN,CCS149,,CCSSBT,CCS149 $$TW*TBN,CCS149,,EDIT,CCS149 $$TW*TBN,CCS149,,FILERR,CCS149 $$TW*TBN,CCS149,,FTNDT1,CCS149 $$TW*TBN,CCS149,,GETGRP,CCS149 $$TW*TBN,CCS149,,GETSW,CCS149 $$TW*TBN,CCS149,,GETUTI,CCS149 $$TW*TBN,CCS149,,GTSYSP,CCS149 $$TW*TBN,CCS149,,ICKGRP,CCS149 $$TW*TBN,CCS149,,LTPRNT,CCS149 $$TW*TBN,CCS149,,PRTORF,CCS149 $$TW*TBN,CCS149,,QCST,CCS149 $$TW*TBN,CCS149,,SYSPRT,CCS149 $$TW*TBN,CCS149,,UTHEAD,CCS149 $$TW*TBN,CCS149,,VFYACF,CCS149 $$TW*TB.,CCS149,,ACTADD,CCS149 $$TW*TB.,CCS149,,ACTMTN,CCS149 $$TW*TB.,CCS149,,AVMCON,CCS149 $$TW*TB.,CCS149,,CCSDMP,CCS149 $$TW*TB.,CCS149,,CCSSPC,CCS149 $$TW*TB.,CCS149,,CHEKID,CCS149 $$TW*TB.,CCS149,,CHUPD2,CCS149 $$TW*TB.,CCS149,,CMPACC,CCS149 $$TW*TB.,CCS149,,COLCHG,CCS149 $$TW*TB.,CCS149,,COLECT,CCS149 $$TW*TB.,CCS149,,COLSTS,CCS149 $$TW*TB.,CCS149,,CPYIND,CCS149 $$TW*TB.,CCS149,,DALIST,CCS149 $$TW*TB.,CCS149,,DECMTN,CCS149 $$TW*TB.,CCS149,,DHUPDT,CCS149 $$TW*TB.,CCS149,,DMPFIL,CCS149 $$TW*TB.,CCS149,,FIXINA,CCS149 $$TW*TB.,CCS149,,LODFIL,CCS149 $$TW*TB.,CCS149,,LTRBLD,CCS149 $$TW*TB.,CCS149,,LTRPRT,CCS149 $$TW*TB.,CCS149,,LTRSTA,CCS149 $$TW*TB.,CCS149,,MHUPDT,CCS149 $$TW*TB.,CCS149,,NEWS,CCS149 $$TW*TB.,CCS149,,NMCHNG,CCS149 $$TW*TB.,CCS149,,PGGEN,CCS149 $$TW*TB.,CCS149,,PHDEL1,CCS149 $$TW*TB.,CCS149,,PHDEL2,CCS149 $$TW*TB.,CCS149,,PRETSR,CCS149 $$TW*TB.,CCS149,,PROVE,LIBRARY $$TW*TB.,CCS149,,PRTSCN,CCS149 $$TW*TB.,CCS149,,QLOAD,CCS149 $$TW*TB.,CCS149,,REBILD,LIBRARY $$TW*TB.,CCS149,,RSWCHG,CCS149 $$TW*TB.,CCS149,,SRREQ,CCS149 $$TW*TB.,CCS149,,SUMACL,CCS149 $$TW*TB.,CCS149,,SWITCH,CCS149 $$TW*TB.,CCS149,,TIMUSE,CCS149 $$TW*TB.,CCS149,,TRENDF,CCS149 $$TW*TB.,CCS149,,TRENDP,CCS149 $$TW*TB.,CCS149,,TRNPLY,CCS149 $$TW*TB.,CCS149,,UPD400,CCS149 $$TW*TB.,CCS149,,UPD500,CCS149 $$TW*TB.,CCS149,,UPDATE,CCS149 $$TW*TB.,CCS149,,USEMTN,CCS149 $$TW*TB.,CCS149,,UTFMTN,CCS149 $$TW*TB.,CCS149,,WRTOFE,CCS149 $$TW*TB.,CCS149,,WRTOFP,CCS149 __*TB.,CCS149,,NEWS,CCS149 $$TW*TB.,CCS149,,NMCHNG,CCS149 $$TW*TB.,CCS149,,PGGEN,CCS149 $$TW*TB.,CCS149,,PHDEL1,CCS149 $$TW*TB.,CCS149,,PHDEL2,CCS149 $$TW*TB.,CCS149,,PRETSR,CCS149 $$TW*TB.,CCS149,,PROVE,LIBRARY $$TW*TB.,CCS149,,PRTSCN,CCS149 $$TW*TB.,CCS149,,QLOAD,CCS149 ( L xJ.FIXINACCS149 P(*JOB,,TWB.JOB FIXINA INSTALL 08/23/84 00010*K,L14 00020*CTO, FIXINA WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.FIXINA , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.FIXINA,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120FIXINA DCK/ I=13,H 00130FIXINA HOL/ 00140 PROGRAM FIXINA 00150 1 /FIX INACCT FILE (NYGSBC) 10/81. LKL07 01/84 001601 00170C** CYBERCREDIT FINANCIAL SERVICES. 00180C** CYBERCREDIT FIELD SUPPORT GROUPS 00190C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00200C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00210C** 00220C** ************ 12/21/83 ************ PROGRAMMER : RWE 002301 00240C*** REBUILD INACCT FILE : 00250C FIRST CLEAR THE INACCT FILE THEN 00260C READ THE DELQMST FILE AND CREATE A NEW 00270C RECORD FOR EVERY INACTIVE ACCOUNT AND STORE 00280C IT IN THE INACCT FILE. IF THE DATE THE ACCT. 00290C WENT INACTIVE IS INVALID THEN USE TODAYS DATE. 003001 00310 EXTERNAL FMRDEL,FMEOFC 00320 INTEGER FMRDEL,FDEL,FMEOFC,FEOF 003301 00340 INTEGER DLQREC(11004),DLQREQ(24),DDATA(15),DATE(6),KEY(15) 00350 +, INAREC(292),INAREQ(24),IDATA(15),IDUSER(4),FREQ 00360 +, RSWCT(3), RSW(3),DST,IST,EOF,STATCD,DQ(4),LA(4) 00370 +, MSBCT(3), MSG(8) 003801 00390 EQUIVALENCE ( DLQREQ(15), NUMREC ) 004001 00410 DATA RSW/$0052,$0053,$0057/, RSWCT/3*0/,DQ/'DELQMST '/ 00420 +, DLQREQ, INAREQ/48*0/,LA/'LA '/,EOF/0/ 00430 +, DDATA/'LADLQMST',' ',4*$2020,0,11,0/ 00440 +, IDATA/'LAINACCT',' ',4*$2020,0,1,-1/ 00450 +, MSBCT/ 3*0/, MSG/$0D0A,' X - '/ 004602 00470C**** BEGIN REBIULD OF THE INACCT FILE ....... 004801 00490 ASSEM $C000,FMRDEL,$6800,FDEL 00500 ASSEM $C000,FMEOFC,$6800,FEOF 005101 00520 CALL PGMIN(IDUSER,LUNIT,IMODE,NOPORT) 00530 CALL CCSCST(IDUSER,1,8,LA,1,8,ICM) 00540 IF(ICM.EQ.0) GO TO 5 00550 CALL CCSMVA(DQ,1,8,DDATA,1,8) 00560 CALL CCSMVA(IDATA,3,6,IDATA,1,8) 00570 5 CONTINUE 00580 ASSIGN 9000 TO IABORT 00590 CALL PGMINT(IABORT,KK) 006001 00610C*** FIRST PICK UP THE SYSTEM DATE. 00620 CALL UTHEAD( DLQREC, DATE ) 006301 00640 FREQ=1 00650 CALL CLEAR(INAREQ,IDATA,ISTAT) 00660 IF(ISTAT.LT.0)GO TO 7100 00670 DO 50 IZ=1,24 00680 50 INAREQ(IZ)=0 00690 FREQ = 3 00700 CALL OPENFL(INAREQ,IDATA,ISTAT) 00710 IF (ISTAT .LT. 0) GOTO 7100 00720 CALL OPENFL(DLQREQ,DDATA,ISTAT) 00730 IF (ISTAT .LT. 0) GOTO 7000 00740 DLQREQ(23) = 1 00750 CALL LOKFIL(DLQREQ,JSTAT) 007601 00770 100 CONTINUE 00780 CALL GETS(DLQREQ,DLQREC,KEY ,ISTAT) 00790 IF(AND(ISTAT,$8100).EQ.$8100) GO TO 9000 00800 IF (AND(ISTAT,$0100) .EQ. $0100) EOF = 1 00810 IF (AND(ISTAT,$0100) .EQ. $0100) GO TO 150 00820 FREQ = 14 00830 IF (ISTAT .LT. 0) GOTO 7000 008401 00850 150 CONTINUE 00860 INRECS = 0 00870 DO 500 LOOP = 1,NUMREC 00880 DST = 1000*LOOP-999 00890 IF (DLQREC(DST) .EQ. FDEL) GO TO 500 00900 IF (DLQREC(DST) .EQ. FEOF) GO TO 500 009101 00920 CALL CCSGET(DLQREC(DST),306,STATCD) 009301 00940C CHECK STATUS CODE FOR R,S, OR W 00950 DO 200 I = 1,3 00960 IF (STATCD .EQ. RSW(I)) GOTO 300 00970 200 CONTINUE 00980 GOTO 500 00990 300 CONTINUE 01000 INRECS=INRECS+1 01010 IST = 12*INRECS-11 010201 01030 RSWCT(I) = RSWCT(I)+1 010401 01050C*** MSB MODULO 30,000 FOR DOUBLE PRECISION 01060 IF ( RSWCT(I).LT.30000 ) GO TO 310 01070 RSWCT(I) = 0 01080 MSBCT(I) = MSBCT(I) + 1 01090 310 CONTINUE 011001 01110 CALL CCSBLK(INAREC(IST),24) 01120 CALL CCSMVA(DLQREC(DST),1,16,INAREC(IST),1,16) 01130 CALL CCSPUT(STATCD,17,INAREC(IST)) 01140 CALL CCSPUT( $50 ,18,INAREC(IST)) 01150 CALL CCSMVA(DLQREC(DST),857,6,INAREC(IST),19,6) 011601 01170C**** VERIFY DATE ACCOUNT LAST UPDATED FROM HOST 01180 IOK = IDATVR( DLQREC(DST), 857 ) 01190 IF ( IOK.LT.0 ) CALL CCSMVA(DATE,1,6,INAREC(IST),19,6) 01200 IF ( IOK.LT.0 ) CALL CCSMVA(DATE,1,6,DLQREC(DST),857,6) 012101 01220 500 CONTINUE 01230 IF (INRECS.EQ.0)GO TO 550 01240 CALL PUTS(INAREQ,INAREC,INRECS,ISTAT) 01250 FREQ = 11 01260 IF (ISTAT.LT.0) GO TO 7100 01270 550 CONTINUE 01280 IF(JSTAT.LT.0) GO TO 560 01290 CALL UPDREC(DLQREQ,DLQREC,ISTAT) 01300 IF (ISTAT.GE.0) GO TO 560 01310 FREQ = 15 01320 GO TO 7000 013301 01340 560 CONTINUE 01350 IF (EOF.EQ.1)GO TO 9000 01360 GO TO 100 013701 01380C**** ERROR REPORTING......... 01390 7000 CONTINUE 01400 CALL FILERR(DDATA,FREQ,ISTAT,LUNIT) 01410 GOTO 9500 01420 7100 CONTINUE 01430 CALL FILERR(IDATA,FREQ,ISTAT,LUNIT) 01440 GOTO 9500 014501 01460C**** DISPLAY TOTALS AND THEN END..... 014701 01480 9000 CONTINUE 01490 DO 9050 I = 1,3 015001 01510 CALL CCSPUT( RSW(I), 4, MSG ) 01520 CALL HXDEC ( RSWCT(I), MSG(5)) 01530 IF ( MSBCT(I).EQ.0 ) GO TO 9010 01540 MSG(5) = $2030 + MSBCT(I)*3 + AND( MSG(5), $F ) 01550 9010 CONTINUE 01560 CALL WTREAD(05,-1,MSG,16,0,0,0,ITC) 01570 9050 CONTINUE 01580 CALL WTREAD(05,-1,MSG,02,0,0,0,ITC) 015901 01600 9500 CONTINUE 01610 CALL CLOSFL(DLQREQ,ISTAT) 01620 CALL CLOSFL(INAREQ,ISTAT) 01630 CALL PGMOUT 01640 END 01650 END/ 01660HXDEC DCK/ I=13,H 01670HXDEC HOL/ 01680 SUBROUTINE HXDEC (NUM,IOUT) 01690 * /DECK-ID E27 ITOS 2.0 SUMMARY-132 01700C CONVERT HEX TO DECIMAL ASCII 01710C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 2.0 01720C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 01730C COPYRIGHT CONTROL DATA CORPORATION 1978 01740C 01750C** FUNCTION 01760C -------- 01770CS3 HXDEC CONVERTS A HEXADECIMAL NUMBER INTO AN ASCII 01780C DECIMAL NUMBER. 01790CS5 GENERAL DESCRIPTION 01800C ------------------- 01810CS3 HXDEC BLANKS OUT THE OUTPUT BUFFER, IOUT. THE 01820C SUBROUTINE THEN TESTS THE HEX NUMBER FOR ZERO. IF 01830C THE NUMBER IS ZERO, AN ASCII ZERO IS MOVED TO THE 01840C RIGHT BYTE OF THE THIRD WORD OF IOUT. IF THE 01850C NUMBER IS NOT ZERO AND IS NEGATIVE AN ASCII MINUS 01860C SIGN IS PLACED IN THE LEFT BYTE OF THE FIRST WORD 01870C OF IOUT AND THE HEX NUMBER IS COMPLIMENTED. AT 01880C THIS POINT ANOTHER TEST FOR ZERO IS MADE. IF THE 01890C NUMBER IS ZERO, NO CONVERSION TAKES PLACE, 01900C OTHERWISE THE HEX NUMBER IS CONVERTED TO AN ASCII 01910C DECIMAL NUMBER. 01920CE ENTRY/EXIT 01930C ---------- 01940CS3 HXDEC IS ENTERED WITH THE HEX NUMBER IN NUM AND 01950C EXITS WITH THE CONVERTED NUMBER IN IOUT. 01960C 01970 BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) 01980 DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) 01990C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. 02000 N=NUM 02010 DO 8 JK=1,3 02020 8 IOUT(JK)= $3030 02030 IF(N.EQ.0) IRIGHT(3)=$30 02040 IF(N.GE.0) GO TO 50 02050C MINUS NUMBER 02060 N=-N 02070 ILEFT(1)=$2D 0208050 CONTINUE 02090 I=5 0210055 CONTINUE 02110 IF(N.EQ.0) GO TO 200 02120 N1=(N/10)*10 02130 N2=N-N1+$30 02140 I1=I/2+1 02150 IF(AND(I,1).EQ.0) GO TO 100 02160 IRIGHT(I1)=N2 02170 GO TO 110 02180100 ILEFT(I1)=N2 02190110 CONTINUE 02200 N=N/10 02210 I=I-1 02220 IF(I.GT.0) GO TO 55 02230200 CONTINUE 02240 RETURN 02250 END 02260 END/ 02270 END/ 02280*REW,7 02290*K,I7,P21,L14 02300*FTN 02310*EOF 02320*CLOSE 02330*K,I13,L14 02340*Z 02350*Z 02360__ IF(N.EQ.0) GO TO 200 02120 N1=(N/10)*10 02130 N2=N-N1+$30 02140 I1=I/2+1 02150 IF(AND(I,1).EQ.0) GO TO 100 02160 IRIGHT(I1)=N2 02170 GO TO 110 02180100 ILEFT(I1)=N2 02190110 CONTINUE 02200 N=N/10 02210 I=I-1 02220 IF(I.GT.0) GO TO 55 02230200 CONTINUE 02240 RETURN 02250<' Y !9jB.INSTALCCS149 x999999082784< PCCSADD A02 A CCS CCS 3.0 PSR'D SL-149@PHh HX  }hH 9 " :  0n@P+  d 0fhIIccZY TR NhQHQ 9 " : @PV 0A  d 09hLL44- L@P  5`2h`P@P4 `"i PCCSADDP PCCSDVD A02 A CCS CCS 3.0 SL-149@PHh HXz us ohsHr = 9  }  0_@P+hII\\SR MK GhJHJ = 9  }  09hL@PVL44-  L  @P5`2y`P @PE `"i PCCSDVDP P;CCSEAC A05 A CCS CCS 3.0 PSR'D SL-149@PX";h1 h0 Xh( @h'# "``HH" H@P+ `"i ]@PV [.<(+^&!$*);\-/,%_>?:#@'="@P0ABCDEFGHI}JKLMNOPQR@PSTUVWXYZ0123456789@Z{[lP}M]\Nk`Ka@Pz^L~no|J_'Om@P@P-PCCSE2ACCSA2E P PCCSMTP A02 A CCS CCS 3.0 SL-149@PHh HXz us ohsHr = 9  }  0_@P+h  \\SR MK GhJHJ = 9  }  09h @PV 44-    @P5`2y`P @PE `"i PCCSMTPP PCCSSBT A02 A CCS CCS 3.0 SL-149@PHh HXz us ohsHr = 9  }  0_@P+hII\\SR MK GhJHJ = 9  }  09hL@PVL44-  L  @P5`2y`P @PE `"i PCCSSBTP PEDIT B50 F CCS CCS 3.0 PSrPD SL-149@P @P9 -0@P99/99/9999999.999/999-9999-99-9999@P/ /"+ "&h h hh!+ΈhT`.ۘ   hT@PZ.`@Pbh\`.h\.`ػػ@Pt V hȝ!h\`.Ȩ ׈h\`؜h\,. 1@P I.8 l\., \,,\, \, l\.,\@P,#H TTh\h\hhhhhhhhhhh\hu\hp>PEDIT PQ8PKUPQ8PREPCCSGETNCCSPUTZP PFILERR B52 F CCS CCS 3.1 10-23-81 SL-149@P@Pr@Pt $@Pv@P FILE MANAGER ERROR: FILE NAME = 12345678, REQUEST = 123456, ISTAT = 1234. @PlK@Pm#7G@P3CREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEVOLUSEPUTS WRITERREADR GE@P^TS UPDRECDELRECCOMFIL123456@Pp7@P( CR TO CONTINUE@Pq@PxTrmr7h 3 -3 hTs@Pj h ( h\3uvnv\%Twlu\w(qw0u@PHTTh\h\h\hhPFILERRPQ8PKUPQ8PREPCCSMVAyCCSHXAWTREADP PFTNDT1 F CCS CCS 3.0 1500 WD TBL SL-149 @P@P@P@P@P@P99@P h h6 fT k h dTh h@P0!(TȿhȢ  (hT@PG (h ș j (hȒjت@PZT  \Ș #T d\ 6@P ll@PHTT h\h hdPFTNDT1PQ8PKUPQ8PREPRTVDT1GTSDT1&GPMDT14TVPDT1DTRHDT1[VALDT1pP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVAJ \!H\ H  l\@PHF\\J \H\ H  l\HF\\J Ti@PH\H l\HF\!HT\ d d  d@P)d $ d $ ddTID   6  d@PT!fT ̾dܹܺ\ l̺ h T@P@P l" ̗n\ Z̏l d̒ h\̈l\@P̯ d\̦l l\̝ d  h\  l@P h\  l\" ܳܲT\ l̚  @P ̦ diܞtܙ 2' l $ d' a`Hd@P 0d  $ l(Hld   ' )̳ Tz@P [  ̨ \  ̞ \!!\"  \܎@P 1 l , d $ d"PTH d" 9 &@P dH!lll dTHFTl̽ dT Z@P #H # l\HF\ܜ 1\H \!H l\HF \\J@P  \!H !l\ H$ \HF\T J \H >l\@P 2%H$%\HF\\J \H\!H$! ]dT H FT @P ]\J T !H\&H$& zl\HF\,@+H(H%TT@P h$\hhhhhhhhhhhhhWPLTPRNT PQ8PKUP Q8PREP PGMIN (CCSBLK "CCSCST=CCSMVA aFWRITE TDISP \LTRDTECCSGETP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PQCST C56 F CCS CCS 3.1 .PSRD 03/83 SL-173@P}JKLMNOPQR@P 0123456789@Py u _ W QQ hPP hT\ I;Ⱦ 8@PDȻ hT 94Ȱ 1B 94Ȫ 1[ hȣ躚 ȶ h\@Pgȗ譚 ȩ h\@Ptء 1T dl\\$@P I: 7 l\ 93 # l \ l,H)TT@Ph\hshhhhh\hh\hh\hhhhhhh\hh\hh\hh6PQCST PQ8PKUPQ8PREPCCSGET6CCSPUTHCCSCST|P P SYSPRT CCS3.0 SUBROUTINE SYSPRT SL-XXX @P@P@P@P @P@P@P$%@@P@P ABORTED--PRINT FILE IS FULL FN=@P SYSPRT @P@P2 " l,,h+h) Ah& " K  2   @PȾ  Ƚh@Pȳh 8Ȯ @PȪhȢ  h阠! hTT7 lҜ!1dd@P 2 PlT\ l )\̙@PIlm  l fܷ 1T  !T l  1Kl"@PtlTA l!TAդ !%l d\@PA\ AT#A@P@P! ld # l  lT @P@PT d3H0TT h hhFh (hQ\hhv\hhv h@P h hh hh\hPSYSPRTPQ8PKUPQ8PREPFWRITEDISP  WTREADOPENFL\CCSMVAwPUTS FILERRCLOSFLP PUTHEAD C52 F CCS CCS 3.0 .LA SL-149@P@PW@P] @PQHDR0@PSHDR0@PLAUTIFIL  @PU@P`  hT)VVVTW)XV TYZXl]lZ@PlW h $f 1\SWQ] hȺn?n?ȶn=ر 1TVȡ @P!2 hؗT)QVȔ ! h (h*n_ 1\ 1TV @PHTT h h h h\h h h^PUTHEADPQ8PKUPQ8PREPAYERTOAMONTOADAYTOPGMIN hCCSCSTnCCSMVAzOPENFLREADR CLOSFLP PLVFYACF ROUTINE TO VERIFY ACTIVITY BLOCK LENGTH @P @Pdh$( hT 9! !   1Th @P.(ՈhӘ2@P6TH TThh hPVFYACF=PQ8PKUPCQ8PREP@CCSGETICCSAD)CCSBLK7P PpACTADD B01 F CCS CCS 3.0 .LA - PSRD SL-149@P@P#@P&@P)01  +8<0050@P:@P>@PLATRNSFL  @PLAACTFIL  @PLAUTIFIL  @P!@PL@P0482@PBZ@P@P>T !"T#$% T&'$\&'$\&'$T@Pi!%ȸ (T&% T\9%ȩ &\&% \\% dș &\&% \@PT!Q(%Ȋf% &\*% \_+\Q,-T9%@P) &\.% \TRQ/00\% &\.% \\Q12 2\@P30.0\Q45/67d8dTE,Q,99 .!)T@PT9%% 2Tp:% Tv l̤; $ǔ<lT=\Q@P@,,̸lT--̨l\T9% 2\2% \T!%\@Pk9%\TPACTADDPQ8STP oPGMIN ?CCSCSTCCSMVAGOPENFLhFILERR'PGMOUT-GETS READR PUTACFUPDRECCCSBLK:WRITERVCLOSFLgPACTADD PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP PACTMTN B03 F CCS CCS 3.0tMLA SL-149@P@P@P@P@P@PLAACTFIL  @P"@PE@P:@P@P @P@PTT TTFT" (T@PTT"Ũ0 &\\\ȳ Ȣ  E" @Pl9 l\ h " lTz  d d ,Bh@PT@P 1 1 lh\@P* 1T\R!v\r" v d\z$ 9h\@PI\\\Z%9h\@PW\\ 1\z& \D\\Z'\D\T"T8@Pv(//,14X,43HTHE FOLLOWING IS A SUMMARY OF THE NUMBER OF,/14X,43HACCOUNTS WITH XXX NUMBE@PR OF ACTIVITY BLOCKS,/) @P@P(14X,I5,16H ACCOUNTS WITH ,I2,16H ACTIVITY BLOCKS) @P@P(14X,I5,34H ACCOUNTS WITH >10 ACTIVITY BLOCKS,//) @P#@P(1H1,/,1X,20A2,/,1X,20A2,/,1X,20A2,3X,8HAS OF : ,A2,1H/,A2,1H/,A2,/)@PTPACTMTNPQ8STP Q8QINIQ8QX Q8QEND0PGMIN CCSCSTCCSMVAUTHEADOPENFLFILERRPGMOUTtGETS CLOSFLpPACTMTN P$XAVMCON B12 F CCS CCS 3.0mCLA SL-149@P@P!c@P!f@P!k(@P!n@P!q@P!r@P 2****LAST RESULT CODE REJECTED - NOT UNIQUE@P H****NEXT CONTACT DATE OUT OF RANGE - SET TO ZERO@P a**** " " ($ ) NOT A VALID RESULT CODE - IGNORED @P |****LAST RESULT CODE REJECTED - OVERFLOWS TABLE @P ****LAST ACTION CODE A SCREEN FUNCTION - REJECTED @P G*@P `0@P {4@P 0@P 2@P ACTION@P NADSDFDADCCSP1P2P3RLNQOASSDLAAEAUH @P @PC@PACTCRESC@P ACTVERTBAVMDESC @P_LAACTVTB  @PnLAAVMDSC  @P}LAUTIFIL  @P**************************************************************************************@P****************************************@P**@P@P @P @P P@P  @@P @P ACRS@P  @P! @P!$ ACTIVITY VERIFICATION MATRIX BUILD OF  - R@P!OESULT CODE INPUT @P!^ @P!rT[!`!a!b T}!c[!d!e T !d_!d\ !dn!d\}!f!g@P!}!dTCn!h !TC!a!hȸ AVMCKD B10 F CCS CCS 3.0 SL-149@P**@P h* % h"      n 1 1@P.@P1 H TT hPAVMCKD3PQ8PKUP9Q8PREP6P P,AVMCKV B11 F CCS CCS 3.0 SL-149@P**@P h   l @P 1 lH TT h\hPAVMCKVPQ8PKUP%Q8PREP"P P]AVMSRT B14 F CCS CCS 3.0 SL-149@P**@P h9 >53 60h/l-l, h( ,#! !!hnnh !@P0 ! h nnƘÀ@PDؾ 1HTT h h h hPAVMSRTLPQ8PKUPRQ8PREPOP PHAVMBIT A01 A CCS CCS 3.0 SL-149@P HX92h -$h.,'&2T<"$dmŠ'R)2X@P+*2 1 ** "i PAVMBITPAVMCKVP P CCSDMP B20 F CCS CCS 3.0 2 WORD RRN - PSRD SL-149@P@P@P<@P@P@P@P @P @P @P@P@PpY@PEXACT @P @PSEQ INDX@POVER@P  @P@P@PTAPE0 @PT  hTR  @P (20HGENERAL DUMP PGM IN ) @P \R @P (52H ENTER FILE NAME(CR) TO BE DUMPED, (CR) TO TERMINATE) @P 5 hTTQQTQ 2TQ  @P `TT\Q d d d d f 1T@P  (T{T '\iddd@P d dT = \\TT \\@P TZ2  dhT@P 1 lh\@P  1\T!G@P (8HFILE IS ,2A2,14H AND CONTAINS ,2A2,F7.0,9H RECORDS.) @P ,̍  \R5 7@P 7(52H ENTER 0/1/2/3/4 (CR) FOR ACCESS BY RRN OR KEYS 1-4.) @P TT EQ  TQd  d DT R= x,@P x(81H ENTER Y(CR) IF AN EXACT KEY TO BE DUMPED, OTHERWISE DUMP WILL USE 1ST CLOSE KEY )@P \Q doQp  l\RB @P (43H ENTER STARTING RECORD NUMBER OR KEY VALUE )@P T UQ " ̎  !TQ T Q̵ OT rRL @P @P (41H ENTER ENDING RECORD NUMBER OR KEY VALUE )@P \Q̾ !  !\Q\Qdd \@P @ d fp 1dqdr \qTq @P k  /o  (T T Rc @P (43H1 FILE NAME TYPE RETRIEVAL KEY LIMITS)@P  J\Zf l̜hT @P ܕ 1 dh\@P 1\\T @P (4X,4A2,2X,2A2,5X,I1,10X,F7.0)@P \Zh \\@P (34X,F7.0,//) @P T o \T Zm A dh\@P  1 l̢h\@P ܜ 1\ l̓ hT @P +܌ 1 lh\@P 9 1T ɀ@P A(4X,4A2,2X,2A2,5X,I1,1X,3A2,3X,16A2)@P S̡ ,\Zp k lπh\@P d 1\@P k(34X,16A2,//) @P rT Oq  " ,T T ۝@ \\@T Zv \\@P (1X,27HRELATIVE RECORD # IN FILE =,F7.0)@P To  ,\Rz @P (1H0) @P  \\ \\    2 ,Tq  1 @P 2 rT x@P M @P T g\R @P (26HGENERAL DUMP PROGRAM OUT. ) @P TTPCCSDMPPHFLOT Q8STP Q8QINI Q8QX )Q8QEND ?FLOAT PGMIN PGMINT 9CCSMVA INPUT CCSCST sTAPE aCLOSFL OPENFL PFILERR GETFCB INTGR `REALN READR bSEEIT GETS PGMOUT PCCSDMP PREALN CONVERT ASCII TO REAL - 2 WORD INTEGER SL-***@P@P@P@P `"d hAT-@d h:\-@dT@b h/\-@d+h !(TѨ@PFhh\-@dT \۞  T\@ ȵ @Pf\\ l5l)\@\+!\șl!T\\T \@P\\@f"H@G@PHTTh\h\hhh\h h_PREALN PHFLOT 0Q8PKUPQ8PREPHDFLOT%FLOAT DFLT YDBLE Q8QD2DMCCSGET@P P1INPUT B64 F CCS CCS 3.0 SL-149@P : hhT  Tl@PHTTh\h h\hPINPUT !PQ8PKUP'Q8PREP$FREAD DISP P P3INTGR B65 F CCS CCS 3.0 SL-149@P hlh !ThT(l @P"H TTh\h\hPINTGR %PQ8QI2FQ8PKUP+Q8PREP(CCSGETP PSEEIT C19 F CCS CCS 3.0 SL-149@P@Pr W@P}(_)~@P*0 @P hTRD@P(126H0 1 2  @P 3 1 2  3 )@P\RC@P(126H OFFSET 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9@P 0 OFFSET 123456789012345678901234567890 )@P dodn" dp "l dqPhT@P4sTt*uvTqk\kuw*uw\kuw*xw dy `dz d{̽d|Ĝ@P_! hT@Pgk\kw*y}\{r*zr lހ@PT~*\*TZ d)hT@P A1T@P(65A2)@Po nHTThhh\ h\h\huPSEEIT PQ8PKUPQ8PREPQ8QINIQ8QX Q8QENDXLAT 2CCSMVA8HEXDEC@HEXASCeCCSPUTP P9TAPE C22 F CCS CCS 3.0 SL-149@P@P@P@P@P@P@P CRE@PTR%Z@P%(35H MOUNT TAPE TO BE DUMPED ON UNIT 0.,/,73H ENTER C/R/E (CR) TO CONTINUE, REWIND AND@PP CONTINUE, OR EXIT TAPE DUMPING.,/,52H IF EBCDIC TAPE FOLLOW C/R WITH E, SUCH AS RE (@P{CR).) @P~ hlhTȉ T  d\ & @P T  dTR @P(18H1 TAPE REWOUND ) @P\R@P(31H ENTER NUMBER OF FILES TO SKIP.)@P d\ ! [T R\ZTT@P(I5,21H FILES BEING SKIPPED.) @P d˜5\ \R!%@P%(24H FILE SKIPPING COMPLETE.) @P4TZ#>\\@P>(1H0,I4,14H FILES SKIPPED)@PKܗ\R&R@PR(33H ENTER NUMBER OF RECORDS TO SKIP.)@Pe dT ! 4T 4\Z.TT@P(I5,24H RECORDS BEING SKIPPED. )@Pd dÜ!T TT !2T5R6@P(26H RECORD SKIPPING COMPLETE.) @P\Z8\\@P(1H0,I4,16H RECORDS SKIPPED)@PM\Z;\\2@P(33H EOF DETECTED WHILE SKIPPING THE ,I4,9HTH RECORD,/,38H ACTION IDENTICAL TO SKIPPIN@PG 1 FILE. ) @P" d\Z>>TT d\RB;@P;(33H ENTER NUMBER OF RECORDS TO DUMP.)@PNTi  !Tx }d d!DT @PyTT !6Ad"lTZP\\@P(//,32H0 RELATIVE TAPE RECORD NUMBER =,I5) @PTܹf\ZUT+T.%@P(64H EOF OR ERROR DETECTED DURING ACCESS OF RELATIVE RECORD NUMBER,I5)@P5@P@P@PNHKTThhAhh-hh\hhhhhhahmhhAhMhb@Phh~\hhfhhhhh'h@hXhhhhhPTAPE PQ8PKUPQ8PREPQ8QINIQ8QX Q8QENDINPUT OCCSGETTAPMOTINTGR ^FREAD tDISP |LINK ~SEEIT P PXLAT C55 F CCS CCS 3.0 SL-149@P:.@P <.(+&$*)>-/,%?: @'="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@P@JKMNP[\]^`aklmoz{|}~@P@N * hhhT=< h\>;  :1 h\>;T;=Ԝ& @Pk! h !\?; \?;ȼ "ȸh ]"ȳh\;?ز@PHTThh\hhh\h\hPXLAT PQ8PKUPQ8PREPCCSGETJCCSPUTdP P:CCSSPC B22 F CCS CCS 3.0 .LA SL-149@P@P@P8@P@P@P@PUABx@PlDELQMST COSIGNERACCAGE ACTFIL SUMHIST TAPEARC INACCT LADLQMSTLACOSIGNLAACCAGELAACTF@PILLASUMHSTLATAPARCLAINACCT@PY  @P@P @P@P FILE SPACE REPORT@P FILE MAXIMUM CURRENT AVAILABLE PCT SPACE @P NAME RECORDS RECORDS RECORDS AVAILABLE @P THIS FILE MUST BE COMPRESSED AND HISTORY MUST BE RUN ***** @P WARNING - THIS FILE SHOULD BE COMPRESSED ***** @PdddThTh Tl h@P h f 1 (€h\@PYTY (TY dX#$ '\Y@PT%T@M&d\-@OOO \OO\MOE\*\@Q+l@PB\-@SSO \SGS\ʾQSGEGIGEI@ h\-@KK\\~@PmEL\IEIK@ "dTR>\Z? dhT@P #1T\Z@ lh\@P #1\\RAl\ZC l΀h\@P 1\\\\\ZD l̵h\@Pܯ (1\\ZE l̢h\@Pܜ (1\\RFdTZH d;hT@P 1\\\\KTTWKL&!9\UKL!\ZK lЀh@P<\@P> #1\@PE@P=E@PEH@P2G@PGHC@P#K@P&K@PDK@PN\ZM l̳h\@P[ܭ #1\\RN2l\ZP l̘;h\@Pvܒ 1\\\\K\\WKL!4\UKLȺ!TZS dh@PT@P (1T\ZU lh\@P (1\\RV@P@PT@P@P 2\RY\RZ5T@P@P(1H1,////,52X,9A2,2X,1H-,2X,2(1A2,1H/),1A2,////)@P@P@P(/) @P@P@P@P(//)@P@P@P@P(40A2)@P@P@P@P(31X,40A2)@P@P@P(5X,4A2,X,2(4X,F8.0),5X,F8.0,10X,F4.1,1H%)@P@P(36X,4A2,X,2(4X,F8.0),5X,F8.0,10X,F4.1,1H%) @P1@P2(X) @P4@P5(1H1) @P8TPCCSSPCPHFLOT !Q8STP 9Q8QINIQ8QX Q8QENDFLOAT AMONTOADAYTOAYERTOETFCBPGMIN CCSCSTCCSMVAOPENFLPFILERRCLOSFLPGMOUTPCCSSPC P$CHEKID B23 F CCS CCS 3.0 SL-149@P@P L@PMNUPRO @PTT  TT TTPCHEKIDPQ8STP #STIME PGMIN PGMOUTSYSMSGCHAIN PCHEKID PSTIME CCS 3.0 TIME CHECK SUBROUTINE @P+@PMONDAY TUESDAY WEDNESDAY @PTHURSDAY FRIDAY SATURDAY @P%SUNDAY @P:hhhhhhhhhTT@Pe123467Tz h (hT@P}غ 1\,\-\*\.\/\0 hȨh\@Pآ 1T@P(/,5A2,X,A2,1H/,A2,1H/,A2,2X,I2,1H:,I2,1H:,I2,3X,3HID=,4A2) @PHwPSTIME PQ8QINImQ8QX {Q8QENDAYERTO;AMONTO?ADAYTOCHORTO GMINTO KSECON OYERTO SMONTO WDAYTO [PGMIN _YMD1 eP PYMD1 @P@P @P @P@PW@P hVBœS  hO(hp8hڌI lH D#DlB> h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hnPYMD1 PHFLOT 5Q8PKUPQ8PREPFLOAT @P PCHUPD2 B26 F CCS CCS 3.0 .LA - PSRD 08-83 SL-149@P@P @P @P @P @P  @P  @P &h@P *+50@P 6514@P ;@Pe@P}CHUPTEMP SYSVOL @P@PCHUPTEMP  @P@PЂ@P@P@P@P  @P DELQMST ACTFIL UPREQ @P 9LADLQMSTLAACTFILLAUPDREQ@P MOUNT TAPE LABELED: / / ENTER "OK" FOR READY ENTER "NX" FOR NEXT TAPE EN@P TER "EX" TO END @P ROKEX@P NX@P F@P T@P ] INCORRECT TAPE MOUNTED @P j ACCOUNT=# NOT FOUND ON @P END OF HISTORY@P END OF REEL X MOUNT REEL X@P TAPE @P YES NO@P @P ;T)   T 9 )   T   9 hhT 6Tz" @P f hȯ hT@P pب 1 hȡ h\@P }؛ 1 d 5h\@P 1 d  !h\@P 1T d l ,h 4f 1 ,hT@P   d E  " l n 1 1 l @nܲ 1  d&\@P   " lT   " d  dTe}  d  fd@P  1Te}  l̤ )T} E  @P + l\ ̒ !T-   d E   "T N- !  !\ @P V ! j " !T B- # $  $ % % \ d 1d \- # $  $5d 6d  7d @P T  & ' & P  ( P R 9 S   \- # $  $\-  ̓@P ̎ "\- # $  $ %̦  ; T  lr d )T $ * ) UT@P T L   j + ̉ T [    % % T 1\   ,@P \   -T  & - F F F (k !\ $  $\  $  $ %  @P-\  & ] . F F F (I l\ !  ! %̫ !̧  d TT-   d E@PXT 9  j +   /  " l d \    \- 0@P 1  1AT  "T  !  ! % %   \ !  ! %  l@P  2d d  l 3,h\@P !  ! % ,d *d 4ڜ"T d 5T 5 c"TY @P !  !d \  0 G 0̾,h\@P 6 7  6 7T G  d E  1P !  O 8\  0 0 lTP@P1 ߤ \ G 0 0 l\ ˬ  lT ̾ " @P\l\ ̲ " "̸T      " d JT bz y @Pd hT n@P 1 l h\@P 1 l h\@P 1 lր h\@P 1T T 1 @P @PN@Pg@Pn@PT  & j 9 F F F ( d c@P @P @PT # E  @P @P J@P @P\ A E   @Ps@P\ 9 E  \ = E  @P )@P E@P @P\r T \ \ \  d : f 1T } Th@P f@P(1H1,20A2,9X,26HTAPE HISTORY UPDATE REPORT,/,1X,20A2,14X,9HRUN DATE:,A2,1H/,A2,1H/,A2,@P1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVA@P8p@P8,@P8@P0  @P0  P PPACTEDT B02 F CCS CCS 3.0 SL-149@P hhT h h hT0 h 1\0@P. h h\0HTThhhh\hhhhPACTEDT>PQ8PKUPDQ8PREPAEDIT CCSMVAP P)CHSCRN B25 F CCS CCS 3.0 PSrPD SL-149@P@PR@PT @PN<@PDL@P4@,@P6UH'@P_@P9@PADDACT CCS20  @PSREQDL CCS20  @P%UPHSTCM CCS20  @PJ9999999999@P:0Nl1E(@PI @PVT1O 95 2H   \3O  T@P3333\33dd h fر 1 9T@PK̼7 \10%K0K !p 3T3K :T0K dO l̕ @PT3OKI \%O3KIT0Tl "T3\3TWQQ @P 93 !T0l d03O\Q ̴ l lT !̪ ! , l@P-G !A0DdM=RdN 8 dP\1PSS GlT3O3;EL@P0XL 0#lTS3P3TO 1'T04@Pv T30Of\1fTJ0TL g3\f30OQ"h\ǀ@P3M03M\O33MMh\38OM@PMH 5@P3\E01T800Od6 T`30E5l @P_TP3309L\33 h<\4 dP f0 1T18K@PK !0#L 0p T30K !T0K \3198@P5 l dOTOK0IT ldI!;Q찖9  쨖: 2 j̡:@P`hT3M@PiM ; 2~̌;h\38E@P}P  0d dd0ud0N     \@P3OM3MM lT3O3N l  l00dp4U,d 0d4p<@P 0ȌlTT3I33MJ@P@PTo0m@P@P0 4Te T^ 6 3T'H$TThhhhh@PhQhc\ hYhv hS hh'.PCHSCRNPQ8PKUP Q8PREPCCSGETCCSMVAcOPENFL PUTS CLOSFL&FILERR !:T@P@P U ! d lfn ,3l\I3U3J l@P@P d} l lT3B}KITT3KHPDAAASCPOPENFLCCSMVA,READR CCSCSTGETACFGETS  CCSBLK9ACTEDT=WTREADADISPLY[ICHENTgEACTSQvEATRNG|PCPROCPFILERRCLANEXCLOSFLP P,DISPLY B43 F CCS CCS 3.0 PSRD .VERFY INP. SL-149@P_@P99999999990000000000@P (@P @P  @PENTER ITEM,CHANGE OR NEXT FUNCTION OR ACTION,RESULT,LETTER REQUEST,COMMENTENTER NEXT F@P/UNCTION OR ACTION,RESULT,LETTER REQUEST,@PCCOMMENTINVALID REQUEST, PLEASE REENTER@PVJK;@Pa dB " Y<!9 =d0 d00d l)hTr\00KK0 @P " h 13TI333J@Ph  2h0՜ 2%h3T3 ܔܓ\@PҀh\@P3d]\33h\@P3 d^"! ,{ y @sKJp0dO8dMT@PO13MM^ ! \3OM1M^ "κ 1? #̓@PJ lY_\ dPd]Q dK3Tv3K l ul@PuT0T0 PllΑl dd Odd $8dM@Pl   T3OM10M ̝h\@P3OMM̔l՜ llM\ h hT@P@P T\3δ d^ l d 2 d ld] @P3\1 l@P@P@P@P d0MTI33M30J l1@Ph,@P, $ ld d00d0̒Vh̎Vh ̊UhT@PM@PP\V l@PV@PV L$]l3\10̏ lTv3\I33M30J0J \333 l@P d^T^`` #0l l̼9\1^`  lD dM\^M@P3ll l̛!\^` }3 %1T^0ܻ@P@P@P d\K  l1T\3KIT@P@P0 ' T & \E & \E & & 3dH@PX@PHTThhh\hhhh6PDISPLYPQ8PKUPQ8PREPREADR WTREADCCSMVAICCSCSTGETACFfCCSBLKhACTEDTzEDIT CCSTIMCCSGETCCSPUTFILERRPCLANEXGETCHFP PEACTSQ B48 F CCS CCS 3.0 PSRD 02/28/1 SL-149@P@Pm@P@P50617@P9:832@P 4;@P NA@P0uh   0h0 hlT0! hDf 1@P@Rd'Sd(0d$T1 Ƚ mȹ 0h h\ ȫ T3;%@P0k 1h\ ș Iȕ h1ؑ\   d& \@P $ ̷l0dM 1֜ 0%l\13M)3MT@P3$%300 %0l%  0   Tf@P3E30 YlT 3TTK3  3\30 d\ @P/\\333G0l0F &00E  0#l h8;\ @PBu l 0l0TGh%\ "l3Tḑ$0lo0 7̙ 4 @Pm 6T @PvܙT133T330L L %\0m\ ̚0 0 _T@P1 & \0T1     \@P00l\1 \\1 \1 99 6 93 &T@Pq d d00  l 2l 21 0d&\3 ̝ @P"̘  lT  _ l\1   T333 l;0\@P3M00Gl3\30̪F &E  #0l du\ 39u@PxT3 %T1%\ ̥  ̢ Tx00&d0\ 8 @P  T03) !0 0\ dM $\3T@P3@33M)M$ y00% y \330T0̰ wT@P3)  d0f0 1 00d00d0Gl0F %E @P$ 0#l0dTNGdu\l3TVl$0Ôlo 8̵ 5 !@PO3\0\E0 d3\l0 lTu0  0\El̤d ǜ"̯@PzlT30l d0 f0 1\)3300&0 \31 \@P33T100lT0dKT3!v00K dQ l@P%@PZ@P}@P@P@P@P0H   ܦT @P@P@P0d0H6PEACTSQPCCSBLKCCSGETCCSMVAfAVMVACCCSPUTDISPLYICCSAD/ICALJL8PIKAMTCCSCST~IDATVRzJULCAL|SAVTRNPUTACFP P,EATRNG B49 F CCS CCS 3.0 PSrPD SL-149@Pm@P@PFGHJK@PLMNOP@P QRSTU@PVWX@PNA@P0uh   0hT0!T000d$\d0%T3;$%@PF 6 ȴhh   ֔0   TE@P3q3 YhT0\3\3000 d0GlF %̛@PE ̖ #l0 h0\3T0Gh%\"lT3d$l@Po 7 4  6T2@P\3T3T3330L L $0\0\00 0 |T@P3o10\  0\3T3\ * 7 #@P0 $0\  d d0  l 2l 21 ̨d&T 9\@P[     \ ̽l\  AT338@P l0GlF &E  $d d\3@PT0 2\ \̸ T300  TT@P̺0 ̔ \  < 0l\0 $l@PT~33)0$ 0w%0 w0  39\33\0 @P2u\33000 d0GlF &E  #8l @P]d\3T0Gl\lT3d$l0o 8 5  !5@PT0\E0 d3\l0 lT00\El̘l#̦d@PT30d l0Df0 ܯ 1Rd'Sd( lfܜ 1Ty@P0\33)3& 1\3\3330lTdK;T!v@P0 K dQ l@P+@PP@PU@P0H   ܘT@P\ @Pf @P0 d0HPEATRNG'PCCSBLK.DISPLYAVMVAC@CCSMVACCSPUTICCSADgICALJLoPIKAMTCCSCSTCCSGETIDATVRJULCALSAVTRNPUTACFP PTFCOLEC B51 F CCS CCS 3.0 SL-149@P@P@P1@P**A $@P@P@P ^s@P C,@P#!E @P'A@Pc&@P* B,%N,@P/OLPM@PZ@Pd@Pa#@P "@P@PLTR1LTR2@P@PeACTVERTBCCS20  @PtCOSIGNERCCS20  @PDAQUE CCS20  @PUTIFIL CCS20  @PT1IT3rKK (3T3KITT)0  1\T3  d@Pp d0T3301\0K "T33K0Ť ̾ ̷ @P"dd0ȑdT\Z3<K̠ !#T33ZK̖$ ̏ !T@P3AZK d 0fY 1 d lT<K0IT00dR00dS̲d̳d@Pl d0 (d ľhT 0U %̻ Al@PTVܯ 1T1/00KK0 } v !o0T  d\@P0d\00do\10\3K֬ל UЬ O !H d d0ܔ @P f 13\K̩ ̣ ̝ ! lל  @Pn 13TAK@P@P d@P"@P" l lTX3KIT^ 0dE dF d0GTE0l d  ;@PMl0 0l d f0 1T10eK0K !!3T3fK !\@PxK d0T  1 l l l\e0KI\VdfWdg d@Pd l nܬ 1\K̳ !)T33fK0̩ ̢ ̜ !@Pdd dT0K d lT(0KIT. lT3cZK8 dp@PK &\K0I\\3K 1&\3KI\ d\3KK  3  l\K@P3$KI3\\-0K &\-K0I\Ta  +  $@PO- & 0\(\ " "1 T0K  l d@Pz Tm1K lK  !d V U @Pެߜ ddT33lT30vK 08G @PF E 0nH 0d0d dQ̜  d@PTp0K0K % d%d 4 lx laT "5 @P&  d` " lT3`q1` d f0 1 dTtK l@P0Qd̮ !pT3|f0K̤ [̝ !b l $ dT}̐ T@P1|q`1`LL $̴ \ 1 T06 ̎ \3  @P3\ܑ 1T3430T0K0\K\,s l lTt8KIT@P@PT@P3\33 d d d@P@PTZ30K00K     2 lT0d &T@Pc$@P@P3\330T%ˬ̜  ƬΜ \0\,00 !=H*d@P@\0Td  4\0"! 1b&w@Pk0\T\#0T0̼H'l0\2 1   , d@PfAfB d l < d6l3l " ln @P " edd  l l f 1TKtKK "@PT330f\1fT33fK0 d ܤ 49T@PT 0\ 3TxEp ? ;T\1T010K̫ 1% @PBd̢ $ l~0\ \ \0E 3T0K̊ $ lfQd;TK@PmJ@Pb @PoT@Pc@Ps d  l5lj@Pd@Pe@Pf@PT\3@Pd@Pg @P  6l lW@P@P@P@P $0U  6T0%Tl ldfVdg !d @P l d1S l@Ph`@PT3.0̦  l ld@Pis@P\b3Tl@Pj{@Pl@PT[@P@P@P0p TZZ3K d00QK * d ?@P@P̲ !%2BdCd $2dM3\3M03M ,l\B3MB0M l l@P3llllll 3# l l d0lHmPFCOLECOPAMONTO1ADAYTO6AYERTO;PGMIN OPENFLFILERRCLANEXDISPLYCCSGETrCCSMVAREADR CCSTIMWRITER8CLOSFLjPCCSPUT,ICCSADICALJL?GETS XGETACFNMSRCHCCSCST{ICHEKQ ICHENTEDAAASCrCHSCRNCCSBLKUPDRECEATRNGpPPCPROCEACTSQP P`GETCHF B57 F CCS CCS 3.0 SL-149@P hdl 2 h@PhT@Ph !h ( h` n - nn@P=!@ HHTT h h h h h h\ h h hPGETCHFAPQ8PKUPIQ8PREPFICCSADP PPICHEKQ B62 F CCS CCS 3.0 SL-149@PALL @P  7nH 0.U  0V  h h ( h @P0  h @P9 1 hȾ H TTh hPICHEKQDPQ8PKUPJQ8PREPGP PkICHENT B63 F CCS CCS 3.0 SL-149@P DADCDFNARLCSEADSP1P2P3NQOASS@P h9 @P0  > h0T80  h)h׈h 1 ȼ ȹ  ȶ @PKȳ Ȱ  h Ȫ   hȡ HTThPICHENTaPQ8PKUPgQ8PREPdP P[NMSRCH B83 F CCS CCS 3.0 SL-149@P@P@P?0#<@P @PB@P END OF SEARCH@P@P dgfhl0h h " h  hTq0T13q h@P0Fpf0e 1 h "ȽhTI3330JT3Zf00KK0  "@Pq@PP@PP@PP fFf d!,d`m5n@P`x@PxT\T T<~\s @P7@P@P@P @P4@Pod # l  lTYT3Yt0t d @P,@P~@P@P@P\t0t l@P@P@P@P6@P TI0"TlT'!s\"TTPCOLSTSPQ8STP GETSW PGMIN CCSCSTCCSMVAWTREADUTHEADGTSYSPPRTORFGETGRPSYSPRTOPENFLEDIT CCSPUTaPGETUTIGETS UPDREC,HXDEC yCCSADDFILERRCLOSFLPGMOUTPCOLSTS P)GETSW CCS3.0 SUBROUTINE GETSW SL-XXX @Ph h h"p8n h 1@P H TT hPGETSW PQ8PKUP$Q8PREP!P PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP  P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP  PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVAh hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP P>CPYIND B34 F CCS CCS 3.0 PSrPD SL-149@P@P7"@P:  @PC@PG' @POd & @PT@P@P3@P2@P@P/@P  @P  @PINDEX FILE COPY (MAX 2000 BYTES)@P FILE NAME TO COPY FROM @P VOLUME NAME @P FILE NAME TO COPY TO @P OWNER NAME @P XXXXXXXX FILE COULD NOT BE LOCATED@P XXXXXXXX FILE NOT INDEX FILE@P FILE DESCRIPTION NOT THE SAME @PTT456hgT47879T:\47;7:9T:@P:\:\47=7:9\:>:\:\47?7:9\: @:\@P:\47A7:9\: :\:\47=7:9\: >:\:@P\47?7:9\: @:TBBC (TDB4 T/@P B '\ B4\/ B՜ '\ DB4T2@P+B̽ '\EB4\/2eB̭ '\ EB4e ) j @PV) dFd ) 1d1TiGTBBH 3I@P  *TJB4 ldK dL!D , dM h6̣(3d N@P ,\Oh"T{ h\1G1T/GB̦ '\ PB@P4[@P3ܹ Q\:Q:T_47R79>\ :Q:\47R7@P9-\:Q:\47S79\ :Q:\47S79 \4787@P09TB\/B@P:@P:@P%:@P:TTPCPYINDPQ8STP =FMRDEL[PGMIN UWTREADCCSBLKmCCSMVAOPENFLFILERRCLEAR GETFCB'GETS qWRITERCLOSFL4PGMOUT;PCPYIND PDALIST CCS3.0 DAILY ASSIGNMENT LIST SL-XXX @P@P @P $@P @P F( R>P@P 09 6,@P @P  .@P S|wK{kM}IVNl@P 701  *8@P @/%@P D@P F@PUTIFIL SYSPRT @P EXECUTING DALIST @PLADLYASNLA  @P@PLADLQMSTLA  @P@P@PDLYASSN @PDELQMST @P: @P?DALT@PjEND ALL @P@Pq0360@P}@P<@PsMNUPRO@P=@P000000000000000000000001000000000000000000000000@P000000000000@P00000000000000@P@P HOW MANY ACCOUNTS TO PRINT ? ENTER NNN,ALL, END OR (CR) @P. NUMBER OF ACCOUNTS ASSIGNED TOTAL ACCOUNTS ASSIGNED: - END OF REPORT - @PU1---------- HDR1 GOES HERE -------------- DAILY ASSIGNMENTS FOR QUEUE @P PAGE @P @P ---------- HDR2 GOES HERE -------------- AS OF:  @P @P @P ---------- HDR3 GOES HERE --------------  @P @P @P  @PF @PZ @P] AMOUNT DELQ  @P PAYOFF/TOTAL DUE @P @P DELQ DATE  @P CONTACT DATE @P @P HOME PHONE & EXT.  @P PRIORITY @P @P# BUS. NAME  @PN @Pb @Pe BUS. PHONE & EXT.  @P @P @P DATE ACTION RESULT LETTER COLLECTOR-ID ***** COMMENTS *****  @P @P @P  @P  @P ( @P + ********************************************************************@P V************************** @P j @P m ***** ACCOUNTS ASSIGNED TO QUEUE  @P @P @P **DALIST** ERROR IN FILE : XXXXXXXX RUN ABORTED **********  @P @P @P FhhTT9 ;T  ȓ T  \ @P q \   T9   TT< \= T:;=T@P U '\  "T  " d/\ "@P dT@B   d $ d ,thT dB @P   h\B  hT @P ז 3 n 1T \ U  \  \%  @P +  ; T U\ T z9     d !@P V DT Xj   \l    7 l d ՜! T@P 9 3 %  l@P !T  \B l  ̾ \D d T . U   d T@P @1   l  " d '"$  d ?@P   ?hT>@P  ̩ $̥ !Հ?h\@P   T ̣  ̜ "̸?h T Z@P 2  n    ?   >\ d ?\ ?ܮ 1\ +@P "@P "@P "@P %"@P" @P &@P& "   @P 2@P }2@P2 d   >\. U   d@P G@PG\> @ + A B\  T   \ + ! T  \ + \ @PrT L $ $\I@P @P @P Dd C # l  lT C 9\   d E(@P @P *@Pl # l  l\ C 9\   l @P @P @P\  l@P g@P \ T \ TdTTPDALISTPQ8STP FMRDEL GFMEOFC KGETSW OPGMIN RCCSCST CCSMVAtWTREAD ?UTHEAD GTSYSP PRTORF GETGRP SYSPRTOPENFL PGETUTI INTGR EDIT VCCSPUT 3CCSGET GETS ICKGRP READR CCSADD GETACF FILERRCLOSFLPGMOUTPDALIST P)GETSW CCS3.0 SUBROUTINE GETSW SL-XXX @Ph h h"p8n h 1@P H TT hPGETSW PQ8PKUP$Q8PREP!P PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVA> ؔ  ʔ Ô ̼ ̵@PR ̦ h l=@P_TqZ-kTw&Tz@Pk(8HCOMMAND ,A2,23H NOT IN TABLE, REENTER.)@P\R00@P(51H CREATE FUNCTION WILL CLEAR YOUR CURRENT TABLE FILE,/,30H TYPE Y IF YOU WISH TO DO@P THAT,/)@PT : ;:&=&?@T66 "\R6ڀ+@P(53H CREATE TABLE IN PROCESS, INPUT LU OF INPUT STREAM AS,/,19H 2 NUMERIC DIGITS) @PT`R8 !@P (57H IF LU 04 ENTERED, CREATION WILL BE VIA ADD TEST DIALOG ,/)@P+\: ;:-A=-Ed^CH$DdB dF/6 f d d @PV7d _TBGG  d6 f 1Tc6T6@P "Tm6TZJhTf@PTi@P(3X,A2,30H TABLE HAS BEEN FRESHLY LOADED) @P@P4@PT>> " @P;@PT> "T6̟ " l nܕ 1\6\6̇ "@P\6@PB@P\R[$@P(63H DISPLAY TEST IN PROCESS. ENTER 3 DIGIT TEST NUMBER FOR DISPLAY,/)@P T: ;:#H=$CHd^#E$Dh"H$JdITI>> @P ATZa PTIT@P P(21H ERROR IN LINE NUMBER,I4,14H NOT IN TABLE) @P h1@PI j@P jT3\Re t@P t(36H TABLE WAS PRINTED ON LINE PRINTER. ) @P @PP @P \Rh K@P (63H DUMP TABLE IN PROCESS. TABLE WILL BE DUMPED IN FORM COMPATIBLE,/,72H WITH CREAT@P E FUNCTION. INPUT LU OF OUTPUT STREAM AS 2 NUMERIC DIGITS ,/)@P T : ;:+A=+Ed^CH$DdKTK>>  T DZn T@P  JKT M@P (20H TABLE DUMPED TO LU ,I3)@P @P @P T@Pk @P \Rr #@P #(49H FILE DECTBL NOT DEFINED. USE UTIL AND TRY AGAIN.)@P >@P @@P @@P @\Zu I\6\@P I(37HFILE DECTBL ERROR IN REMOVING ERROR-,Z4) @P `@Ph b@P b\Zx k\G\@P k(24HSUBROUTINE LDTABL ERROR-,Z4)@P {}@P |@P |@P |T Z{ T 6T @P (43HFILE DECTBL ERROR IN STORING RECORD, ERROR-,Z4) @P V@P- @P \Z~ \>\@P (36H NO DECISION TABLE IN SYSTEM, ERROR-,Z4)@P 6@P @P \Z \>\@P (24HSUBROUTINE DELDT1 ERROR-,Z4)@P \Z \>\@P (25H SUBROUTINE DPTDT1 ERROR-,Z4) @P 0 TLMT TPDECMTNPQ8STP Q8QINI }Q8QX Q8QEND PGMIN OPGMINT_OPENFLvCLOSFLDEBDT1 WTREAD RTVDT1$CLEAR LDTDT1_PUTS {PDELDT1ADDDT1DSPDT1 8PRTDT1 kDPTDT1 PGMOUT PDECMTN P=ADDDT1 B04 F CCS CCS 3.0 SL-149@P@P @Pd@P @P@P@PBAD OPERATOR BAD CONNECTOR PB .LE. PA BAD SYNTAX @P5 TYPE Y IF CORRECT SYNTAX ERROR, REENTER @PwINPUT=@Pz@PvY @P lh h  ю h  "@P d TZT}TE@P(33H ADD TEST IN PROCESS. THERE ARE ,I3,25H TESTS CURRENTLY IN TABLE,/,58H ENTER 3-D@PIGIT NUMBER OF TEST THAT PRECEEDS YOUR NEW TEST,/)@PTwNOHh(N$h"H$d} ! !@P=TZKTT̀c@PK(37H STARTING TO DEVELOP A NEW TEST, NO=,I3,/,78H ENTER LEVEL NUMBER (1-9) THEN NEX@PvT LEVEL (0-9) THEN NUMBER OF PARMS (1-9). ,/,55H SEPERATE FIELDS BY COMMAS, FOR EXAM@PPLE, INPUT=1,0,3 ,/)@PTwN|NHdzOHd{PHd|Tzl\{l\|l "~@P "~ "~  dITIMMhT@P\d "} !\Mh\@P\ " l@P lT>Z/.TDz\{\|TG,@P.(5H LVL=,I1,7H, NLVL=,I1,5H, NP=,I1,43H TYPE Y IF CORRECT, TYPE N TO ENTER AGAIN.,/) @PYTwNN lv =Tz{| "\Z7 @PdMh\@P 1\(@P(39HNON-NUMERIC FIELD IN LAST INPUT, INPUT=,2A2,A1,21H RE-ENTER LAST INPUT,/)@PTZ:T%zT,A@P(20HLEVEL ERROR, LEVEL= ,I1,33H LEVEL MUST BE .GE. PREVIOUS LVL,/,30H AND .LE. N@PEXT TEST LEVEL,/,19H REENTER LAST INPUT,/)@P d| " \Z@#\\@P#(17H ENTER PARAMETER ,I1,58H INFO. ENTER OPERATOR (NULL/.EQ./.LE./.GT./.NE./.WE./.OS.)@PN,/,77H FOLLOWED BY 6 CHARACTER PARAMETER VALUE ( 2 VALUES IF OPERATOR IS .WE./.OS.,/,@Py37H FOLLOWED BY CONNECTOR (.AND./.OR.).,/,41H SEPERATE FIELDS BY COMMA, FOR EXAMPLE@P,,/,33H INPUT=.WE.,000500,000650,.AND. ,/) @P TZCTT@P(18H ENTER PARAMETER ,I1,6H INFO.,/) @P| #\RF@P(49H DO NOT INPUT CONNECTOR ON THIS LAST PARAMETER.,/)@P dfM 1TZwN@P(12A2)@P d̹  lTN("% " ![TZRn dMhT@PI@PK 1 d!h\@PY 1 l'h\@Pf 1Tŀ'@Pn(4H OP=,2A2,5H, PA=,3A2,6H, CON=,3A2,32H TYPE Y IF CORRECT, N TO REENTER,/) @Pd\ZU l̦Mh\@Pܠ 1 l̨!h\@Pܢ 1 l̛$h\@Pܕ 1 l̎'h TI@P 1\'@P(5H OP=,2A2,5H, PA=,3A2,5H, PB=,3A2,6H, CON=,3A2,19H TYPE Y IF CORRECT,/) @PTwNN lv T"% " l@P#T =2 h7  h- hT/ hhܘ!/ (1#TZ@P]t hȝhT@Piؖ (1T@Pt(40A2)@Pw h\/fدȬ $Ȣf\Zt lh\@P (1\Ȓ \/)l\Zt lрh\@P (1\. d,z\Zt\*\ lHTT h h\hhhh@P\hNPDPTDT1PQ8PKUPQ8PREPQ8QINI[Q8QX gQ8QENDoBLKDT1JP PUDSPDT1 B47 F CCS CCS 3.0 SL-149@P@PM@PS@P\ @PJ@P+NULL.EQ..LE..GT..NE..WE..OS.@P;.AND. .OR.  @P^T* "0hT@PnMJȹ(h\@PuNKȲ!h\@P|OL h h hTZT\J\K\LT1@P(/,/,34H DECISION TABLE TEST NUMBER -,I4,10H LVL - ,I1,10H, NLVL - ,I1,8H, N@PP - ,I1)@P\R%@P(/,64H PRM NUM OPERATOR VALUE 1 VALUE 2 CONNECTOR ) @P* lI dQL"TGMT9DG:9  dR dT: $M dU @PdV  l lTZlTQdW9*h\@P=@P@ dCh\@PI 1 lFh\@PV 1dX8:h\@PgT@Pl(8X,I1,10X,2A2,6X,1H*,3A2,1H*,5X,1H*,3A2,1H*,7X,3A2)@PQp\Z"̯h\@P̩`h\@P\$@P(/,31H NUMBER OF RESULT VALUES - ,A2,22H, CURRENT POSITION - ,A2)@P?hTl@PYh\@PSZTZh%\Y$\ d[ dW dXT)Z)l9̖ hT/@Pܐ@PTj@P(15H RESULTS - ,2A2,9(1H,2A2))@P \R+ @P(/,12H END OF TEST,//)@P l@Pg"@P"]l.H+TT hgh] h)hh\ hh\hhJ\hChhh@PM?hh\h PDSPDT1(PQ8PKUP.Q8PREP+Q8QINIQ8QX Q8QENDGTPDT1_CCSGETBLKDT1GPMDT1NUMDT1P P^GPMDT1 B59 F CCS CCS 3.0 SL-149@P@P@P<hUhmhh h\hY\h+\hh\ h h h\ h h' h{@PT hz\ h hL ho hn\hhdPPMEDT1#PQ8PKUP)Q8PREP&CCSGETCCSPUTP PPRTDT1 C08 F CCS CCS 3.0 SL-149@P@P@P @P@P @P@PwNULL.EQ..LE..GT..NE..WE..OS.@P.AND. .OR. @P  @P,,@P @P@P d 5 h h h h hTTȲ T@P!\Ȣ TZS d d ,vhT@PF 1 1T @PS(1H1,3(/2X,20R2)) @P\\Z!| d ,h\@Pl 1\\\\\%@P|(43X,5A2,37H DECISION TABLE CONTENTS DATE ,A2,1H/,A2,1H/,A2,I5)@P\R#A@P(122H0 TEST LEVEL NEXT NO. OF PARAM PARAM PARAM PARAM PARAM NO@P. OF RETURN CURRENT RETURNED VALUES)@PT2R%9@P(106H NO LEVEL PARAMS NO. OPERATOR VALUE 1 VALUE 2 CONNECTOR @P VALUES RET VAL  )@P$T d!_ d ,hWTf; 1 ,@POh (  h hT 8 h h hܘ!) h\@P4     ؽT@POȴ س l@PYȮlHTThh\h\h\hPRESDT1^PQ8PKUPdQ8PREPaCCSGETCCSPUTIP PRTVDT1 C17 F CCS CCS 3.0 SL-149@P+"3@PDECTBL  @P- l: 8j6 412h l.T( !*T( ! T(Ԝ !@PX  hhƘ9 nÀ@Pl ȺlȺlȸlHTTh\ h h h h\hPRTVDT1yPQ8PKUPQ8PREP|OPENFLCl @Pl\sumT tt ޜ dhh @P/hTx@P6 @P9  4   Zրh\@PTD Jƀh€h̾h̺ 8h\<@Pq@Pt2̮h̪8h̦h̢ h\@P<@P̰ hh 8hT<@P@P 2%T2<?  l lhhh\@P @P L dhh8h\<@P @P ,hhހhڀ 8h\<@P@Pπhˀ8h ǀhT @P<@Pܻ 1 1@P!%@P%TLuu (Tum| d\CCdT< @PPrr ET1 \ d d \< sT  z lT@P{ \ s \< T  u̚ '\ umT4<ű '\u@Pml  "BTZ dhT@P 1\BT+@P(1H1,4X,20A2,4X,29HACTIVE ACCOUNTS UPDATED FROM ,14HHISTORY SYSTEM,28X,6HPAGE: ,I3) @P\Z l̼h\@Pܶ (1\\\\@P(1H ,4X,20A2,15X,8HAS OF: ,A2,1H/,A2,1H/,A2) @P+\Z@ )l̋h\@P8 <1\ @P@(1H ,4X,20A2,/) @PHTRO;@PO(1H ,5X,14HACCOUNT NUMBER,10X,14HBORROWERS NAME,22X,13HFORMER STATUS,8X,13HINACTIVE DA@PzTE,3X,17HTAPE ARCHIVE DATE,/) @P dlTWT\}CT<\<@P\ \VTIZ dhT@P <1T΀@P(1H ,4X,60A2) @Pܤ̸TKPP@Ps@P@P@P{d@P^@PT&uu 'T/dumy 0 lTIP{D T P@P!{@P@#@P# 1\R.@P.(1H ) @P1\ZE l̖Oh\@P>ܐ 1\ @PE(1H ,4X,46HTOTAL NUMBER OF ACCOUNTS UPDATED FROM SUMHIST ,6A2)@PdTRk@Pk(1H ,/,44X,23H**** END OF REPORT ****)@P/~@PO~@P~@P~@P~@P5~@P~@P~@P~Tu\ u@P!@P\4u@P@P\u@P@P\u@P@P@PTTPDHUPDTPQ8STP Q8QINIeQ8QX Q8QENDFMRDELPGMIN CCSCSTCCSMVAUTHEADOPENFLFILERRCCSBLKGETS 5READR PUPDRECDECHEXqBINASCyWRITERDELRECEDIT CCSADDCLOSFLPGMOUTPDHUPDT PeDMPFIL B45 F CCS CCS 3.0 . - PSRD 03/83 SL-149@P@P@P@PȀ@P"N @P(& @P@P @P@Pn@P@P000000000000@P~ @P0000000001@P@PY @Pp@P DUMP FILE TO TAPE @P' INPUT FILE NAME @P2 VOLUME NAME @P; *****OPERATOR-MOUNT TAPE FOR XXXXXXXX ON UNIT 0 WITH RING READY (Y/N) @Pb FILE COULD NOT BE LOCATED @Pq RECORD EXCEEDS 2000 CHARACTERS @P THIS IS A SUPERVISOR COMMAND ONLY @P *****OPERATOR-REWIND TAPE ON UNIT 0 @P RECORDS WRITTEN TO TAPE@Pd `dTz TpTp\'p y@P ȶ Tp~\p\2pȞ \p~T~@P2Ȕ .ȑ/T~h&h$T  '\~@P] dd̜"9p,, d,, !, ;T+, # l, @P.-@P-/./@P./T+,,,E@P-.6@P-&.6@P.6\,z,,,?@P,.<@P.< d,,h T-@P.F,,,hT@P.O,,  ,,h,$,,ʈ%lT,,,,, 1\,,,,,@P.zT+,\,b,TTPFIXINAPQ8STP .FMRDEL,FMEOFC,PGMIN ,CCSCST,CCSMVA-PGMINT,UTHEAD-CLEAR -OPENFL-LOKFIL-4GETS -8CCSGET-CCSBLK-PCCSPUT.DIDATVR-PUTS . UPDREC.FILERR.0HXDEC .MWTREAD.cCLOSFL.{PGMOUT.PFIXINA PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP P LODFIL B73 F CCS CCS 3.0 REPORT DUP RECORD SL-149 @P@P J@P M@P Q @P U"P  @P a 6&'4@P h@P @Pg000000000000@P|  @P &0000000001@P@P ,@P 6Y @Pu TAPE TO DISK FILE @P OUTPUT FILE NAME @P VOLUME NAME @P *****OPERATOR-MOUNT TAPE FOR XXXXXXXX ON UNIT 0 WITHOUT RING READY (Y/N) @P FILE COULD NOT BE LOCATED @P FILE SIZE EXCEEDS 3000 CHARACTERS @P THIS IS A SUPERVISOR COMMAND ONLY @P LOAD COMPLETE. MOUNT NEXT REEL IF MULTI-REEL LOAD.@P RECORDS ADDED TO THE XXXXXXXX FILE @P 8 DUPLICATE RECORD CONTENTS @P hTx G H I T G Ju K Jn LTn M\ G J K Jn M Ln T@P n M| M\n M\ G J N Jn M L\n M| O MT| PȞ .ț T| R@P P GTx M| S M TȈ T 7 7 P P '\| U P Gd +d@P W" \| M X M̖lT t G J Y Jn L̈ 6 T ~ Z dT ,@P  +g -TT ,d 5 [f  ET P̥ 1KT | \ P G̛ ]@P ?r̥ Ad ^ A" Ald _d `n\ S J 8 a Ld 8\ S J _@P j LnT P P &\| b P G4T & Vhh~T G J c Jn L@P \ G J a Jn L1\ G J d Jn L @P r @P \ G J d Jn LT h \ e \\| M  f M\ G J g Jn LT P@P @P TTPLODFILPQ8STP STATIT PGMIN iWTREAD CCSBLK CCSMVA OPENFL FILERR 7CCSCST GETFCB FREAD DISP WRITER -PUTS qPCCSADD CLOSFL PGMOUT PLODFIL PLTRBLD B75 F CCS CCS 3.0 .LA PSR 07/83 SL-149@P@P@P@P@P(@P)3Kd 0@PPQ<"@P0,/@PU@P@P 2@P  @P @P2000*'&@P @P F@P"@P@PE******************************************************************************** @Pp  @P  @P @P  @P  @P  @P @P>  @Pi @P} @P  @P @P @P@P)@P=@PLTRDESC @PFLALTRDSC  @PULARPTTBL  @PdLALTRFIL  @PsLAUTIFIL  @PA*A, ,@P @P@**1 @PD=F @PHDR1HDR2HDR3@PEND LTR1@PLTR296@P9M@P99*@P$@P** @P @P2@P@PN@P @P1@PV@P@PEXPECTED "*A," - FOUND " ". @PFOUND AN ILLEGAL BLANK IN PARAMETER " ". @PEXPECTED LETTER NUMBER - FOUND A "COMMA". @P&DUPLICATE KEY - LETTER NUMBER XX ALEADY PRESENT @P>EXPECTED "END" FOUND " ". @PLFORMAT MISSING "=" SIGN @PXFIELD DESCRIPTION EXCEEDS LIMIT OF 9. @PkEXPECTED "F" - FOUND " ". @PxEXPECTED NUMBER WITH RANGE OF 01-99 FOUND " ". @PEXCEEDED PARAMETER LIMIT ON PARAMETER # . @PLINE NUMBER IN FIELD DESCRIPTION EXCEEDS 24.@PCOLUMN NUMBER PLUS FIELD LENGTH EXCEEDS 54. @PILLEGAL CHARACTER - FOUND " ".@PILLEGAL USE OF PARAM 5. TYPE FIELD DOES NOT = A.@PUNABLE TO LOCATE FIELD NAME " " IN RPTTBL @PUNABLE TO LOCATE LINE CONTROL OR CONTROL INVALID. @P*NUMBER OF LETTERS EXCEED 50 @P82@P:NUMBER OF LINES EXCEED 24 @PGMAX. LINE NUMBER FIELD EXCEEDS LETTER SIZE. @P]UNABLE TO LOCATE LTRX IN THE UTIFIL @Pp LETTER FILE BUILD @PPAGE@PAS OF:@P**2 @PT Y @P00 @P @P"TȪ  dTsȟ Tss\UU\d@PMd\FTF (TF\>U '\UT@Pxh\Td d f 1\d '\d\.s̻@P '\s dT̨ޜ̡ '\ ddd @Pddddddddd TT<\@P dTT\\\\p\@P $p4d,ddp4d,dlp4d,dld 0h@P O 0Ȉd 0h 0Ȉd dT/ T @P z1\ dTT T\\\@P T l\\\̨ %@P @P \d\ l l\\ lT d@P  G@P \\lT q dT T d\ \@P ) l\\\̆ !̇lT \>\@P T> fl\\\ d\ d hT  9@P 4 1  BHlT 1\T @P \ dT T  ;\=T I\@P d\ l\\d\x\x@P  l\\\ d\Tڤ F (Tb@P +  dddT  B 2̝lT @P V hdT T T d\k\k@P l\\̿ \d\ l\@P \ d d T z d # )1\̞l\L@P ܥ dT _T gT S d\ l̲l@P \  94̶ 1E̲ ̫ ̤ ̝ ̖ @P -W̐ ̉ T i\\̬ ̧ @P X̖ ̝ ̌ ̕  ̌    "@P  \l dT  dd T   @P  \ 1\T>ڤ 14T 'U@P T >d\\\ dT @P T T = d d d-\  lT@P /  Td\$ll ll l d \  l@P Z\  d 7"\ \l\,Ȍd l\ @P U @P Z @P d @P  @P "T  @P < @P   2  2   ; ;@P  ̽  ̺ l̶ r  @P  @P ̺  dT / @P  @P ̓ ̠   6̒  2 3  @P      @Ph@Pv@P@P@P@P -@P @P7T 7"p4d\l" : '0WV lܺ " "@Pb d T   "l\ d̼d  @P "̱ " l\ \ ̑d @P " "d l̼d 7"̒ l\  lܤ̃ @Pl\ TjO@P !@P 5@P̏   d  l d T  (@P@P d!@P (#@P#  2 l l\  @P ;@P;@P;T<"p4d\,d  l\  ܽ l\@Pf@P k@P/k@Pk2w"\l\$l̐ lT  ܌ l\@P@P @P̽  d \  d 7" @P @P l\@P l@P u@P @P @P @P @P @P@P&@P8@P:@PT  0l\\ lR@P @P^@Pc@P\\F@P @P\\\3@P h@P\\'@P @P\T@P @P @P @P\̮ 0l\\̝ l@P P-@P-d dT T @P C@PR@PC@PC  2 @P J@PJ v 2 @P X@PXTl\Xql\\@P Oq@Pq d\ lT  2\L  v@P @P\m  ddd\\Wd d@P\v\v "\2 md\r\ @P>\>l\:\:̏  2d<\@P\9̘l\9l\ \  " N@PC l 5l\\Gkd\\ K@Pnd\4  9" 4" 2  @Pۜ  \dd dl   @P   l ̒l ̌ l\$ l@Pl   d \  2 0" d @Pl\  ,$ l\  l\ ̼ l@PE\  [ l e  &̒l 6@Pp"\ dl l 2p \x @Pl׌l\\b d\\O: l l@Pvd\k\k8 " Tڤ@P 2$\d\Xd\&\&l\@P\ܵ\2\\Fl\\\@PG\\\p\p 4d@Pr,ddp4d,dlp4d,dld 0d 0Ȍd 0l 0@Pd d\c \W 2\I@Pd\l\l\\/\'\\@Pl\=\=fl  "T\? @Pd\*5l\ \ @P 5@P5 d d 2r d"tοm "tηdnnd "r@P`k "oΠlnn̓l l"S 2l̶ 2̱ l̺$@P h\{E Ylh\m@PY\el\YY\QY l 2 l@P\.Y,  2'\s\.Y U@PU 2 \Y\YT.Y 2'\@P Y r\0h 9~h\YOh\@PK\%D\hv fQhl\]!\]@Pvu 2Ohai hU\\T\ \.@PTTPLTRBLDPQ8STP FMRDEL|PGMIN #CCSCST CCSMVA OPENFLYFILERR UTHEADxCLEAR GETS |CCSBLKYFWRITE:DISP BLTRDTE PCCSGET CCSPUTREADR ICCSAD@PwA.@P})B'i"=6@P 3@P0s2jJpPNl(@P @P @P: @P@P  @P  @P*  @P31  @P^ @Pr @Pv  @P @P  @P @P  @P @P3  @P^ @Pr  @P @P  @P @P  @P @P/  @PZ @Pn  @P @P  @P @P  @P @P+  @PV @Pj  @P @P @P @P"  @PM @Pa  @P @P  @P @P  @P @P   @P I @P ]  @P @P  @P @P  @P  @P   @P E @P Y  @P @P  @P @P  @P  @P @P /@P C@P d  @P @P  @P LACOSIGN LADLQMST LALTRFIL  @P LATRNSFL @P COSIGNERDELQMST LTRFIL TRNSFL @P A*@B@P  ,,@P (@P +1 0 @P -D$@P 5F=@P 3EXT @P 6END 9@P :N @P <012@P ?@P BY 00@P D@P G@P F@P H@P K@P N@P LTRF@P @P SALC@P @P @P @P 1234567890123456 @P  DO YOU WISH TO PRINT ALL OF THE LETTERS REQUESTED BY THE COLLECTORS? (Y/N): @P LINE THE * TO THE TOP OF PAGE AND SEVENTH CHARACTER POSITION@P  DO YOU WISH TO HAVE ANOTHER ALIGNMENT LINE PRINTED?  (Y/N) :@P 7 ENTER ACCOUNT NUMBER OF THE NEXT LETTER TO BE PRINTED - (16 DIGITS MAX). @P _ UNABLE TO LOCATE ACCOUNT IN THE DELQMST FILE @P UNABLE TO LOCATE ACCOUNT IN THE TRNSFL FILE @P UNABLE TO LOCATE COLLECTOR TTTT IN UTIFIL. @P LETTER TO BE SENT TO ACCOUNT NUMBER XXXXXXXXXXXXXXXX HAS NOT BEEN PRINTED @P UNABLE TO LOCATE LETTER NUMBER TO BE SENT TO ACCT# . @P UNABLE TO LOCATE ACCOUNT XXXXXXXXXXXXXXXX IN THE COSIGNER FILE @P01 UNABLE TO LOCATE LTRF RECORD IN THE UTIFIL @PGRE: C/O @PKP@P` @Pb@PT I JTQ_eaT fQghȞ T g i\ g i\ g @Pi\ g iTbj\ckTM`LabTUdcM  a ld +md@P ,ThKO " d / d 0 d 1T 4 oo "\ L o@P7 "\  o d 2 "\  o d  " d Ed d Od d T@PbKT3fK\ fg\ pqp\K\rT_ @ s @ rt@P B  : T uvv "u \ w0xw\yz dz@P\ yuv " \0{KTK\r\_ @ r @rt̪@P .̥ T`r 7d \_ @ 7rtT_ @ x @rtt Td@P i Ad d T L o B cT L oo 2 - "@P9T i i|| \ }f <f| \ ~f f|  4\ @Pdi i\_ @ ta J T i\ f d \ L  o̥ @P̞ "\ }f <f|̧ \ ~f f|̛ TUd  T @Pi i\ w w d &T< w whh I\ wwh RT @Puvu Fv "\ w w\ {K +d3T3K ,l\@P3fK\K\3K\ i i\ rK\KA\ ~f fT@P;  \ f f|| T f fT 4 oo 2   ?@Pf  "\ f f\ i i\ rK d Fd Gd Ld Nd Kd@P l d HT{ dT Lf 5f|̟ * l\ L :|̏  @Pld >\ L H l̾ lܷ 1̵l 3 !l !hTV  o@Po ?   2  "TN ii\rK $d @PhJ\\ P 2h@\\ _T n Ph2\\x }x dh(\\y y\@P=  hT;\ \  o̚  ̕ ̐ "@P]\ i _i\ _K\ T  Ô  4 34 @P1Y\ \ P\ _\ n\ }x\y  yT%@P -\ PTC \ _\x }x\y y\ @P\ n +d3T3K ,l\3 (K\K\ kT / Tu k{k@P d\KK d\\\\Gw{wTyy =f|\ f| \@P4 \K d T\v 8 !0 !, l  d\ dg@P_g d\ |  1 3 l l l\ P $|̨ @P' 1T P  d *T  * ||  l 1 lx ̱ d@P\ Pv̦ dl =\ P | ܓ\ P ۄ lLl@Pl =\ P |̸   d ) d\\ P\ |̡ l@P ld *T P ) * ) l\v *댎 lT3KTCK\@P6 8\K\K Ô  \Iw 8w 8 l\ \\ K\@PaK\ _ 8\KT n || \K\ n 8\ K\@PK\ }x 8x̻ d\T y\y\K\KT)3KT/  >d L @Pd d ' dd M $p d $ dd\ L 6|̜  @P4 d 9!f T L  ̶ܹd %ܱܲ\ L l̼ @P l\ M % \ % lΜ"̜n\ LД  q̉l l̗ d\T M@P8 % \ %̋l L\ L̰ d\ Ļd ; l\ L̝ d '  $ @Pc l\ * \ *  *l l l\  \ l l\v \@Pք l\ ;f $  ܝܜT L l ̏ M d %S@P L[ 2 l $ d  `Hdd D@P $p dHld nd  -  . Z   @PT / ̛ ̗ T "\  {T5 \@P: !mT T  % % \   \ q qM\q\  @Pe\  dTo ||  1 d Al\ .f @P  d d\\ \\ %  % 2 l $p l $@P d Cd 'T>K 1" ,d Addl  @Pl  lTK̔ lT0 \ 8\Kܦ 1\3K\K @Pd \ f l 8 d 1*  d\ dgg d lTq@P< ||  1Ԍ l\x\y\K̸ @Pgl\ | TTwTK\w w|̶ \@P\a 3 d\\Tw\w\K\K\Dy ,d@P\K@P@P @Pl@P +d3\3Kl\3fK\K@P@Pl\3fK`@PS@P@P d # l  lT o_ dF@PG@PZ@P l # l  l\ o_ l0@P2@Pl@P 7l # l  l\ o_ l@P;)@P:)@P)@P) Ol #̸ l̵  l\ o_ l@P?@P?@P?@P?@P? l@PB@PyB@PBT 4o\ Lo\ o\ o\oouvf\(oKTTPLTRPRTPQ8STP _ADAYTO AMONTOAYERTO%PGMINTPGMIN CCSCST;CCSMVAGTSYSPPRTORFGETGRPSYSPRTOPENFL)CCSBLKuPWTREADGETUTIREADR GETS )ICKGRPCCSGETLTRDTEBEDIT yIDATVR!FILERRCLOSFLCPGMOUT]PLTRPRT PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVA@PR@P}@P@P@P@P@P @P :@P N@P y@P @P @P @P @P @P 6@P J@P u@P @P @P @P @P @P 2@P F@P q@P @P @P @P @P @P .@P B@P m@P @P @P @P @P @P *@P >@P i@P }@P @P @P @P @P&@P:@Pe@Py@P@P@P@P@P"@P6@Pa@Pu@P@P@P@P@P@P2@P]@Pq@P@P@P@P@P@P.@PY@Pm@P@P@P@P@P@P*@PU@Pi@P@P@P@P@P@P&@PQ@Pe@P@P@P@P@P@P"@PM@Pa@P@P@P@P@P @P@PI@P]@P@P@P@P@P@P@PE@PY  @P @P  @P @P2@P@P**TOTALS@PLTR1@P000000@P1---------- HDR1 GOES HERE -------------- COLLECTOR LETTER STATISTICS @P PAGE @P @P ---------- HDR2 GOES HERE -------------- AS OF:  @PE @PY @P\ ---------- HDR3 GOES HERE --------------  @P @P @P LETTERS REQUESTED  @P @P @P COLLECTOR  @P @P @P" COLLECTOR  @PM @Pa @Pd COLLECTOR  @P @P @P COLLECTOR  @P @P @P[ TOTALS  @P @P @P LTR1 RECORD NOT FOUND  @P @P @PUTIFIL SYSPRT @P EXECUTING LTRSTA @PP @PU@PV **LTRSTA** ERROR IN FILE : XXXXXXXX RUN ABORTED **********  @P @P @P@PTQTȸ T\T@PTTR\STPQRT TST '\ "@P2T " dT\\(\<\@P]Q T dT3U "U  \ d$@P d  d d  dT3 -\3@P ! B,݀hT3@P\3f4ܲ 1ܑ 1\T  @P "d  2 d" $d $d hX\ @Pm̈  )hHT m  h6T T m @PC )h)T md h\ m W 214 d lw@Pn l lTq d f 24 f d d,h f 21 d1@P  d h\ mq h\ m d8̒4 @Pd d,h d,h "λ n'@P l d̙! l= d,dmΕnܺ l̶! @Pl= d,ڌl줆nܞ lݜ6Ǝl̓d # lp4@P3 d d",d d d2 $ d,d̦ "̢ll@P^"7  d LTTF 1 d̴ d B@P,h\@P ll 3̞ l B,hT@P  \ 1Ts\qTk3U "@PU \3\3 #d 2 l d!$  d@P$ d d$h Tp@P Tt 1h\@P"̿ l\T%  !G BTa d̝!@PM  l̨, lh\@P]\[ /\ d\[\\[@P>@P̶ n3@P>@P@Pd # l  lTTV d@Pv@PT/@P3@P\V l \VTT3U\TTPLTRSTAPQ8STP PGMIN CCSCST'CCSMVAWTREADUTHEADGTSYSP PRTORFGETGRPSYSPRTOPENFL5EDIT CCCSPUTcGETUTIPGETS ICKGRP9CCSBLKDBHXDEC FILERRCLOSFLPGMOUTPLTRSTA PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVAh hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPBHXDECcPQ8PKUPkQ8PREPhP P+MHUPDT B79 F CCS CCS 3.0 .LA - PSRD 07-83 SL-149@P@P@P@P (@Pd @P@P @P@P2m@P 51@P.@P@P @P1@PX@Pg@P@P@P@P@P@P@P@P!HDR0RSW1@P  @P @P  @PA @PU  @P @P  @P @P  @P @P  @P= @PQ  @P| @P  @P @P  @P @P  @P9 @PM  @Px @P  @P @P  @P @P  @P5 @PI  @Pt @P  @P @P@P@PRSW@P@P@P@PRELEASED SATISFIED WRITTEN-OFF @PDELQMST COSIGNERSUMHIST TAPEARC @P"LAINACCT  @PILADLQMST  @PpLACOSIGN  @PLAACTFIL  @PLASUMHST  @PLATAPARC  @P LAUTIFIL  @P,3qw@P6}hZ @P@)@P&@P "RSW1" RECORD NOT PRESENT IN UTIFIL @P*@P VALUES IN "RSW1" RECORD -- NOT NUMERIC. @P%END OF HISTORY@P2@PJ@P END-OF-TAPE -- MOUNT ANOTHER REEL. CARRIAGE RETURN WHEN READY. READY @PTT ȿ 3T""\I\p \@P<\\\  Ȇ T "ȃ (T"@PgT\1I *\IT \\Xp ,\p\ \1\\@P /\\ \1\X\\ 1\\ \1\ X\@P\\̫ 1\\ \1\X\\\T[ ̍ 1Tc @P\ \1TxX\\\Ti d"T! @P )\ \ ,1hT%@P ( 1\#׬؜ .T\ d f ,d@P S lhT u 94 1\Tv@P v $ˎn ڬ$n Ь$췎n 1ܯ 1\@P dddTdTdTT # d@P d d.T xdTz  T@P \\\TA@P (1H0,9X,6HTOTALS,//,12X,13HRELEASED ,I5,/,12X,13HSATISFIED ,I5,/,12X,13HWRITTEN@P +-OFF ,I5,//,7X,18HMOVED TO HISTORY ,I5) @P @T T % d TlT\̂ (T" @P kTJ  \JT Z d d N@P 1 l dIfQ 1T 1R  '@P \I#T E\ l̷ ܰ 1T l  !@P \T ̷ *T a"T d$d u\d@P  " dIfQfafYfifr 1 T 1R @P B   '\Io  ldd @P md5h?h5h +hT @P @P 1dddd uݬlT m \@P T1 ,T I TZ 13\@P  T 8Z '\\T ̾ '\ @P dT A\Xb̨,̢&̜ '\p lT X @P 3'\pT J\d drh\@P Vj -լ cT hT J@P r Iπh\@P ̮ '\_\Jj̶h\J@P ޔ 1̤ l! d̙ d dKT  d#@P ? #  l l-\{T sQK (T@P a  d T{  @P (A2,1H/,A2,1H/,A2)@P  lf̥ l 1T <T ̴ '\*T  \J@P >\\JsT s̊ '\  T @P iza  dDh T @P w 1\T @P (1H1,20A2,8X,27HACCOUNT MOVEMENT TO HISTORY,42X,5HPAGE ,I3) @P \zc lȀXh\@P 1 dh\@P 1 ḽlh\@P ܧ 1\\\\@P (1X,20A2,12X,10HRUN DATE: ,A2,1H/,A2,1H/,A2,/,1X,20A2,9X,15HAS OF: RELEASED,I3,17H DAY@PS, SATISFIED ,I3,19H DAYS, WRITTEN-OFF ,I3,5H DAYS,/,1H0,15X,7HACCOUNT,9X,9HBORROWERS,@P+24X,8HINACTIVE,9X,4HDATE,5X,14HDATE LOST WITH,/,16X,6HNUMBER,10X,4HNAME,30X,6HSTATUS,8@PVX,28HINACTIVE TAPE ARCHIVE DATA,/)@Ph@P fj@PjT hzh  dh T u@P| 1 lh\@P 1 l $h\@P 1 lӀh\@P 1 dzh\@P 1T @P(11X,8A2,4X,R1,14A2,A1,3X,6A2,5X,A2,1H/,A2,1H/,A2,4X,4A2) @P̎  d@P @PdTTTdT U\T <@P l\\\lլTTPMHUPDTPQ8STP *Q8QINImQ8QX zQ8QENDAMONTO ADAYTO AYERTO STATITPGMIN CCSCST mCCSMVA !OPENFLFILERR PGMOUT(PCLOSFL pREADR WTREADCCSGET ICALJL ICCSAD CCSBLK 9GETS TAPMOTUPDREC )DELREC ,WRITER RENCODE FWRITEPDISP PMHUPDT PNEWS B81 F CCS CCS 3.0 SL-149@P@P@P @P@@P(@PP@P'J @P @P*NEWS CCS20 @P @P COLECT @P7@P9EX @P>@PELALEGAL @PJ**************************************************************************@Po************************ N E W S XX/XX/XX ************************@PANSWER 1,2,3(CR)@PREADY @PNEWS  @P@P@P.@P@P TAdddhhAE TZ;@P5TTL@P;(A2,/,36HCHOOSE ONE OF THE FOLLOWING OPTIONS:,//,2X,12H1) NEWS ONLY,/,2X,34H2) DISPLAY@Pf NEWS THEN GO INTO LEGAL,/,2X,26H3) SKIP NEWS GO INTO LEGAL,//) @P d>T>H d 1 1 TET@P 2y T\\ 2yݬ \@PT0Z-T6T9M@P(A2,/,36HCHOOSE ONE OF THE FOLLOWING OPTIONS:,//,2X,12H1) NEWS ONLY,/,2X,35H2) DISPLAY@P NEWS THEN GO INTO COLECT,/,2X,27H3) SKIP NEWS GO INTO COLECT,//) @P: d>T>H d 1 1 TT@Pe / TTT Ɣ8 @P *\ d7d d" $d@P $d ο=  hT W d@Pd@PTZN d IhT@P %1T@P(1H ,37A2)@PTo\ZQ lnh\@P %1\\ZR lɀIh\@P/ %1\M h\̙ ll hTZ\Z@PZZl l̓h\@Pe܍ %1\@Pl(1H ,37A2)@Pq ddi)7 , d>T> @P> TZjTT@P(A2)@P lM@P@Pp@P@P@P@Pll-Ṯ )\Zs\\@P(A2,///,20X,25H***** NO NEWS TODAY *****) @P lll T 9@P@PX@PAE \F\ @P@P@Px@PTTPNEWS PQ8STP Q8QINIQ8QX Q8QENDAMONTOADAYTOAYERTOFMEOFC FMRDEL$PGMIN  WTREADCCSMVAQOPENFLbFILERRrPCCSBLKzGETS ~CCSCSTEDIT  CLOSFLCHAIN PGMOUTPNEWS P NMCHNG B82 F CCS CCS 3.0 .LA PSR(05/83) SL-149@P@P@P@PZ @P @P@PyDELQMST @PLADLQMST  @PLAADDACT  @P@P @P} NAME CHANGE KEY-INDEX ERROR *** PROGRAM CONTINUING...@PTmTm Ty\T  (T@P\Ⱥ '\T #Ȫ Ȥ '\T@P #-- T#T # '\\#qTq@P 3 &\kT# T\ @P ^T\̵ 1T\T̝ +̚\@P \Tq 2 ^\T\ TTPNMCHNGPQ8STP PGMIN CCSCST =CCSMVA KOPENFLFILERR kGETS CCSGET CCSPUT UPDREC READR .CCSBLK _DELREC zWRITER PCLOSFL PGMOUT PNMCHNG PPGGEN A16 A CCS CCS 3.0 SL-149@PPPGGEN PPGGEN0P PHQ8QBDS B89 F CCS CCS 3.0 SL-149@P0UTIFIL  @P0DELQMST  @P0RPTTBL  @P0-RPTPGM  @P0\;T@P 10f01)\1\?10d00dd00d00T90@P J0dddT3{00-  \\33f@P u*f0+f,έT 3\3WÔ  8f-\@P T1 r100 d002 d003 d001d00  d  d@P $ d dT, -  2 93 " lT3) 9\@P3 \3̺ l 1$ l0(T 1\1O18@P !̰ d̕ l̡, l d\10 0 1 93 # d\) @P L l 1 l lT33 0" l1 \1 T @P1 w107 !ܜ !0$ ḻ T)10), l\@P )10), l1T)), d1\)), d, d d@P d d̏!T )\) ! 4T T v1@P @P @P l̉$ l(\1\1m10T ^30 " l01@P *  r " r0$ d  T )1)0~T 1))u@P T@P Td00dd00d00 " lT D1300dddT3 U{08-@P 0 T 1T 33 ̍0h   1@P @P0 30 002 ̱f.0̯f/̯f0 0l@P @P1 \1\101\\S\1 d0dd0 d0 dTX @P l l h0 dldd0d00 2 IF(ICMP.XX.0) GO TO X00@PJCALL QCST(A,WRKMST,K+XXXX,XXXX,WRKMST,K+XXXX,XXXX,ICMP) @PfCALL QCST(A,WRKMST,K+XXXX,XXXX,IVLXX,1,XXXX,ICMP) @P 200 CALL CCSBLK(EXTREC,132) @PGO TO 300 @PCALL CCSMVA(WRKMST,K+XXXX,XXXX,EXTREC,XXXX,XXX) @PDATA IVLXX/'XXXXXXXXXXXXX '/@PqIF(ICMP.GE.0 .AND. JCMP.LE.0) GO TO 200 @P PROGRAM RPTEXX@Po INTEGER A,N,T @P INTEGER ID(4),LU,ISTAT,EFG,FDEL @P% INTEGER REQBFD(24),IDATDM(15),WRKMST(9000) @P> INTEGER REQBFE(24),IDATEX(15),EXTREC(68) @PV INTEGER IVL01(7),IVL02(7),IVL03(7),IVL04(7) @P INTEGER IVL05(7),IVL06(7),IVL07(7),IVL08(7) @P INTEGER IVL09(7),IVL10(7)  @P INTEGER IVL11(7),IVL12(7),IVL13(7),IVL14(7) @P INTEGER IVL15(7),IVL16(7),IVL17(7),IVL18(7) @P INTEGER IVL19(7),IVL20(7),I(8)  @P C @P EXTERNAL FMRDEL @PC @P DATA REQBFD /24*0/ ,REQBFE /24*0/ @P+ DATA IDATDM /'MMMMMMMMCCS20 ' ,0, 9,0 / @PG DATA IDATEX /'MMMMMMMMCCS20 ' ,0,1,0/ @Pb DATA EFG /0 / @Py DATA A,N,T/ $41,$4E,$54 / @PlC @Pm CALL PGMIN(ID,LU,MODE,NPORT)@P~ ASSEM $C000,FMRDEL,$6400,+FDEL@P CALL OPENFL(REQBFD,IDATDM,ISTAT)@P REQBFD(23) = 1@P IF(ISTAT.GE.0) GO TO 50 @P CALL FILERR(IDATDM,3,ISTAT,LU)@P GO TO 850 @P 50 CALL OPENFL(REQBFE,IDATEX,ISTAT)@P IF(ISTAT.GE.0) GO TO 100@P CALL FILERR(IDATEX,3,ISTAT,LU)@P GO TO 850 @PC @P 100 CALL GETS(REQBFD,WRKMST,I,ISTAT)@P& IF(AND(ISTAT,$8100).EQ.$8100) GO TO 850 @P= IF(AND(ISTAT,$100).EQ.$100) EFG = 1 @PR IF(ISTAT.GE.0) GO TO 115@Pa CALL FILERR(IDATDM,14,ISTAT,LU) @Pt GO TO 850 @P|C @P} 115 DO 300 M = 1,9 @P J = 1000*M-999@P K = 2*J-1 @P IF(WRKMST(J).EQ.$2020.OR.WRKMST(J).EQ.FDEL) GO TO 300 @P CALL PUTS(REQBFE,EXTREC,1,ISTAT)@P IF(ISTAT.GE.0) GO TO 300@P CALL FILERR(IDATEX,11,ISTAT,LU) @P GO TO 850 @P 300 CONTINUE@P IF(EFG.EQ.1) GO TO 850@P CALL CCSBLK(WRKMST,18000) @P GO TO 100 @P" 850 CALL CLOSFL(REQBFD,ISTAT) @P2 CALL CLOSFL(REQBFE,ISTAT) @PB 900 CALL PGMOUT @PK END @PP*JOB, @PS*K,P2 @PV*FTN@PX MON@PZ*LIBEDT @P^*K,I08,P08@Pc*P,F,2@Pf*K,I08@Pi*N,RPTEXX,,,B @Pp*Z@PhThhhT1 "T hT h\@P\Pș Ph\Sȏ Ph\Vȅ Ph\ Pl@P\ Pl\o Pl\ Pl\% Pl "p@P?4dHd l\>̿ Pl\V̵ Pl\̫ PlT@Pj̠ Pl\̖ Pl\̌ Pl\̂ Pl\ @P Pl\  Pl\ Pl\ Pl\6+@P\:G\+ Pl\G̿ Pl\b̵ Pl\y@P̫ Pl "p4dd0)  dld0!c Ad@P0 , RT1Ti1 1hH\) q h=\ q Pl@P A( & d\1\1̱ h\) q h\ q Pl@P l̚ "lܚ@P r̿ "p4d & dG l\l̤ Pl\m̚ PlT ~@P ̏ Pl\ Pl\ Pl\ Pl\@P  Pl "p sdẊ lT @P x1̈ \1\ l:\1f1\f\f@P  l l̴l\>l( @ l@P lT R>ldBdH\> dl l\>@P lκ 6̺ !̜l̼l\> ll̬l\@P $>l̮l̰l\>l( @Ȕ  ̏@P Ol lT >?lkdBdH\> udVll@P z\>?lEκ 7̺ "l̻l\> l(l@P ̫l\>?ḽl̯l\>?l0( ?0Ȕ @P ̣l lT T>?ldBdH\> d̙l@P l\>?l !̄ll\>ll̴l\>@P&?ll̷l\>?l@P +?@P Z?@P ?@P ?@P ?@P +?@P ;?@P? "l AdX@P K@P0KȔ  \]ln@P ]@P]T  dml^ ld l0!b\1T3 {08 @P"1T  4\ 54$5 d3T w31\1\1\@P\1\1\d1\ ̡l l  d\@P PlT^ Pl\ Pl\ Pl\@P  Pl\ Pl\ ̺ Pl\̰ Pl\"@P4̦ Pl\2̜ Pl\B̒ Pl\K̈ Pl "p4dbd@P_i d\X PlTZ Pl\^ Pl\c@P Pl\f Pl\1i\i̽ Pl\p̳ Pl "@Ppd0?\v4l̤l@Pd:\s140dDḷlli  2X d"^  d@Pnjdd6lTZs4ldIdJd0Kd0M d*@P Xl0 H d!Cll\s4̛l̽lT^_l $  d@P15\T4\3^\^14\14ܺ v@P`dld6d:Ty4dDdIdJ0dK8d<@Pd=d>\140 7d l!/̽l̿l\y14@PlT0(^00_dE̢lll\4\^14]܄ľl\|@P4ddd1Tp49ld06\|4l@P ll\140ld<0d=0d>\v43d @P7 d"̼llll 0dTs04\4$  d@P1b\ 4Ԍ dddT14l0d6d:\m94@P\ 14d0IdJl̗ Yl̾ l\p4̳@Pl̰ l ̈l\14dc, l̬l̓ l\m4 @PA dM\ 14̠l̢ ll3̽$ l !28d6@PԌ d:Ttm4A l\1 4dI dJ:l@P9Yll l\140dD0dE0dF@P@\@P\wd̩l0d<0d=0d>\v4d 2l "W@P̆ dd dd60d:Ty14llldIl@PdKlll 0 d\14ld0l ; d!@Pv̸l̪l\y14̦dDT^_dE̠ld0J̼d< 0 l\4@P1\^4"0 ;Qdd6d:T4̊l̋d0 =̋d>@P3\4ld\4\14܇̪ +el l\@P^4l̪ d 19 l!5̤ld8d9Ԅld@P<flKl\y140 dD0/dI0dJ0(dK@P@P@P8@P0 A hh l0 !5d6T$m4\148 dIT@P^_dJ h1\4 hCܓ hl\p4 @P0 dN0dO* 4ḏl\y4dDdIdJdKd<@P0 ,d=0d> Yl̇ld<d=d>T4MdDQlpl@P W yl]d6d8`d9\14d0D]d0E l= d6\p@P 4dN9dO h$d6d<Vd=\v148 @P u h!q hh hl0)d70d:T Fs@P 4dDdIdJdKF 2 h !,l8d7@P d:\s140dD0dIT0^00_dJ #dqܒ 0h @P .l" X hQ hG{h lhd6 d7@P Y6 wlT y4mdD# VdD OdE  SdF@P d0I?d0J`d0KFd0<Cd0=@d0>\4 N h @P h0 !Dd069d07 d0:\y4dDT ^ _dE@P d00I_d0Jd0@P(d0H PPGGN2PPBINASCASCBINPUTS 4CCSBLK@CCSPUTQCCSMVAREADR CCSGET P PAPGSEDT B97 F CCS CCS 3.0 SL-149@PCAREPEAT    l @P' l lHTTh\h h h hPPGSEDT/PQ8PKUP5Q8PREP2P PZPGSJL B98 F CCS CCS 3.0 SL-149@P@PT hh h?TT@P/h h=\\@PCHTTh\h\h\h\h\hPPGSJL FPQ8PKUPLQ8PREPICCSBLKCCSGET!CCSPUT&P PjPGSJR B99 F CCS CCS 3.0 SL-149@P00@P hj 1 h hh h!TT@P= hh h=\\ؿ@PSHTTh\h\h\h\h\hPPGSJR VPQ8PKUP\Q8PREPYCCSGET-CCSPUT2P PH}PGSLST C01 F CCS CCS 3.0 SL-149@P@P(@P@Pvw D@P ")@P @PPGGEN REPORT GENERATOR DATA NAME LIST @P @P @P STARTING DATA EDIT DEC SUB S@PTK\K ddd3T{3̗Ԝ̐ "- Ք@Pi "ܹT^_dC dd df B1T@PTl lJn B1l ln B1l  l@Pn B1lTl lnܫ 71l lGnܜ 71@Pl\ d0d0d0d0 d0 d0 d0 dT=@PTB\\\\\\ d d d @P@f 1 Ml 1l lT l l 1Qd%@Pi@Pi@Pi@PiT8@Pbp@P1p\;@P]u@PuHlPPGSLSTxPAMONTO.ADAYTO8AYERTO3BINASCsREADR CCSMVAQCCSGETCCSPUTGETS RFWRITEDISP CCSBLKFILERRjP PPHDEL1 C02 F CCS CCS 3.0dELA SL-149@P@P@P@P@P@Pd @P@PTAPEARC @P3LATAPARC  @PLAUTIFIL  @P@PTMTH@P@P0000@PTBTB T\3hhT@P(FTz hȼEhT@P9ص 1 hȮYh\@PFب 1 dh\@PT 1 hȓmh\@Pa؍ 1TT d " \3 l "T l@P " ݤvHhn$hhH$b`dT l@P̹Ҝj̴ !Z$hIH,܈Dd&h>H,ш9ddd ,@Pl !T+z-  dh T7@P 1TgT d >@P\r2\r3  T3\\r8 TTW@P/1@P1(1H1,20A2,6X,39HACCOUNTS BEING PURGED FROM THE TAPEARC ,4HFILE,/,1X,20A2,14X,10HRUN DA@P\TE: ,A2,1H/,A2,1H/,A2,/,1X,20A2,//,35X,14HACCOUNT NUMBER,10X,18HARCHIVE TAPE DATES,/) @P8@P(34X,8A2,2X,A2,1H/,A2,1H/,A2,2X,A2,1H/,A2,1H/,A2,2X,A2,1H/,A2,1H/,A2,2X,A2,1H/,A2,1H/,@PA2,2X,A2,1H/,A2,1H/,A2) @P@P(//,52X,21H*** END OF REPORT ***) @P@P(/,34H ERROR WHEN UTIFIL RECORD NO FOUND) @PTPPHDEL1PQ8STP Q8QINIQ8QX Q8QENDMONTO YERTO #PGMIN CCSCSTCCSMVAUTHEAD'OPENFLiREADR GETS DELRECPFILERRCLOSFL+PGMOUT/PPHDEL1 PPHDEL2 C03 F CCS CCS 3.0dELA SL-149@P@P2@P5@P8@P<d @PD@PJ@P@P(SUMHIST @PiLASUMHST  @PLAUTIFIL  @P|@P @PSMTH@P,R S W @PINVALID STATUS@P  @P0000@PJTx/01T2x34 T563\(3i3hhT@PuT|: hȻ "\i: hȰ "T|: hȣȟ "Ț@PdH(d(d@Hl>$AlH$?@PˌdlH,l,d dB !BTz+  dChT@P@P 1 lh\@P 1 dh\@P 1 lՀh\@P 1T lT : d;:</ "#T]'2 dE@PKҔ, l- l. l s$>hl@H$AedF@Pv&h_H,ZdG7dH9dI ,l "Tz=  dChT@P@P 1\' lh\@P 1 lh\@P 1T&BT: d;: !O @P@P@PT@DD\zD  l̲h\@Pܬ 1\' ḷh\@Pܝ 1 l̖h\@P ܐ 1\ܶTD@P@PTrH\rI Ӏ @P#@P#Ti;:/@P*@P*@P*\;:/\rN T:Te@P;@P;(1H1,20A2,12X,39HACCOUNTS BEING PURGED FROM THE SUMHIST ,4HFILE,/,1X,20A2,20X,10HRUN D@PfATE: ,A2,1H/,A2,1H/,A2,/,1X,20A2,//,20X,14HACCOUNT NUMBER,5X,13HINACTIVE DATE,5X,6HSTA@PTUS,15X,14HBORROWERS NAME,/)@P@P@P(20X,8A2,7X,A2,1H/,A2,1H/,A2,9X,A1,10X,R1,14A2,A1,10X,7A2)@P@P(//,54X,21H*** END OF REPORT ***) @P@P(/,34H ERROR WHEN UTIFIL RECORD NO FOUND) @PTPPHDEL2PQ8STP Q8QINIQ8QX Q8QENDMONTO lYERTO pPGMIN KCCSCSTQCCSMVAUTHEADtOPENFLxREADR GETS *DELRECPCCSBLKFILERR$CLOSFL5PGMOUT9PPHDEL2 PPRETSR C06 F CCS CCS 3.0 .LA SL-149@P@P@P@P01@P@P@PI  @Pt  @P  @P@P L@P@PLATRNSFL  @PTT TT " T@PØȼ "Hd@\ȣ e h @P=Wؤ 1T 9S 2 0lTI !C d@Phn E1dd lf 1 դh Ȥl l@P@P̶ḽḻl̨l d dTTTPPRETSRPQ8STP PGMIN CCSCSTCCSMVAOPENFLGETS UPDREC[CLOSFLPGMOUTPPRETSR P PROVE CHECK FILE MANAGER DATA STRUCTURES @PTTTTPPROVE PQ8STP PRINITPRCHEKPGMOUTPPROVE Pl\10:$:" $Xh\1:#d:"8,d\@P.:#60l d0" ,l0 .TnCZT%@PH(14H1 PROVE RUN ,A2,1H/,A2,1H/,A2,4X,I6,//,15H VOLUME LABEL ,4A2,///)@PlHPPRINITnPQ8QINIQ8QX Q8QEND VPC DISPLABQUIET uPROMPTISHIFTMEMORYERROR MMREADDATTIMFDWADDPGMOUTFP P0= : (h54  (h-, TZ':! (̀0hT@PO (Ā0h\@PVT 0(hT@P`9  hد@PiȬ \R+:!T dd @ h @1> 2 @$hT13:#g:$"!d:" d@Pߜ 2 d `0,;Th0!  l `,;R!h `,ބ00;O!hT@P0:(:" `,ь!hT@P3:,:&:" `,Ō0!h\@P3:,:*:"1\:(:&0:"T^0:*  TBZ=:!TMTW `,dg0!Ƥ * `, ;Q!@Ph\@P:&d 8\Z?0:!\\ `$0!h\@P:( 8\Z@:!\\1T:#3:&d:"\ZB0:!\3\\:& \ZC:!\@PC\\3:* \ZD:!\\ d `0,;Sl0!0  l `,dg08! @Pn l `,l0!”0  l `,l!  l dϔ l @Plޜ l l `$l0"  ̣  TZO:!TT `, ;O!@P hT@P4 3T@P@PD d d l  \ZT0:!\\\  @Pddgn0:.ۜ  \ZV:!\\\ dlnܯ;T:$:,@P0$:$:"S@P(@P(@P(0?  TZ\:!T\?T> Dd! d!Κ Η \@PSZ`:!\h\@P_\\ lΚ Η \Zc:!\:.h\@P{\"1\Re:! l ,dg" \Zh:! 0,h\@P ,0h\@P ,0 hT5@P ,0h\@PT:@P @P(9H NFCB = $,Z4,17H KEYBA TOO SMALL) @P@P(9H NFCB = $,Z4,17H KEYBA TOO LARGE) @P4@P(9H NFCB = $,Z4,19H NO *AL* IN HEADER) @PA@P(9H NFCB = $,Z4,27H HEADER ADDRESS ERROR, FCB) @PN @P (9H NFCB = $,Z4,24H HEADER SIZE ERROR, FCB)@P#@P#(9H NFCB = $,Z4,25H HEADER OWNER ERROR, FCB) @P:@P:(9H NFCB = $,Z4,30H FIAT DISAGREEMENT, MASK = $,Z4) @P3U@PU(33H FILE COUNTS CONFLICT: NFILES = ,I5,12H, VLCURF = ,I5)@PVs@Ps(21H FIAT LEFTOVER, FIAT(,I5,5H) = $,Z4,10H FCB IS $,Z3,1H0,24H+ BIT POSITION ( F - 0@P )) @P@P(5H ASD:,4(3H  $,Z4)) @Pp@P(50H VLLBL DISAGREES WITH ASD - LARGEST HOLE AVAILABLE) @P@P(9H NFCB = $,Z4,17H FILE SIZE ERROR) @P @P(9H NFCB = $,Z4,29H FDB DISAGREEMENT, MASK = $,Z4)@Pr@P(20H FDB LEFTOVER, FDBX(,I5,5H) = $,Z4) @P@P(//35H "ASD" WITH ALL FILES REMOVED IS: //)@PF@P(21H ZERO LENGTH HOLE: $,Z4,1H,,Z4)@P0@P0HPPRCHEK2PQ8QINI/Q8QX Q8QENDTWCMPRCHKFDDrMMREAD$FDWADD!FDWSUBREMOVEP  P3TJ:"TZ3:&:" d̈!3 ,l ,dz8f @P3,l ,l0f ,l ,l0f ,l ,l0f@P Z@P,Z@PZ $" 0l:*n ,d0::+n ,l:&n ,l0:'n ,l n ,h @P,րh\@P0:"T0:&d !e l +T Z~:!TT ,h 0,hT:(@P:" ,l f8;@P@P(6H FCB $,Z4,40H OVERLAPS FILE SPACE WITH LARGER ADDRESS) @P9@P(6H FCB $,Z4,41H OVERLAPS FILE SPACE WITH SMALLER ADDRESS)@P+@P@PHTThh4hhPREMOVEPQ8PKUPQ8PREPQ8QINIQ8QX Q8QENDTWCMPRFDWADDFDWSUBP P6TWCMPR COMPARE TWO 31-BIT INTEGERS @P  h  ! h@P h  h 5 h@P#HTTh h\h hPTWCMPR&PQ8PKUP,Q8PREP)P P:!VT\:.TM\1Z@:!r\\:.\B\ZB:!\0\:.\7 d#hT@P@Pf 1\ZG1:!\:. l爼h\@P 1 lۀh\@P 1\\ lɈh\@Pnh\@Pfܹ 1\ZM1:! ḽh T@Pܦ 1 l̟h\@P+ܙ 1TTZN1:! d#h\@PA 1 lh\@PN 1\@PV(31H NO FCB FOR FDB ENTRY, NFCB = $,Z4,10H, NFDB = $,Z4)@Pr(31H NAME/OWNER ERROR, NFCB = $,Z4,10H, NFDB = $,Z4)@P(31H FDB MULTI-MARK, NFCB = $,Z4,10H, NFDB = $,Z4)@P(8H FDD : ,8(X,Z4),2X,8A2) @P(8H FCB : ,8(X,Z4),8X,8A2) @P(25H FDD HASH ERROR, NFDD = $,Z4,X,8(X,Z4),2X,8A2,3H $,Z4) @P<@P@P"@!HHTT hh" hhhhh\h"PCHKDEFPQ8PKUPQ8PREPQ8QINI3Q8QX Q8QEND1VPC FDWADD`MMREADfP P'DATTIM DATEtT TIME AREA TRANSFER @P@PT h\h h\n 1@P H TT hPDATTIMPQ8PKUP"Q8PREPMEMORYP P[FDWMTH DECK-ID F36 ITOS 1.1 SUMMARY-122@Ph hV h hP hLHGhFTT"h6h5\"h2: 5\h4\h3h)\@P+h-\h,O*`TTT 6fbf b l `@PVPFDWADDFDWSUBFDWMUI PDWMUL :DWSUB 7DWADD 4Q8PKUPQ8PREPP PGMMREAD MASS MEMORY READ FUNCTION @P hhh'h hTdT`DhҀ@P2HTTh\h\h h\h؀PMMREAD5PQ8PKUP;Q8PREP8FREAD DISPAT&P PMNDWMTH DECK-ID A36 ITOS 1.1 SUMMARY-122@Ph!@  " 2a"a ! A%dada`hdb@P+dbh@!Ha"! B  2ADa a`PDWADD DWSUB $DWMUL .P  PZQUIET INDICATORS FOR ENVIRONMENT @P $$  l=T l2 l- l(ܘ l# dRl@P4h dRlh dRl@PN HTThPQUIET PPQ8PKUPVQ8PREPSTSNABL5AUTON APGMIN P PVPC VALIDATE TWO PRINTABLE CHARACTERS @P H" 2 1 `h"Ƞ 2 1 `ȸPVPC P PuWTRD WTREAD INTERFACE @PX hh hT=T  h@P+X X:XjDhBhT8Xo X /6Ȉh}Ȉ@PV{h~hhT9c wh [YlX7 @PX! 1 OhF?X& Xlh=19116h h+&@P$h h ! hT^TX X@Pȟ h H !bhΐjTxXT@PX X\h! 1 Oh^! 1 hhX@P- X8XhBh@h?h 7h ' jT89@PX|hhy TN8 !h h hT`@P9X=! uyntXy+ !ijeͤ @P_nXdhHH T:>? h@@P  PAUSE @P8@P>Xo Xl)hyX` Xw= lhtoȠ lb@Piel blhbVPCLRSCRDISPLA*ERROR DLMARGN|NCHAR OPMSG PAUSE POSITNPROMPT*TERMC CWHERE RPWTREADPGMIN P P MEMORY @PHPMEMORYP PISHIFT @PH"h"hC PISHIFTP P"ZERO ZERO WORDS @P  1 h7 n@PH TT h\hPZERO PQ8PKUPQ8PREPP P GPRTSCN C10 F CCS CCS 3.0 PSrPD SL-149@P@P JP ( 6`@P |@P ~@P @P-@P,@P6@P)@PaEX@P.0000000000000000@P`@P@P@P3DELQMST CCS20  @PBCOSIGNERCCS20  @PQSCRNFILECCS20  @P ENTER THE NUMBER OF THE SCREEN YOU WISH PRINTED OR EX TO EXIT ROUTINE @P THE SCREEN NUMBER ENTERED IS INVALID @P ENTER THE NAME OF THE SCREEN @P DO YOU WANT THE SCREEN TO BE DOUBLE SPACED? Y OR N @P ENTER THE ACCOUNT NUMBER IF DATA IS TO BE PRINTED OR ONLY IF NO DATA IS TO @P 7BE USED @P < THERE IS NO RECORD IN THE MASTER FILE FOR THE NUMBER ENTERED RE-ENTER ACCOUNT NUMBE@P gR OR <CR> ONLY OR EX TO EXIT ROUTINE @P z THERE IS NO RECORD IN THE COSIGNER FILE FOR THE NUMBER ENTERED THE SCREEN WILL BE P@P RINTED WITH THE FIELD DESIGNATORS @P T"&'(TQ++ (TQ +&\`3+ '\3 +&\xB+ @P '\B +&T&),-*\&) )8 *8a T8db  @P lTKb+̮6 ̧7  ̡ 1\Q +&\&)  *\&@P G) )8 *`d!T8! !\&) )8 *̩d \&)  )8 * @P rBd T \8  \`c++   1&T 3 +&@P T &) < )8 *8a  9̞ \.  Tc  !Kb @P  ^lT Kb+̵6 ̮7  ̨ 1\Q +&\\&) *@P T .  1/\xc++ ʜ  1T Q +&&@P T &) z *T S.  \c !K@P  9@P 9T`+\+\x+@P C@P C@P C@P : C@P CTTPPRTSCNPQ8STP FPGMIN OPENFL FILERR WTREAD ICCSAD READR CCSMVA )CCSBLK wPRNTIT CCSCST CLOSFL :PGMOUT DPPRTSCN P PRNTIT C07 F CCS CCS 3.0 SL-149@Pd* @PgP@C>AD@P/ ( ) [ ] @P< > @PW0360@P99999999990000000000000000* @P@P @P\@Pj @P.@Pt9 lTjdhT``TlTa  h hĘ@P>h\``\ط@P hȳfخ 81h\``\\d'dS d/h\`@P`\ 1\ke df l  h0 l-iH d0 $j@Pd2dd_ dc"! ,n D [fA@@P*_Tk kc 1^ *\_ c ! ! \_@PUc̷ !f $T_k2v툶hT_k2@P{jTh\h^k2^^ h\@P_k2R@PΑ d)\ l^ ] l_ l@P\\k2\ A2d^ +T_+\+]gk^g l̻ l̴@P ḽ lTh\k2\@P@P l (d1 dc d/̿l9jfܳ l (ld'dS4d`T@P-``Ta TyllKl\``\ 1\ll l@PXcl\``\ܥ 1 l̶nܛ 81}l\``\\l@P\``\ lAd_T_l\``\\ @PdY dZ d[\\n\\\o\\Y\p\\Y]\q\\Yr@P\s\d`T+``T3@P@P3H0TThHhZhnhy\h-\h\h\hh\ h h h h @Phh hxUPPRNTITPQ8PKUPQ8PREPAMONTOAYERTOADAYTOCCSBLK:FWRITEDISP CCSGETCCSCST,CCSMVAEDIT uCCSTIM~HEXDECP  PQLOAD C11 F CCS CCS 3.0 .LA - PSRD SL-149@P@Ph@Pl ,@Ps @Pz(@P|@P @Pmu0 0@P@PX@P  @P @PYDLYASSN @P#LADLYASN  @P]@P@P ENTER DATE (MMDDYY) OR CR FOR SYSTEM DATE @P READY (CR)@P$ @P'@PS00@PT@P^@PTefgT#hij TYi#i  d&Ȼ  lT #kȵ@P (T#lkeTZeTT@P(A2,2X,20HQUEUE LOADING REPORT,//)@PT\mUmndTeopom]]  T @P!\mm\mUmTUdq !TWdrT2sT 22kk@P3tu /T#vke d lDdw dx" $z@P^dy $|d{2 "  hT2}5} huT2}5@P}~~  d d6h&hT@P d6h\@PS~ 6h\@P 1 1& X % $TZN% dhT@P@P 1Tʀ @P(1H1,2X,20A2) @P\ZP% lh\@P (1\$\@P(1H ,2X,20A2,10X,20HQUEUE LOADING REPORT,35X,6HPAGE: ,I2) @P1\ZR%K )ḽh\@P>ܧ <1\\ \ \@PK(1H ,2X,20A2,13X,7HAS OF: ,A2,1H/,A2,1H/,A2,/)@PbTRT%i;@Pi(1H ,48X,29HNEXT CONTACT DATE AGE BY DAYS,/,10X,5HQUEUE,15X,2H-0,9X,1H0,9X,1H1,9X,1H2,@P9X,1H3,8X,2H+3,9X,6HTOTALS,/) @P dX\ZW%T5\6 d6h\@P 1T@P(1H ,9X,2A2,12X,6(3A2,4X),4X,3A2) @P@P@P 5 f$TcZ]e\\$\\ \ \π-@P(1H ,A2,28X,20HQUEUE LOADING REPORT,16X,6HPAGE: ,I2,/,32X,7HAS OF: ,A2,1H/,A2,1H/,A2,/@P) @P\R_e#@P#(1H ,24X,29HNEXT CONTACT DATE AGE BY DAYS)@P8\Rae>&@P>(1H ,4X,5HQUEUE,7X,2H-0,6X,1H0,6X,1H1,6X,1H2,6X,1H3,5X,2H+3,5X,6HTOTALS,/)@Pc dXTZdeT5\6 d6h\@Pz 1T@P(1H ,4X,2A2,4X,6(3A2,1X),3X,3A2,/)@P 1ndTeoo]]  l d f& 1 y d@PTx2}5}T u p@P@P lT2d{>hT"@Pd !Hqdr &$l %,ld 7 4 d@P  " l " lޚ-5 n]44 ldx#@PY2@P2̙ &̔  dTR d d6h -hT@PS `6d$lm dۀ6hT@PrS~~ ɀ6hT@P 1ܲ 1& /TgZ% d6hTm@P 1T@P(1H ,/,10X,6HTOTALS,10X,6(3A2,4X),4X,3A2) @P*\Ze lҀ6h\@P 1\@P(1H ,4X,6HTOTALS,2X,6(3A2,1X),3X,3A2,//)@P@P@PF@PT kTTPQLOAD PQ8STP Q8QINIQ8QX Q8QENDPGMIN CCSCSTpCCSMVAOPENFLFILERR@UTHEADWTREADIDATVRICALJLICCSADPCCSBLK'GETS +HEXDECPCLOSFLPGMOUTPQLOAD PSWREBILD REBUILD INDEX FILE (NYGSBC) @P@POj@POm `@POt $@PO}@PO@PO@PO@PO@P @PSYSVOL @P00FILE $$ @PO  REBUILD FILE VER 2.0 @PN  @PON  COPYING BACK @PO'N @PO>@PO) DUP KEY:  @PO: @PO@ RECORDS =  000 @PO[DELQMST @PO`LADLQMST@PO_@POd@POe$$PRINT @POTOO"O#O$hTO%O hkhhTO"OjO OkO TOlOTO[Om@POOmO_\O`OmOmOd\OeOmOmOiTOnOoOn\OpOmOpOmTOq-d `@POd!TOsȍ 'TOsO"Ot\OuT2OsOs &\OsO"OtO) dO \@PP OqO OvOq\O"OjO OwO 2dO7Ox1p4OrhT-@POyT\P\@PP4O\P\Or\OyPPP@h \Or\P\\OyPOdRdOdO@dO@PP_AdOO(p<dOdd!d8d9 dTOsOsO> ) 'TO@PPOsO"OtTOOq l l lTOOs &\OsO"Otm@PP\Oq l l l\Os &\OsO"OtTOOs̳ &\OsO"Ot dO{T@PPOY\8OWOYOW " lOXOZ 6  l TOs\OqT OsOs@PQ 'TPOsO"OtTPOqZ dOdO|TNOsO} l۬  &\@PQ.OsO"Ot#dO  2Q dO~"QO, dO, dO    @PQY  l   J @ :Od O_ @PQhTOO@PQOOnOi ̷h\O@PQOO̬ ̬h ̣h\@PQO@PQOOO~ TOOsOs 'TQOsO"OtO| BTPOs &\@PQOsO"OtTOO"OjONOO TQ OqTOs &\OsO"Ot\Oq d7 @PR l dTPOs̰ &\OsO"Ot\Os̤ &\OsO"Ot\OqOd\Os@PR1̐ &\OsO"Ot ldO&TQNOsOsO} dO| 'TQOsO"Ot@PR\dO 2S̜ TQOOs &\OsO"Ot S dO "S@PRO, dOdO=dNdNTQNNOh\@PROONO߀hT@PRNOsnnOsO'   &\OsO"Ot#TRUOsO"O dO̳h\@PROOO)OvOTQO"OjO)OO  O&OO?TO?OK\OKOuOoO@OOo l\O"OjO@Ok@PS O OpO| &TQOsTQOqTPOs̗ &\OsO"  d@PS5   dT2OsOs 'TROsO"Ot@POSP@PSP\OsTTPREBILDPHFLOT P)Q8STP SVFLOAT P.FMRDELOFMEOFCOPGMIN OPGMINTOWTREADRGTREBIOCCSCSTOCCSMVARZERO SOPENFLR FMERR SJPGETFCBPCREATEPyCNV2W PCLOSFLSDELETES!GETS R?PUTS RkCLEAR QWRITERRHXDEC RUPDFCBS?PGMOUTSTPREBILD P\GTREBI RETREIVE PARAMETERS FROM ONE INPUT LINE. @P@PbZMP@Ph@Pl@Pp @P,,,,,,,,,@P4 ,,, SYSVOL @P_ @PrTbTcd4edfg \cdhij Țh T h@P\l@l h hhTmkh hT@lhȱ h\A@lȧ@Ph\mkh ho\@lhkȗ hi\A@plȍ d \lplo dn\@Pmkl hG\@lhC hATsA@ql d  h/\@qll\@Pmkl h\@lh h\A@ql̽ d \[lql@PBHTThwhhhh\hh\\hPGTREBIDPQ8PKUPJQ8PREPGSCAN CCSMVAWTREAD{PGMOUTMIN0 P P9SCAN SCAN STRING TO SEPERATOR @P@P l & l@PT  ! lhHTTh\h\hh\h׀PSCAN (PQ8PKUP.Q8PREP+CCSGETP PMIN0 @P h "h@P H TTh\hPMIN0 PQ8PKUPQ8PREPP  PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP P-CNV2W 32 BIT TO 31 BIT INTEGER CONVERSION PSR 10/82@PhhHhll@PHTTh h\h hPCNV2W PQ8PKUP#Q8PREP P  PZERO @P h7 n@P H TT h\hPZERO PQ8PKUPQ8PREPP PFMERR FM FILE ERROR REPORTER W/WO PAUSE SL-***@P@Pl %@Pq@Ps7L@Pg@P FILE MANAGER ERROR: FILE=XXXXXXXX,XXXXXXXX REQUEST= , ISTAT =$ . @P(FFCLOSCREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFCBRENAMEPUTS WRITERREADR GE@PSTS UPDRECDELRECCOMFILVOLUSEREDUCE $ @Ph PAUSE @PwTlml\nlolT%\eh ! < ( h\(rsts@P\dstsTgur  \ghlgvr  T@PHTThh\h\h\hh\hPFMERR PQ8PKUPQ8PREPCCSMVAxCCSHXAWTREADPGMOUTP *T PVRSWCHG XXX F CCS CCS3.0 .LA LKL07 SL-XXX@P@P@P@P@P 00@P @P2@PR Y#&) 2;DwM @P@P@PLASCNFIL  @P@P,LATRNSFL  2@PE@PWRS @P)997 998 999 @PLADLQMST  @PLAACCAGE  @P/LARSWFIL  @PVSCRNFILEDELQMST @P^#@P_@P@P2@P02@P<@P@P!@P@P@P@P@PERROR - STATUS CODE NOT FOUND ON SUPERVISOR CHANGE SCREEN.@P:@P h h hT T,Ȼ %TV@P(\Z\,,\\GGTȑ "T*@PS^Ȇ  "TT*_ d_!% , d^ @P~ SRREQ XXX F CCS CCS 3.0 .LA PSR 02/83 SL-149@P@P@P@P@P % (@P@P4@P8SR @P@01@Psd@PA THE RECORD FOR COLLECTOR IS NOT IN THE UTILITY FILE THIS SR REQUEST WILL NOT B@PlE PROCESSED @PtLADLYWRK  @PLATRNSFL  @PLAUTIFIL  @P@P@P@P@P  @P @P(  @PS @Pg  @P @P  @P @P  @P @P$  @PO @Pc  @P @P  @P @P  @P @P  @PK @P_  @P @P  @P @P h h hT Tt Ttt\@P\T77 (T7\7 '\7T@PGt7 h f؏ 1\t7 '\t7T70̻ @Pr'\7 d".,d hGT@66 * $@Ph5\86 * h%T<T<77TN@P (T07_@P\>\>:6̳ \8>\\>\@PT7̵ &\t7+T h\AT4As@P)5O3T7\7\7@P6:@P:TTPSRREQ PQ8STP =AMONTOADAYTOAYERTOPGMIN CCSCSTCCSMVAOPENFL'FILERRCLEAR FGETS dREADR PUTS CCSBLKPWTREAD!CLOSFL1PGMOUT;PSRREQ PSUMACL C20 F CCS CCS 3.0 .LA - PSRD SL-149@P@P@P@P@P@P1vj6@KX_hu" 1 03@P@P@P@Pr@Pl@P@P@P @P @P! @P@P00@PDELQMST @PLADLQMST  @Pg0000000010@Pa000000000000@PTOTALS@PNUMBER OF ACCOUNTS@PDELINQUENT AMOUNT @P'CURRENT PAY OFF @P/***END OF REPORT*** @PTT ThT"^؞T^ "T@P dȧ (TTȖ#Ȑ '\ h@P>"T9 \^" l $ d\ @PihT hTllh\rrT@P9 h\9̵huT9̪hk\9̡hb\9@P̘hX\9̍hMT !ƌhB\9h8\9@Ph.\9h$\9dT|gaaT!9xT@P!@P # 7T ^"KlTB9T9\9\!9@PFx\\9\9 lTa̠ \aܬ 1\a@Pq9l\!9x\d\9\9Tl\9 T @P!9xTl\9\'9\rT59\!9x\l@PT19\9\/9\!9x\@P8@PT@P"@PTTPSUMACLPQ8STP FMRDELPGMIN CCSCSTXCCSMVAUTHEADSUMHD )OPENFLFILERRGETS $CCSBLKCCSGETmCCSADDEDIT PIDATVRFWRITEDISP TOTEDTCLOSFLPGMOUTPSUMACL PISUMHD C21 F CCS CCS 3.0 SL-149@P@P d (5z@P)9@Q *7&bK8@P@P@P_ @P @P 00 @PACCOUNT SUMMARY LIST REPORT @PPAGE@PAS OF:@PACCOUNT NUMBER BORROWERS NAME@PJDELINQUENT DELINQUENT CURRENT QUEUE @PaPROMISED TO PAY NEXT REVIEW @P$DATE AMOUNT PAYOFF DATE AMOUNT CONTACT CODE @P'p8h(dhp8h(dhp8h(dhh 0h 0ȈhȺ 0hȵ 0@PRhTtT_t\t\t\t hT@P}  \ ؊ 1\tlTtT\t@P\t\tTtl\t\\t\t@Pl\t\TVtTZ`t\t\J t! \a"t#"@P d\t\\t\$$t%&l\t\\t/lTt@P)T@P(@P/@P2HTTh\hy\h hehPSUMHD 4PQ8PKUP:Q8PREP7CCSBLKCCSMVACCSCSTyFWRITE&DISP .EDIT P PlSWITCH S12 F RPG CCS 3.0 SL-149@PT@PK9@PP@PR@P% ENTER SWITCH VALUES @PXXXXXXXX @P SWITCH = 00000000@P INVALID SWITCH ENTRY @PH@P@PTTCGIJhTGH%KHLM h⪡hʟHhިh     Ә@P @P   ȿ ȼض 1I HlA@P lI HlA lI @PHlA 묹lIv HlAi @Pl`h̔A lBlC lD@P2lE lFlG lHlT_GHS@P]MT\GHRMPSWITCHPPGMIN UWTREADVPGMOUT`PSWITCH P TIMUSE CCS3.0 TIME USAGE REPORT SL-XXX @P@P @P@P$@P @PF( @P܁@PE@P@P<@PJ& 3)@-1L5R9X=^Adj|:@Pc,!@P %6';+8@P@P/K@P@PUTIFIL SYSPRT @P EXECUTING TIMUSE @PLATRNSFLLA  @P@PLACOLSTSLA  @P@P@PTRNSFL @PCOLSTATS@P6 @P;@PdEND ALL @P}@P8@PjMNUPRO@P9@Pm000000000000AARR@P000000000000000000000001000000000000000000000000@P000000000000@P00000000000000@P@P TOTAL ACCOUNTS WORKED : - END OF REPORT - @P1---------- HDR1 GOES HERE -------------- TIME USAGE REPORT @P PAGE @P4 @P7 ---------- HDR2 GOES HERE -------------- AS OF:  @Pb @Pv @Py ---------- HDR3 GOES HERE --------------  @P @P @P  @P @P @P COLLECTOR: QUEUES:  @P( @P< @P? ACCOUNT START STOP ELAP NEXT ACT RES LTR  @Pj @P~ @P NUMBER TIME TIME TIME CONTACT CDE CDE CDE COMMENT  @P @P @P : : :  @P @P @P ********************************************************************@P0************************** @PD @PG TOTAL ACCOUNTS TIME: :  @Pr @P @P **TIMUSE** ERROR IN FILE : XXXXXXXX RUN ABORTED **********  @P @P @P!Th p8 0Ȉ 0 @P0HTTh@P:@P:hhT57T T\\@PeT5TT8\9T678T:9T@P '\ "T " d/\ " d@PT7\\ 7\!y  7 T @PdT@1̹ l̲ܜ̫ " d'"$ d@P?   d ?hT:@P6 Ӏ ?hTI@PBh ; hTTVT\@PmGp4d,ddXdYXd\G lT \G@P d dm\} ހ?h\@Ph dܑ?h\@PhTh<~ "~ T\h<\<\<@PTd<\<\<\<\<\<@P\<\<\<\<TT\@PE\\T\7\y\} \@Pp\\?\\@PM@P 2ހ?h T@@Pm ?h ?h T@P@P@P@P@Pۀ?h\@PmT7 dŀ?hT@P\̵?h\@P̪ ?hT@P  T ̒?h\@P?h\@P    \\?hT@P#  ݀?h\@P.  Ҁ?h\@P9uǀ?h\@PD xTux l \  ll\@Po̒?h\@Py?h\@P?h\@P ?hT!@PTS d d\{ \h€?h %l\@P\  Tפ 8 " d\\@PT\ l 1T " +\@P T l\̷ l 1T̝ "  l 2@P F@P H@P H@P: H@P H@P L@P L "  @P X@P, X@P X@P X d} NW@Pl c@P c\\T\T\\@P \\J@P @P @P d # l  lT5T  d (@P @P l # l  l\5\ l @P @P @P \ l \T\Th<~T TTPTIMUSEPQ8STP Q8PKUP6Q8PREP3FMRDEL;FMEOFC?MOD "PGMIN CCCSCSTCCSMVA WTREADlUTHEADvGTSYSPzPRTORFGETGRPPSYSPRT OPENFLEDIT rCCSPUTGETS ICKGRP2CCSADDGETUTI CCSGETTIMDIFJREADR UPDREC WRITER 5FILERR PCLOSFL PGMOUT PTIMUSE PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP  PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVA@P>@P>@P>2T0@P>z @NON Y @P>#@P>@P>*@P>@P>) 2@P>k@P>R @P>@P>nm000 @P>d@P> @P>@P+@PV@Pj@P @P  @P @P  @P @P  @P1 @PE  @Pp @P  @P @P  @P @P  @P- @PA  @Pl @P  @P @P  @P @P  @P) @P=  @Ph @P|  @P @P  @P @P  @P% @P9  @Pd @Px  @P @P  @P @P  @P! @P5  @P` @Pt  @P @P  @P @P  @P @P1  @P\ @Pp  @P @P  @P @P  @P @P-  @PX @Pl  @P @P  @P @P  @P @P)  @PT @Ph  @P @P  @P @P  @P  @P %  @P P @P d  @P @P  @P @P  @P @P !  @P L @P `  @P @P  @P @P  @P @P   @P H @P \  @P @P  @P @P  @P  @P   @P D @P X  @P @P  @P @P  @P  @P   @P @ @P T  @P  @P  @P @P  @P @P  @P< @PP  @P{ @P  @P @P  @P @P  @P8 @PL  @Pw @P  @P @P  @P @P  @P4 @PH  @Ps @P  @P @P  @P @P  @P0 @PD  @Po @P  @P @P  @P @P  @P, @P@  @Pk @P  @P @P  @P @P  @P( @P<  @Pg @P{  @P @P  @P @P  @P$ @P8  @Pc @Pw  @P @P  @P @P  @P @P4  @P_ @Ps  @P @P  @P @P  @P @P0  @P[ @Po  @P @P  @P @P  @P @P,  @PW @Pk  @P @P  @P @P  @P @P(  @PS @Pg  @P @P  @P @P  @P @P$  @PO @Pc  @P @P  @P @P  @P @P  @PK @P_  @P @P  @P @P  @P @P  @PG @P[  @P @P  @P @P  @P @P  @PC @PW  @P @P  @P @P  @P @P  @P? @PS  @P~ @P  @P @P  @P @P  @P; @PO  @Pz @P  @P @P  @P @P  @P7 @PK  @Pv @P  @P @P  @P @P   @P 3 @P G  @P r @P  @P @P  @P @P!  @P!/ @P!C  @P!n @P!  @P! @P!  @P! @P"  @P"+ @P"?  @P"j @P"~  @P" @P"  @P" @P"  @P#' @P#;  @P#f @P#z  @P# @P#  @P# @P#  @P$# @P$7  @P$b @P$v  @P$ @P$  @P$ @P$  @P% @P%3  @P%^ @P%r  @P% @P%  @P% @P%  @P& @P&/  @P&Z @P&n  @P& @P&  @P& @P&  @P' @P'+  @P'V @P'j  @P' @P'  @P' @P'  @P( @P('  @P(R @P(f  @P( @P(  @P( @P(  @P) @P)#  @P)N @P)b  @P) @P)  @P) @P)  @P* @P*  @P*J @P*^  @P* @P*  @P* @P*  @P+ @P+  @P+F @P+Z  @P+ @P+  @P+ @P+  @P, @P,  @P,B @P,V  @P, @P,  @P, @P,  @P, @P-  @P-> @P-R  @P-} @P-  @P- @P-  @P- @P.  @P.: @P.N  @P.y @P.  @P. @P.  @P. @P/  @P/6 @P/J  @P/u @P/  @P/ @P/  @P/ @P0  @P02 @P0F  @P0q @P0  @P0 @P0  @P0 @P1  @P1. @P1B  @P1m @P1  @P1 @P1  @P1 @P1  @P2* @P2>  @P2i @P2}  @P2 @P2  @P2 @P2  @P3& @P3:  @P3e @P3y  @P3 @P3  @P3 @P3  @P4" @P46  @P4a @P4u  @P4 @P4  @P4 @P4  @P5 @P52  @P5] @P5q  @P5 @P5  @P5 @P5  @P6 @P6.  @P6Y @P6m  @P6 @P6  @P6 @P6  @P7 @P7*  @P7U @P7i  @P7  @P9  @P: @P:  @P:I @P:]  @P: @P:  @P: @P:  @P; @P; @P;K @P;RSW 998 999 997 @P>^@P>?@P>_:@P@P;@P>d@P;a@P>e@P;S @P>[YES NO@P;#);&2D@P; @P;kw2);M@P; @P>C AS OF DATE WAS NOT GREATER THAN LAST RUN DATE @P;b PLEASE ENTER "AS OF" DATE FOR TREND ANALYSIS CALCULATION - ENTER : MMDDYY OR @P;CARRIAGE RETURN TO USE SYSTEM DATE @PpLAACCAGE  @P;fDELQMST @P>j THE DATE ENTERED IS . IS THIS THE CORRECT DATE? Y OR N @P>T;>>>T>;>>Ȱ T>>>\p>>p>\>f>;<>T@P>+p>Ȕ (Tp>>> d;S d;T d;UhT>T+C>@P?'>> d>d . '\p>>>\>\>C>>>  Od;@P?RPd; ll\CC>>\>\C> l l l l T>>>C>>;V>T>;V@P?};V>\>>;b>>;V>>> ;V>\;S>>j>>\;V>>j>>d@P?>\>>>j>>>>>>>>>[  ;\ T;V @P?!\;S>;V>>d 5 dO\C>>;]>;X;_ "?pT;] d>\;V@P?d> "?p; ; T?{;]>C>>\;V>C>> T+C>̷ @P@)T+C>> 1̪  d>̤  lT?p>>>T+>>c>"p 4>d>@P@Tp4>d> d|d}>d  d;Hd;I llT>̻ '\>> d@P@> f* f 1T>+p>̜ '\p>>>\;<>̎ '\;<> >>@P@\>> '\>>> d̤ T?"+>> d>_  (@P@T@?p>>>9d> 2 d>"$> d>>^  ;@PA hT@@PA >;K>T;K>̘̒>̋ '\;<>>>T>> d>\@PA6;>>>>  1 9; ; ) d>;h;h̗h@PAa;h ;h>h\@PAt 1 l׀;hӀ;hhˀ;h ǀ;hTA @PAܻ 1\>>;>> 1h hT>@PA>>;>>> i>a d>?$> d>;h ̠h\@PA>@PA>;h ,ˀ;h\@PA>@PA>>>h\;>@PA>>>b !T;>a>> (T@>>> l>` F$Bd> ΀@PBhTA;>@PB>>@PAB"@PA"B"@PB"h\;>@PB+>> l@P@B/@P B/ d>^@P@B2@PAB2@PB2>@P@B6@PB6T@*+> '\p>>>>_ @ l >a !>?  d  dTA@PBa+>̖ '\p>>>\;>>>\+>> 2TBp>>>@P@B@PBT@;K>> ḻ  '\;<>>>d> C d>"C@PB$>>d>; CT?C> d>;h;h;h ;hhT@PBB@PBC@PB 1̀h\@PB>>;>€h\@PB>C>̷ hTA.@PC>> d>\;>>>>  1 !'C)d>Cd^\;>C>>@PC1>eT@!+CC>> 1FTBp>>>>a$> d> , ;hTB@PCU>C>>;h\C>@PCc>>b !TA;>a> '\>>> l>` >&>_ B l@PC !q@PBC@PC d;d;d;T?;Vd>\;d>;X; Bd>d>Ŝ $>l @PC$>lٜl '>l>l*>ʜ"lp4>d>,dd>p4>d>,@PCdd> 0h 0Ȉ l 0 l@P?=C@P@EC@P@C@P@C@PCT@G+> @P@|D@P@D@P@D@PA,D@PBD@PBDD@PBXD@PBnD@PBD@PBD@PD\+>\>\>@P? D @PD TTPTRENDFPQ8STP DAMONTO? ADAYTO?AYERTO?FMRDEL?PGMIN >CCSCSTACCSMVACSOPENFL@FILERRC>CCSBLKBGETS BWTREAD?qIDATVR?PICALJLCWRITERC3UPDRECB7CLOSFLCCLEAR @oREADR B`CCSGETCPUTS ClPGMOUTDPTRENDF PJTRENDP CCS3.0 TREND ANALYSIS REPORT SL-XXX @P@P@P$@P!!"@P$x(\ @P+@P/)@P3&@P6#@P8;@P;D2 J<F|CN 8@PJ @PPr9@PV@PX@PUTIFIL SYSPRT @P EXECUTING TRENDP @PLAAGEWRK  @P@PAGEWRK @PL @PQ@PT@PZ@PV@P[@PR@PN@PWMNUPRO@PO@P000000000000000000000001@P000000000000@P00000000000000@P000000000000000000000000 029 059 089 119 149 179 996 997 998 999 000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P#00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@PN0000000000000000000000000000000000000000@Pb00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@PJ0000000000000000000000000000000000000000@P^00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@PF0000000000000000000000000000000000000000@PZ00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@PB0000000000000000000000000000000000000000@PV00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P>0000000000000000000000000000000000000000@PR00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P}0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P:0000000000000000000000000000000000000000@PN00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@Py0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 60000000000000000000000000000000000000000@P J00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P u0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 20000000000000000000000000000000000000000@P F00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P q0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P .0000000000000000000000000000000000000000@P B00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P m0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 0000000000000000000000000000000000000000@P 00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P 0000000000000000000000000000000000000000@P 00000000000000000000000000000000@P @P >FORMER STATUS CURRENT PAYOFF  @P ] TOTALS PRODUCT REPORT TOTALS - END OF REPORT - @P 1---------- HDR1 GOES HERE -------------- DELINQUENT TREND ANALYSIS @P AMOUNT PAST DUE PAGE @P @P ---------- HDR2 GOES HERE -------------- FOR GROUP QUEUE  @P RUN DAT@P E @P  ---------- HDR3 GOES HERE -------------- FROM: TO:  @P 3 @P G @P J  @P u @P @P 00 - 29 30 - 59 60 - 89 90 - 119 120 - 149 150 - 179 @P 180 + WRITE OFF RELEASED SATISI@P FIED @P  @P @P @P  @P; @PO @PR  @P} @P @P NEWLY ADDED 00 - 29 30 - 59 60 - 89 90 - 119 120 - 149 @P150 - 179 180 + PAGE TOTALS@P @P **TRENDP** ERROR IN FILE : XXXXXXXX RUN ABORTED **********  @P @P @PXhhT  dVTKMTȡ T@P\TK T TN!\O"T L MNTPOT@P    '\ "T## " d/T   $\@P% %\#% %\7% % \ >&' (   M T) @P d*T@1#̺+ l̳,̬ " d-'"$ / d.@P/?  ?hTP@PI ] ـ?h Tq@P[V0T011  ?h\@PrR0 ̯?hT}@PV0T0̣?h\@PR0̘?hT@P34d2̍?h\@P64d5   d7  .?h\@P8909 ?h\@P/909 B,h $:h B,h ,hT0@P@P B,h ,h B,h ,ֈh\0@P@P l2  l̢ ?hT@P$8909̒ ̓?h\@P2/909 .?h\@PA<909  ?h\@PS=909 B$7h4 $:0h B,h* ,'hT0@Pq@Ps B,h ,h B,h , h\0@P@P @P l ,ʀh ̣?h TY@P64@P4  2 ܲ 1 l ,h .?h\@P34@P4 27 1@PS@Pf@P}@P d Q] 1, l ~?hT@P? @Ȁ?h\@P6 A T" m9 B9Tm0\))\;4\4C@P" DC\R E\T0 F0[ \ ]G HGT  \  \  @PM\ J \   dI dK$) dL dM 2 B,d ,#h B,@Pxl ,#h B,l ,ٌhT @P0@P@P B,l ,Ȍ uh B,l ,Ѐ uh B,l ,ǀh\@P0@P@P ,h ,h B,l ,h\@P0@P@P ,#h ,#h B$Il $Kh\@P0@P@P $ ,T))\))) dN ,h T@P 0 ,#h\@P0)) 1 B,d ,hT@P,04L l\99 l\> B,l ,h\@PP))\;4\;RM;K 2^I T >' ' T? @P{  \ J $' dO\O' '\  \ \R \ J @P 2[d\PQ\PP[  0@P7@P?@PM@P@P@P@P-U@P(@P  !c* @P@P l l\ mJ'R'\kPPTn PPTy J4 \ {S JTS@P\ J ,@P @P @P VdU # l  lTU#K\G dW @P+@P+\G l \ T#\ J TTPTRENDPPQ8STP IFMRDELYFMEOFC]GETSW aPGMIN kCCSCSTCCSMVAWTREADUTHEADGTSYSPPRTORFGETGRPSYSPRTOPENFLPEDIT *CCSPUTGETS ICKGRPEICHKZBCCSADDFILERRCLOSFL>PGMOUTGPTRENDP P)GETSW CCS3.0 SUBROUTINE GETSW SL-XXX @Ph h h"p8n h 1@P H TT hPGETSW PQ8PKUP$Q8PREP!P PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP  PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVALAUTIFIL  @PM@PHOST@P@P@P,@PS@Pb@Pz@P@PDELQMST COSIGNERSCRNFILE@PLADLQMST  @PDLACOSIGN  @PkLATRANFL  @P@P@P @P(@PS@Pg@P@P@PLASCNFIL  @PLAADDACT  @P@P8@P0360@P@PY @P#@P9PP@P,0130@P.60909193@P5@P @P<1 N @P4@P;@P2@P!@P:?@P @P0Nl1E(@P@PTT>ȹ ,T>>\kk\ \@P\D\Tz'E dhT@P= 1T @PE(/,8HUSERID =,4A2,37H TYPE OK TO CONTINUE, OR EX TO EXIT,/) @PdT T (T@P\,D '\D\Sk '\k\z '\ @P\ '\\M≯ '\>Tz̨ ̠@P "T\z̒  "\(\z՜  @P"\Tz d d! d"TS8ʤǜ !T@P;3Tk24T ̖@Pf ̎̈ "\\e\Meeٜ @P "\e\̠d#TY#\T;@P\9 \\\ \@P, !- 1. 1// 2 1 2 3@P Td ,hDd ,h d d@P /\ l ,h'Dl ,h(lT$T^,  1-@P Z  T\$\T,$ ";@P \T,̾ "T  d ,hDd ,d .@P d d \ l l4l lT K   "@P   T T C\  $@P  l dd!.̡ $  +h\:@P &  +܀h\ @P 7  7 \ \<̞ "Ȕ \@P b\=T " @P w@P w@P wT  2@Pu @P TR@Pj @Pp @P 2 T.r  @@P (1H1,/,20X,28HTRANSACTION REPLAY -- REPORT,/,39X,12HNEW DATA OR,/,5X,9HACCOUNT #,7X,3@P 6HTYPE UPCD AC RC LT COMMENT) @P lI\z  dhT;@P 1\\ dh\@P 1TC@P (2X,8A2,4X,A2,6X,A2,5X,15A2,4X,15H NOT UPDATED***)@P ; lT z  W l̶h\@P 3ܰ 1\ l̺h\@P Bܴ 1 dh\@P P 21\@P W(2X,8A2,4X,A2,11X,3(2X,A2),3X,28A2,4X,15H NOT UPDATED***) @P t4 l@P z@P z@P z@P z@P z@P z@P zT \r @P (39HREPLACE SCREEN FILE AND RESTART PROGRAM)@P T@Py @P @P @P @P @P @P @PZ @P @P T &r @P (41H ...PROGRAM ABORTED. - RUN NOT COMPLETE)@P ?@P d @P @P @P \D@P v @P \@P @P @P \z T \T @P (9H COID : ,2A2,32H NOT IN UTIFIL - USING HOST ID ) @P T e@P5 @P TS\\,\\M\z \4\;\3\2\G@P (26HTOTAL ACTIVITIES UPDATED ,I4,/,26HTOTAL CHANGES UPDATED ,I4,/,26HTOTAL OTHER @P ERECORDS ,I4,/,26HTOTAL NOT UPDATED  ,I4) @P `T TPTRNPLYPQ8STP cQ8QINI Q8QX Q8QEND AMONTOADAYTO!AYERTO&PGMIN CCSCST CCSMVA WTREADeOPENFLFILERR {READR PGETCHFCLOSFL GETS *PUTACFICCSAD CCSBLK fWRITER xUPDREC xPUTS lPGMOUT aPTRNPLY PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP  PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP PUPD400 A20 A CCS CCS 3.0 SL-149@PPUPD400PFUPD4XP P2Q8QBDS C32 F CCS CCS 3.0 SL-149@P8@P8@P0000000000000000000000000000000@P8 @P8@P0 TRAN ACCOUNT  @P0 @P0 @P0 CODE NUMBER NEW DATA OLD DATA  @P0 ACTION @P0 @P0;  @P0f @P0z  @P8@P8 @P8@P0 <-- HDR1 FROM UTILITY FILE GOES HERE -->  @P0 @P0 @P0<-- HDR2 FROM UTILITY FILE GOES HERE --> DAILY MASTER FILE NON-FINANCIAL UPD@P0%ATE REPORT PAGE @P09 @P0<<-- HDR3 FROM UTILITY FILE GOES HERE --> <-DATE->  @P0g @P0{ @P0ADDACT  @P0|COSIGNER  @P0DELQMST  @P0UP4INPUT  @P0UP4PRINT  @P0UUTIFIL  @P8@P0HDR1@P8B@P8@P8@P8@P0 0000000001@P0000000000000@P0000000000000@P8@P8 @P8!@P8"@P8#@P8$@P8%@P8&@P8' @P8( @P8) @P8* @P8+@P8,@P8-@P8.#@P8/(@P80P@P81@P0000000000000@P0  @P0G @P0[  @P0 @P0  @P0 @P0  @P0 @P0  @P0C @P0W  @P0 @P0  @P0 @P0  @P0 @P0  @P0? @P0S  @P0~ @P0  @P0 @P0  @P0 @P0  @P0; @P0O  @P0z @P0  @P0 @P0  @P0 @P0@P0d@P0@P0@P0@P0@P8@P8@P8@P8@P8 P P2MFUPD4X B55 F CCS CCS 3.0 SL-149@P@P@P0@P N@Pl@P@P @P@P @P$@P(@P,@P0 @P4@P8@P< @P@@PD@PH@PL@PP@PT@PX@P\2@P`P@Pdd@Phi @Pls@Ppw @Pt@Px@P|@P@P@P@P@P @P@P @P@P@P@P@P@P6@PJ@PO @PY@P] @Pg@P@P@P@P@P@P@P@P@P@P@P<@P@PN@P@PTTT0 TTT1 1\!1\" h:0 $(5d , h0/@P" ̜ ! ! - :ȼ 'ȹ 4ȵ T#3T !33  8T;@PM@PO ,hd8 ,hd9 ,hd: ,h T  \!\ @P3z! 3 \;̗ E3T3390 0 3\33%3 @P'T3%30%\33 -3 -T0T3 00  (T30) TT? @PT3389TB 33! 0 TJ;3T0 13Y\,3 \T0 8\"\@P3 !30  \0;A\ 3T33903\339 90 0 0  T@P3&9389\ 33! 00 \;\30d 0 (T3|, 0THPFUPD4XHPUP4INIUP4LABUP4NXTUP4TOTUP4ENDCCCSGETUP4FMLCCSADDUP4PRTUP4GTMqCCSCSTCCSMVA$CCSPUTPUTS PFILERR=CHNGNFUPDRECUP4GTCP P2UP4INI C33 F CCS CCS 3.0 SL-149@P@P T1dd0dT33 ^!00 "d h h"p8@P4n (h 10 3T00  (T30" T0 3 \0 .@P3_\"3 \0 00d\30U  &\U30" \3\ &\33" ;\\d|@P ̽ 3&\|"3 \\30 ̰ &\30" \ dT3-0 ̞ ̙0 ̔@P &\33U* \ B,0vhT3-$/@P0!/0 1H1PUP4INIPAMONTOADAYTOAYERTOPGMIN EDIT OPENFLDFILERRMUP4ENDSREADR CCSMVAP P2UP4LAB C34 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT7  T3" hT3 0z00 1\@P \3" h3T lHPUP4LABPUP4NXTTAPMOTCCSMVACLOSFLP P2LUP4NXT C35 F CCS CCS 3.0 SL-149@PP@P@P1h T30 0 1'0 T30+ T dT1@P.T0Th  l @P0< THPUP4NXTHPSTATIT2GETS FILERRUP4END"FREAD (DISP 0CCSE2AAP P2fUP4TOT C36 F CCS CCS 3.0 SL-149@P * TOTALS *  @P+ @P? @PD ACCOUNTS NUMBER  @Po @P @P UPDATED  @P @P @P REJECTED  @P @P @P0 5 Bl dT31&%3!%\3&%!0% h h D(߀hT@P7  D(hT@PF 1 1 h D(hT@PZص 1HPUP4TOTbPCCSMVACCSGET5CCSPUTBUP4PRTXP  P2GUP4END C37 F CCS CCS 3.0 SL-149@P? T0 0o 0\d 0 0\ 0 0\ 0Ȩ 8\ @P+  3\  3T#THPUP4ENDCPCLOSFLTAPMOT;PGMOUT?P P2@UP4GTM C38 F CCS CCS 3.0 SL-149@PT33#- 0-T30 00  0  (T33* T @P+   d lHPUP4GTM<PCCSMVAREADR FILERRUP4END$P P2@UP4GTC C39 F CCS CCS 3.0 SL-149@PT33#- 0-Td30 00  0  (T33|* T @P+   d lHPUP4GTC<PCCSMVAREADR FILERRUP4END$P P2UP4PRT C40 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T !33   d8@P05d09 hT8 T8ؿ 10 T113T;\1@P3`\\<131\T30" 0 (T3) 0T0 &̞ l \@P310\3\10\3\!0 &3\) 0\̥ \1318\\@P0  ̺ &\30) \T1H TThhh4PUP4PRTPQ8PKUPQ8PREPCCSADD*CCSGETAYERTOBCCSCSTECCSMVAP PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP P*UPD500 QSS000 CCS 3.0 UPD500 SL-149@P@P,@P  UPD500 REQUIRES A QSS FROM CONTROL DATA.@PTTTPUPD500PQ8STP )WTREADPGMOUT'PUPD500 PUPDATE A21 A CCS CCS 3.0 SL-149@PPUPDATEPFUPDATP PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP P [ADDIT B05 F CCS CCS 3.0 SL-149@PA@PT33 A M] >0 MT3 ]T33E] > (3Th H3 1T3\ A M30 > M\3; A@P0,  A\33 > C3 C\33 = = 03 C\ >33 C C3T 4 ?33 > >3\  30 > >\3;  >@P0W >T A\33 > M >0 XT30̫ ̦ &\33 I 1\̝ 13T38̓@P0 ̍ 3&\ J3 1\T0 VT3 (3T L3 1T3T >3; P > P@PHMPADDIT PCCSMVACCSPUT PUTS FILERRUPDENDCCSADDDFORMLNZWRITERdREADR |CCSBLKUPDRECP PCHNGNF B24 F CCS CCS 3.0 SL-149@P@P1@P4@P@P0@PN@Pl1@PE@P(,@P!@P$@P'@P*@P-@P0 @P5 , h h hTȷ \Ȫ t\@P`Ȟ  l@Pn hh hȻ!" ( hʓ !ȏ谚 Ȩf dؚ@P 5h !0 2. d3 h hT@P@P  h\4@P4 \5H2TThbhmhhhh\hZheh\hVhjh\h@PQheh\hIhJhRh\hhhh\ha'PCHNGNFPQ8PKUPQ8PREPAMONTO:ADAYTO>AYERTOBCCSCSTECCSMVAP P [ CONUPD 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  C =3 = 2 2 70 ژ(0T h\hȞ #Ț dhȗhT 0 >h\@Pr hȍ(Έh 1 *T >33 Q > Qx hȴ!& ( h @P !ȥhȡh ȝhT@P@P =ؐ3\ R33 R 2̒ A 4TH33 C =3 = 2 2 &\33 C3 C\@P3 > M]3 > MT0 ]T3E] >00 (Th30 H 1TT33 R 0 RH>PCONUPDPCCSCSTICCSAD[ICALJLlCCSMVACHNGNFCCSPUTPUTS FILERRUPDENDP P [COSUPD B33 F CCS CCS 3.0 SL-149@P@P@P@P@PY@PT3 R =3 = 2 2 \13 R30 = = 2 \3 R =3 = 2 YT3; > M@P00 > N\11 ?T33g  (T630 I 1T 10/ *T@P3[g0  3&\6 J3 1\\11 ?T30g &\630 L 1\@PH|PCOSUPDPCCSCSTCCSMVA+WRITER:FILERRIUPDENDOREADR ZUPDRECuP P [ FORMLN B53 F CCS CCS 3.0 SL-149@PWRITEOFF @PRELEASE @P$SATISFY @P6ADD @PHUPDATE @PZREACTIVATE @PlREJECT - ACCOUNT NOT ACTIVE FOR 30X @P~REJECT - NO ACCOUNT FOR 30X CODE @PREJECT - INVALID TRANSACTION CODE @P ,,hT@P3 > S 3 ? S\33 > @ A03 @\ A33 M F M 1? #  )\33 R Q8 R @P3\ 33 R Q R % !3T 30 > >\33  ?03 @\ 30 ? @ 3\ 3 > >\@P3 ?0 @ HTThŀPFORMLNPQ8PKUPQ8PREPCCSMVAEDIT P P [FUPDAT B56 F CCS CCS 3.0 SL-149@PTTT0 TTTT33 > @ - >3 @ 2 2 \33 > @ +30 > @ 2  \@P3+ > @ )30 > @ 2 'T0 T300 13T L3 1\ lT 43; ? > @PV >T0 o\33 > @ / >3 @ 2̶  T F3\ 4 ? 30 > >\0 W TTTTT@P33̻ 3'\ I3 1T \ 70 3 T\\\3\̝ &\3; L 1@P\\ T\\\T3= '3TG L3 1\\0 9H/PFUPDATPUPINITLABHANNXTRANTOTALP UPDENDGETMASCCSCSTRSWIT 6UPDRECFILERRCCSADDPPRTLINXFORMLNgUNCUPDyPCONUPD{ADDIT }COSUPDWRITERUPDIT REACITP P [GETMAS B58 F CCS 3.0 09-22-81 SL-149@P@P,@P.@P UPDATE WAITING ACCT. NO. @P'.L@P)@P/T33 A M > >0 MT30 >00 0  (T33 J 1T 5@P0Z /ެ  d0-T31 A M) M+Ⱥ \31 A M) M\* R'0 RT 1@P,(,- lT.HPGETMASPCCSMVA0READR 8FILERRMUPDENDSCCSCSThWTREADCCSBLKP P [LABHAN B67 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT   T3 @ hT3 > Wz0 W 1\@P \3 @ h3T lHPLABHANPNXTRANTAPMOTCCSMVACLOSFLP P [LNXTRAN B85 F CCS CCS 3.0 SL-149@P@P@P1h T300 1'0 T30 K 1T dT 1 @P. T0T h  l @P0< T =HPNXTRANHPSTATIT2GETS FILERRUPDEND"FREAD (DISP 0CCSE2AAP P [PRTLIN C09 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T 4 ?33 > > d [@P05 d0 \ hT [ T 9 [ؿ 10 T1 Z3 T;\  Z@P3` \\ _13 Z \T30 @0 (T3 H0 1T0 &̞ l \@P3 Z0 \3\ Z0 \3\ ?0 &3\ H0 1\̥ \13 Z 8\\@P0 >̺ &\30 H 1\T Z H TThhh4PPRTLINPQ8PKUPQ8PREPCCSADD*CCSGET33 C C3\ = =10 L\3; = =@P00 GT CT33 4 ? >3 >\33  > 03 >\ 33 > >3\ > M30 > XT308@P[  (T3 I0 1T 1/T30  3&\ J3 1\T8 VT@P30 &3\ L0 1\T33 > P 3 > P " 9 0X :l3T 3 ;\3; > M= >@P M\ 33 > A= N0 ATGGdIHdJ0dK\33  > IL3 > I\ "33 > UR >0 YT%38= >@P (3Tb H3 1Th 3\= >0 &3\ H0 1\HPREACITPCCSPUT CCSMVAFORMLN3CCSADD6WRITERSFILERRUPDENDREADR nCCSBLKUPDRECPUTACFCCSTIMPUTS P P [kRSWIT C16 F CCS CCS 3.0 SL-149@P@PWRS@P999 @P998 @P997 @P @P @P - ACCOUNT NOT IN ACCAGE @P0  d0T E0  3  l\ D0HhlT3; C@P0E  C 0(π h  (ʀ hT 4 ?@PV >@PX > ( Vh 0( Vh\ @Pg >@Pi > ( hh 0( hh\ @Px >@Pz > ( Dh 0( Dh\ @P >@P >\33 F 0 F\\33 M3 > M\31  > 03 ?\ 3 C C3Tw3 > (T@P3 H0 1TT3@ M30 > > MT3 >0  1ݤ0  \3; J 1@P\\ 33 > O >0 OyT3 &\33 M 10\d00 \33  A 0; A\ @P3 @ 03 @\ 33 F  F3\  F30  F\33  A3  A $h\@P3- > @3  @T33  F3  F\33  F 03 F\ 33 A  AހhT@P0O T3 >00 (T30 H 1T@P%c@P2c@PcHPRSWIT fPFORMLN"CCSMVA3CCSADDRPUTS RFILERR\UPDENDbREADR DELRECCCSPUTMP P [TOTALP 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 D C3 > C\ 3 D C >03 C\ D13 Cb > C3\ D C0 > C\39 D C@P0 > C\31 D C.3 > C\ 3 D Cr >0 C h h D(hT@Pȵ  D(hT 9@Pا 1ء 1T1 A3 ? @\ 13 A" ? @1\ Af3 ? @\ 13 A ? @1\ A)3 ? @\ @P, Am ?03 @\ P A0 ? @\3 V A ?03 @\ J A09 ? @\3 Au >03 @\ t A0 > @\3 z A >0; @\ n A@P3WA > @1\ A|3 > @\ b13 A > @1\ h A3 > @\ \13 AH > @ d D,hT@P} 1H"PTOTALPPCCSMVACCSGETCCSPUTEDIT  PRTLIN{P P [UNCUPD C31 F CCS CCS 3.0 SL-149@P @P@P@P!@Pkk@@PE@P@Pkk@P qq@P#ww @P& @P) @P,@P/ @P2 @P5@P8@P;@P>@PA@PD@PG@PJ@PM(@PP@PS@PV@PY@P\@P_@PbT 33 > C 0 C h!( ( hʝ ʘ !hހhڀ hր@P h\@P@P0 1\ > >T0\ >1 >\1HPUNCUPDPCCSMVAcCCSPYTP  P [Q8QBDS C46 F CCS CCS 3.0 SL-149@P8 :01@P0 ;0360@P8@P8 3 @P0 000000000000@P0 000000000000@P8 @P0 - ACCOUNT ALREADY IN ACCAGE @P0  CO HOST @P8 9 @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 40000000001@P0 000000000000@P0 000000000000@P0 000000000000@P0 000000000000000000000000000000000000@P0 000000000000@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 Q@P8 R@P8 S#@P8 T(@P8 U7@P8 VB@P8 WP@P8 XR@P8 Y`@P8 Z@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 [sUPDEND 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 ATHPUPDENDoPCLOSFLTAPMOTgPGMOUTkP P [.UPDIT C48 F CCS CCS 3.0 SL-149@PT33  > 03 >\ 33 > >3\  30 > >\33  >3 >\ 433 ? > 0 >T B@P+HPUPDIT *PCCSADDFORMLN%P P [UPINIT C49 F CCS CCS 3.0 SL-149@P@P T 1d0 d 0d T3 > ~3 ? >T33 > C 3 > C 8"d @P4h h "p8n (h 1 T3 (T33 @ 1 T @P_  \30 .\30 @ 1\  d 3\X &\33X @ 13\\ 0 &@P3\ @3 1\\30g6̽ &\630 @ 1\3\Eh̰ &\33h @ 13\\w0̣ &;\ @@P 1\\30̖ &\30 @ 1\3TM00 (TV30 @ 1T0\ "0 9 #;\%@P &3\ @0 1\\3 .٤  \30 @ 1\0 d dT330 F8¤ @P ̽0 ̸ &\X30 J 1\ B, hT'0; B T@P0% ? T0 G 1\300 H̖ 0  (T3X J0 1T03 H h/T2@P0P$ G)d T3 > M\30 >   &\30 J 1\  8 d@P|HPUPINIT~PAMONTOADAYTOAYERTOPGMIN EDIT CCSMVA OPENFLFILERR@UPDENDFREADR ICCSADNCCSBLKVP PUSEMTN C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL-149@P}@Pe@Ph@Pl @Pp0@PsYE *END  @P|@P@P3@P5 RESPOND WITH "YES" IF ANY DELETES,ELSE (CR) @PLAACTIVE  @PM ENTER COLLECTOR ID TO DELETE OR "END" @P}T/bcdTe/fg ThifTj (Thjb@PhTZbTkT@P(A2)@P\RbT3jȪȢ '\njb\Zb hȖh\@Pؐ 1\Tbp5qp/er/sktld0\bpMup/vrx@P wTd3d4T/jjym 1 1$Tzjb@P4TZ(bT3\4TT3vv{{ Tj 1\|jb@P_TjT@Pf(1H1,5X,15HUSERS OF COLECT,/,3X,2HID,3X,4HPORT,3X,4HTIME/)@P@P(20X,15HUSERS OF COLECT,/,10X,2HID,5X,4HPORT,5X,4HTIME) @P@P(2X,2A2,3X,I4,4X,A2,1H:,A2) @P@P(9X,2A2,5X,I4,6X,A2,1H:,A2) @P@P(5X,5HUSER ,A2,A2,10H NOT FOUND)@PTPUSEMTNPQ8STP Q8QINI5Q8QX ;Q8QEND@PGMIN ~CCSCSTCCCSMVAOPENFLFILERR.GETS WTREADREADR DELRECQCLOSFL`PPGMOUTdPUSEMTN P7UTFMTN F51 F CCS CCS 3.1 LKL07 02-84 SL-149@P@P+*LJ &@P604PN$OUT @P>@P@PUTIFIL  @PY @PZ UTILITY FILE MODIFICATION PROGRAM IN @Po ENTER "UPD" TO ADD/UPDATE, "DEL" TO DELETE, OR CARRIAGE RETURN TO EXIT @P INVALID REQUEST @P ENTER KEY OF RECORD TO XXXXXXXXXX @P RECORD -XXXX- NOT FOR ADDITION, DELETION, OR UPDATE THRU THIS PROGRAM @P RECORD -XXXX- IS REQUIRED, CANNOT BE DELETED @P RECORD -XXXX- DOES NOT EXIST, CANNOT BE DELETED @P RECORD -XXXX- ADDED SUCCESSFULLY @P RECORD -XXXX- DELETED SUCCESSFULLY @P- RECORD -XXXX- UPDATED SUCCESSFULLY @Pg @PUPD DEL @PADD/UPDATEDELETE @P**@P @PCOID@PHDR1@PHDR2@PHDR3@PRSW1@PACTC@PRESC@PSALC@PDALT@PSMTH@PTMTH@PUPDY@POLPM@PLTRF@PRPTG@PLTR1@PLTR2@PLTR3@PLTR4@PHOST@PTRND@P** @P @P @P @PqNAME ISPHONE EXT CSUP QUEUES... @P---------------------------------------- @PR---,S---,W--- @PCODE1 CODE2 CODE3 CODE4 CODE5 CODE6 CODE7 CODE8 CODE9 @P ---,QUE =---,QUE =---,QUE =---,QUE =---,QUE =---,QUE =--- @P/--- @PURL--,P--,C--,NA- @P{N------------------------- @P @P @P @P @P9 @P_ @P @P @P @P @P @PC @Pi @P @P @P @P @P>T()T* "T+Y,\+Z-T@.\+o@Pi/+@. f  d , hA @   1\@P+1 , hT)232\@.\+4+@.̺ \@0U0@P d5 V U  l d1 l4 1d@PdTO+/i  dd\+6N̿d@PW̷dXT+W**  " ;  ̗d̏d@P@\+7T+* "UdVd \+4 d@Pk̳ ̮  lTb-.d+d, L5& d'Tq'.g8.T+@Pg9 dS\+-:+@. f a d(!T@() [@P)8 5T)(-̝ T+** !;Ud2Vd3\+-4@PsT+U* !d d\+;X@PM @P l l l l lT)*@Px@P99NO@PA000000000000@PM000000000000000000000000@P000000@PYWRS @P\000000000000@PG0000000010@PoYES @P'@Pq0000@P'LADLQMST  @P[@P,@P'LAWOEF  @P,DELQMST @P+w ANSWER (1 OR 2) @P+ ENTER AS-OF-DATE (MMDDYY) @P+ ENTER NUMBER OF DAYS DELINQUENT (NNN) @P+ ENTER WRITE-OFFS SINCE DATE (MMDDYY)@P+ ANSWER (1,2,OR 3) @P+ ARE SUBTOTALS DESIRED (YES/NO)@P+ RECORD COUNT--R RECORDS 000000000000@P+ RECORD COUNT--S RECORDS 000000000000@P+ RECORD COUNT--W RECORDS 000000000000@P, RECORD COUNT--OTHER RECORDS 000000000000 @P,, CHOOSE ONE OF THE FOLLOWING REPORTS:@P,? 1) ELIGIBLE FOR WRITE-OFF REPORT@P,S 2) ACTUAL WRITE-OFF REPORT @P,d CHOOSE ONE OF THE FOLLOWING WAYS TO PRINT THE WRITE-OFF REPORT: @P, 1) PRINT THE REPORT BY ACCOUNT TYPE, QUEUE ASSIGNED @P, 2) PRINT THE REPORT BY QUEUE ASSIGNED, ACCOUNT TYPE @P, 3) PRINT THE REPORT BY STRAIGHT LIST @P3$2Ykw@Pd"ra@FgO@P( @P-T,,,T',,,ȼ T',,',\,,',dd@P-@dddThhT,,,,,,,\,,,?,, ,\,@P-k,,S,,, d\,,+w,,,, Hd 2! !db\@P-,  \,,+,,,, \,,+,,,,,  T-(, @P-,T  ! J\,T-W,,+,,,, ̜d, ! !@P- d,!T-,q,, !\,>, !T,\@P.,,,d,,,\,,,,,,\,,,,,,\,,,,,,T-,@P.B\,,+,,,,,  H d ! ! 6\@P.m,T-,,+,,,, T-,o,,, \,?,,  d@P.[ l ̺  1dc ̱  2l̬  3l ̤  4l ̜  5lT@P.s',, (T',,,\'', '\',,, db /Ts@P.,,Ф,  *\',,, dd@ d,!s $,d@P/, $-d, X d,-hPT.}/~Y,,, C 1ր@P/DhT@P/I- T,T.-,  d !T'-T.; ,'-,\-@P/t,'-,/dLБ@P//lЌ܊ \T.s,,,,  *T.'-,,@P/ ld@ d,!` $,d, $-d, J-hT/0/~@P/Y,, 3 dۀ hT/G@P/- T/O,, T/f'-T/j ,'-,\q,'-,0dL0l@P0ܝ 0n@P-70 @P0 d,2d- 'hch 'h\- @P09'@P0< 1c 6  ,- d/~\/~-'- -- l\/~-'--@P0gl\/~-'- -l\/~-'--T/b,'-\c,'-,$ , d-@P0( h\'-@P0- !T'( ,,, (T/'- ,, l, Eϑ@P-;0@P0 d,̐-lT//~Y,,,  1TGAA \G\\@P0 \GMM \GSSO@P.0@P/0@P/0@P0 l,  d,\M,q,̼ T0|M, 1 l\S,q@P1(,̢ \S, 1 lT0\,q,, \\,ܷ 1@P1S l\A,q, \A,ܞ 21U\M,+-,\S,+-,\\@P1~,+-,\A,,-,T.o,,+,,,\,,+,,,\,,+,,,\,,,@P1-,,@P/1@P/1@P1Ts,\',@P.1@P.1@P1TTPWRTOFEPQ8STP 1FMRDEL-SAMONTO-?ADAYTO-DAYERTO-IPGMIN -CCSCST1;CCSMVA1ICALJL-NWTREAD1IDATVR-INTGR /TOPENFL.FILERR0PGETS /DAYS /CCSGET/CCSBLK/PUTS 0CCSADD0CLOSFL1PGMOUT1PWRTOFE P3INTGR B65 F CCS CCS 3.0 SL-149@P hlh !ThT(l @P"H TTh\h\hPINTGR %PQ8QI2FQ8PKUP+Q8PREP(CCSGETP PDAYS CALCULATE DAYS DIFFERENCE FOR TWO DATES (RWE) @P@P@P hTT !jTh\h\hT \\@PH !K\h\h\h\Tp8h(dhhȢ 4 @Psؕ hșhȐ;Ƞ ȝ  ؘ@Pdd \˸ T HTThz\hx\h\h\@Ph\hgPDAYS PHFLOT ^Q8PKUPQ8PREPCCSMVA IDATVR(ICCSAD/YMD1 9HXDEC P PYMD1 @P@P @P @P@PW@P hVBœS  hO(hp8hڌI lH D#DlB> h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hnPYMD1 PHFLOT 5Q8PKUPQ8PREPFLOAT @P PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP P WRTOFP CCS3.0 ELIGIBLE/ACTUAL WRITEOFF RPT SL-XXX @P@P@P$@P%&@PF( @P@P:9@P= Ncv@PXD 86q|Og"@^[ap@P @P@P@PUTIFIL SYSPRT @P EXECUTING WRTOFP @PLAWOEF  @P@PWOEF @P @PEND ALL @P@P @P@P@PMNUPRO@P@P:000000000000000000000001000000000000000000000000@PY000000000000@PR00000000000000@P_00000000000000000000000000000000000000000000000000000000000000000000000000000000000000@P0000000000000000000000000000000000@P@P ACTUAL WRITE-OFF REPORT  @PFROM: TO: QUEUE - END OF REPORT - @P1---------- HDR1 GOES HERE -------------- ELIGIBLE FOR WRITE-OFF @P; PAGE @PO @PR ---------- HDR2 GOES HERE -------------- AS OF:  @P} @P @P ---------- HDR3 GOES HERE -------------- RUN DATE:  @P @P @P  @P @P @P TYPE DELQ  PAST DU@PCE DAYS STATUS CURRENT CURRENT DATE@PW LAST @PZ QUEUE CODE ACCOUNT NAME DATE  AMOUNT@P DELQ CODE PAYOFF BALANCE UPD@P A/R @P  @P @P @P  @P @P @P  @PK @P_ @Pb  @P @P @P NO. ACCOUNTS PAST DUE A@PMT CURR PAYOFF AMT CURR BALAN@PCE @P ********************************************************************@P************************** @P% @P( ***** TOTALS *****  @PS @Pg @Pj **WRTOFP** ERROR IN FILE : XXXXXXXX RUN ABORTED **********  @P @P @PhhTTȯ T\T@PTT\TTT '\@P> "T " d/T\\R@Pi\   T dT@1Ť l̾@P̷ " d'"$ d?  ?h@PT@P  ـ?h T@P ǀ?h\@P TLL\_qq\eww\k} }T@P RTWR0\0(\(\(\Z( \_@P =(\e(\k(\:\:_\:e\:k@P h 1T3\\\(?h\@P     2 TLFF\q\w@P \}T LRT R0\0(\(\@P (\Z(\q(\w(\}(\:L\:q\@P :w\:} T o\\\( d@P 6 ?hT @P C  @P M@P M d?h\@P Xހ?h\@P c fπ ?hT @P sRĀ?hT@P ~ &\\RR\̢?h\@P \̑?h\@P   T A\ZZ\ZT @Y Y\Y@P R\R0\0T \R\@P @P  2 M\  \\Z\@P @P @P  2 M\@?h\@P 0__?h\@P ;ee?h\@P Fkk dۀ?hT @P Uπ?h\@P `Ā?h\@P k̹?h\@P v̮ ?hT q@P ̣?h\@P ̙?h\@P ̎?h\@P ?h\@P ?h\@P ?h\@P T @P @P @P @P @P @P  " k @P @P : @P d   dbT S((\FR\R0\0(T@P  (\(\(\\\\(\@P 3\\,@PR @@P @@P @d # l  lT\j d @PG a@P a\j l T jT\TTPWRTOFPPQ8STP FMRDELFMEOFCPGMIN CCSCSTCCSMVA WTREADUTHEADGTSYSP PRTORF'GETGRP.SYSPRT oOPENFLIEDIT PCCSPUT{GETS ICKGRPCCSADD CCSGET |FILERR QCLOSFL uPGMOUT ~PWRTOFP PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVA@PP@PP@PP fFf d!,d`m5n@P`x@PxT\T T<~\s @P7@P@P@P @P4@Pod # l  lTYT3Yt0t d @P,@P~@P@P@P\t0t l@P@P@P@P6@P TI0"TlT'!s\"TTPCOLSTSPQ8STP GETSW PGMIN CCSCSTCCSMVAWTREADUTHEADGTSYSPPRTORFGETGRPSYSPRTOPENFLEDIT CCSPUTaPGETUTIGETS UPDREC,HXDEC yCCSADDFILERRCLOSFLPGMOUTPCOLSTS P)GETSW CCS3.0 SUBROUTINE GETSW SL-XXX @Ph h h"p8n h 1@P H TT hPGETSW PQ8PKUP$Q8PREP!P PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVAh hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP __h"  T h h\  1hՀ@P-HTTh\h\h\hPICKGRP1PQ8PKUP7Q8PREP4CCSGETP (  MWSSRREQ CCS149 P032883($$TWB.JOB,WEAVE,,SRREQ,CCS149 00010$$TWFTNHOL,RWE,,SRREQ,CCS149 00020$$TWFBEND,WEAVE 00030_ __P __h"  T h h\  1hՀ@P-HTTh\h\h\hPICKGRP1PQ8PKUP7Q8PREP4CCSGETP (ox o~/TFEDTA CCS149 P( SUBROUTINE EDTA(INBUF,ISTART,OBUF,OSTART,ELEN) B5000010 1 /B50 F CCS CCS 3.1 7/15/82 SL-173B5000020C B5000030C CYBERCREDIT SYSTEM VERSION 3 B5000040C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5000050C COPYRIGHT CONTROL DATA CORPORATION, 1979 B5000060C B5000070C B5000080C EDIT FIELDS FOR DISPLAY. B5000090C B5000100C ROUTINE TO EDIT VARIABLE LENGTH AMOUNT FIELDS FOR DISPLAY OR 000110C PRINTING. THIS HANDLES SIGNED AND UNSIGNED FIELDS. 000120C B5000130C CALLING SEQUENCE: B5000140C CALL EDIT(INBUF,ISTART,OBUF,OSTART,ELEN) B5000150C WHERE THE PARAMETERS HAVE THE FOLLOWING DEFINITIONS: B5000160C INBUF = INPUT BUFFER SOURCE FOR THE CHARACTERS TO EDIT. B5000170C ISTART = STARTING CHARACTER OF THE FIELD TO EDIT. B5000180C OBUF = OUTPUT BUFFER TO RECEIVE THE EDITED FIELD. B5000190C OSTART = STARTING POSITION IN OUTPUT BUFFER OF THE EDITED FIELD. B5000200C ELEN = THE MAXIMUM LENGTH OF THE AMOUNT TO BE EDITED. B5000210C THE MAXIMUM LENGTH HANDLED IS 12 DIGITS(EXCLUDING SIGN). B5000220C B5000230C B50002401 B5000250 INTEGER INBUF,ISTART,OBUF,OSTART,ELEN,NINE B5000260 INTEGER BLANK,MINUS,ZERO,ZSUPLN,BASE,EDIFIL( 7) B50002701 B5000280 DATA NINE/$39/,BLANK/$20/,MINUS/$2D/,ZERO/$30/ B5000290 DATA EDIFIL/'9999999999.99 '/ B50003002 B5000310C CHECK FOR ILLEGAL LENGTH, OUT OF RANGE. B5000320 IF(ELEN .LT.1.OR.ELEN.GT.12) GO TO 500 B5000330C SET STARTING POSITION IN EDIT FILE FOR EDIT AND THE LENGTH OF EDITB5000340C B5000350 BASE = 13 - ELEN B50003601 B5000370C PEFORM THE EDITING. B5000380C ZERO INDEX INTO INPUT BUFFER. B5000390 J = 0 B5000400 DO 200 I=0,ELEN B5000410C RETRIEVE CHARACTER FROM EDIT FILE. B5000420 CALL CCSGET(EDIFIL,BASE+I,M) B5000430C IF CHARACTER IS NOT A NINE, STORE THE CHARACTER INTO THE OUTPUT BUB5000440 IF(M.EQ.NINE) GO TO 100 B5000450 CALL CCSPUT(M,OSTART+I,OBUF) B5000460 GO TO 200 B5000470C CHARACTER FROM EDIT FILE NOT AN EDIT CHARACTER. MOVE NEXT CHARACTEB5000480C FROM INPUT BUFFER TO OUTPUT BUFFER. B5000490 100 CALL CCSGET(INBUF,ISTART+J,M) B5000500 CALL CCSPUT(M,OSTART+I,OBUF) B5000510 J = J + 1 B5000520 200 CONTINUE B50005302 B5000540C EDIT COMPLETE. SUPPRESS LEADING ZEROS AND CHECK FOR NEGATIVE SIGN. 00550C 000560 ZSUPLN = ELEN - 4 00570 DO 300 I=0,ZSUPLN B5000580 CALL CCSGET(OBUF,OSTART+I,M) B5000590 IF(M.NE.ZERO) GO TO 400 B5000600 CALL CCSPUT(BLANK,OSTART+I,OBUF) B5000610 300 CONTINUE B50006201 B5000630C ****************************************************** 173*A010B5000640C ..CHECK LAST DIGIT FOR OVERPUNCH & CONVERT AS REQUIRED B5000650 400 J = OSTART + ELEN B500660 CALL CCSGET (OBUF, J, M) B5000670C ..IF NO OVERPUNCH(ASCII), SET SIGN=BLANK(POS.) & EXIT B5000680 IF (M .LE. NINE) GO TO 420 B5000690C ..IF OVERPUNCH = POSITIVE DIGIT($41-$49), CONVERT & SET SIGN B5000700C .. = BLANK B5000710 IF (M .GT. $49) GO TO 410 B5000720 M = M - $10 B5000730 CALL CCSPUT (M, J, OBUF) B5000740 GO TO 420 B5000750C ..IF OVERPUNCH=POSITIVE ZERO, CONVERT TO ASCII ZERO & SET B5000760C .. SIGN=BLANK B5000770 410 IF (M .NE. $7B) GO TO 430 B5000780 CALL CCSPUT (ZERO, J, OBUF) B5000790C ..SET SIGN = BLANK B5000800 420 J = J + 1 B5000810 CALL CCSPUT (BLANK, J, OBUF) B5000820 GO TO 500 B5000830C ..IF OVERPUNCH=NEG. ZERO, CONVERT & SET SIGN MINUS B5000840 430 IF (M .NE. $7D) GO TO 440 B5000850 CALL CCSPUT (ZERO, J, OBUF) B5000860 GO TO 450 B5000870C ..ASSUME OVERPUNCH = NEG. DIGIT($4A-$52), CONVERT & SET B5000880C .. SIGN MINUS B5000890 440 M = M - $19 B5000900 CALL CCSPUT (M, J, OBUF) B5000910C ****************************************************** 173*A010B5000920C ****************************************************** 173*A009B5000930 450 J = J + 1 B5000940 CALL CCSPUT (MINUS, J, OBUF) B5000950C ****************************************************** 173*A009B50009602 B5000970C EDITING COMPLETE. RETURN. B5000980 500 RETURN. B5000990 END B5001000_ __ GO TO 450 B5000870C ..ASSUME OVERPUNCH = NEG. DIGIT($4A-$52), CONVERT & SET B5000880C .. SIGN MINUS B5000890 440 M = M - $19 B5000900 CALL CCSPUT (M, J, OBUF) B5000910C ****************************************************** 173*A010B5000920C ****************************************************** 173*A009B5000930 450 J = J + 1 B5000940 CALL CCSPUT (MINUS, J, OBUF) B5000950C ****************************************************** 173*A009B50009602 B5000970C EDITING COMPLETE. RETURN. B5000980 500 RETURN. B5000990 END B5001000<VKp <vs6B.SRREQ CCS149 x032883< P>SRREQ XXX F CCS CCS 3.0 .LA PSR 02/83 SL-149@P@P@P@P@P % (@P@P4@P8SR @P@01@Psd@PA THE RECORD FOR COLLECTOR IS NOT IN THE UTILITY FILE THIS SR REQUEST WILL NOT B@PlE PROCESSED @PtLADLYWRK  @PLATRNSFL  @PLAUTIFIL  @P@P@P@P@P  @P @P(  @PS @Pg  @P @P  @P @P  @P @P$  @PO @Pc  @P @P  @P @P  @P @P  @PK @P_  @P @P  @P @P h h hT Tt Ttt\@P\T77 (T7\7 '\7T@PGt7 h f؏ 1\t7 '\t7T70̻ @Pr'\7 d".,d hGT@66 * $@Ph5\86 * h%T<T<77TN@P (T07_@P\>\>:6̳ \8>\\>\@PT7̵ &\t7+T h\AT4As@P)5O3T7\7\7@P6:@P:TTPSRREQ PQ8STP =AMONTOADAYTOAYERTOPGMIN CCSCSTCCSMVAOPENFL'FILERRCLEAR FGETS dREADR PUTS CCSBLKPWTREAD!CLOSFL1PGMOUT;PSRREQ __ h h hT Tt Ttt\@P\T77 (T7\7 '\7T@PGt7 h f؏ 1\t7 '\t7T70̻ @Pr'\7 d".,d hGT@66 * $( V ]J.SRREQ CCS149 P(*JOB,,TWB.JOB SRREQ INSTALL 08/23/84 00010*K,L14 00020*CTO, SRREQ WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.SRREQ , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.SRREQ,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120SRREQ DCK/ I=13,H 00130SRREQ HOL/ 00140 PROGRAM SRREQ 00150 1 /XXX F CCS CCS 3.0 .LA PSR 02/83 SL-149 001601 00170C COPYRIGHT CONTROL DATA CORPORATION 00180C CYBERCREDIT SYSTEM 00190C 002001 00210C THIS PROGRAM HANDLES THE SUPERVISOR REQUESTS INSTEAD OF IN 00220C TIMUSE. IT IS EXECUTED IN LD/M 002301 00240 INTEGER LU,MODE,ID(4),PORT 002501 00260 INTEGER IOBUF(41),XYN,TC,COMPIN,ISTAT 00270 DATA XYN/-1/ 002801 00290 INTEGER SR(2),BLANK(2),COID(2),SRID(2),ACTREC 00300 DATA SR/'SR '/,BLANK/' '/,ACTREC/'01'/ 003101 00320 INTEGER ERRMSG(50),ERRLEN 00330 DATA ERRLEN/100/ 00340 DATA ERRMSG / 00350 1 $D0A,'THE RECORD FOR COLLECTOR IS NOT IN THE UTILITY FI 00360 2LE',$D0A,'THIS SR REQUEST WILL NOT BE PROCESSED ',$D0A/ 003701 00380 INTEGER DDATA(15),TDATA(15),UDATA(15),NUMREC,MAXREC 00390 DATA DDATA/'LADLYWRK',8*$2020,0,1,0/ 00400 DATA TDATA/'LATRNSFL',8*$2020,0,10 ,0/ 00410 DATA UDATA/'LAUTIFIL',8*$2020,1,1,1/ 004201 00430 INTEGER DLYREQ(24),TRNREQ(24),UTIREQ(24) 00440 DATA DLYREQ/24*0/,TRNREQ/24*0/,UTIREQ/24*0/ 004501 00460 INTEGER DLYWRK(20),TRNREC(690),UTIREC(40) 00470 DATA DLYWRK/20*$2020/,TRNREC/690*$2020/,UTIREC/40*$2020/ 004801 00490C EQUIVALENCES FOR NUMBER OF RECORDS RETRIEVED PER 'GETS' 00500C REQUEST FROM TRANSACTION FILE AND MAXIMUM NUMBER OF RECORDS 00510C TO RETRIEVE 00520 EQUIVALENCE (NUMREC,TDATA(15)) 00530 EQUIVALENCE (MAXREC,TRNREQ(15)) 005401 00550 INTEGER AMONTO,ADAYTO,AYERTO,DATE(3) 00560 EXTERNAL AMONTO,ADAYTO,AYERTO 005701 00580C RETRIEVE SYSTEM DATE 00590 DATE(1) = AND($FFFF,AMONTO) 00600 DATE(2) = AND($FFFF,ADAYTO) 00610 DATE(3) = AND($FFFF,AYERTO) 006201 00630C BEGIN PROCESSING 006401 00650 CALL PGMIN(ID,LU,MODE,PORT) 00660 CALL CCSCST(DDATA,1,2,ID,1,8,ICM) 00670 IF(ICM.EQ.0) GO TO 5 00680 CALL CCSMVA(DDATA,3,6,DDATA,1,8) 00690 CALL CCSMVA(TDATA,3,6,TDATA,1,8) 00700 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00710 5 CONTINUE 007201 00730C OPEN FILES 00740 50 CALL OPENFL(UTIREQ,UDATA,ISTAT) 00750 IF(ISTAT.GE.0) GO TO 100 00760 CALL FILERR(UDATA,3,ISTAT,LU) 00770 GO TO 900 007801 00790 100 CALL OPENFL(TRNREQ,TDATA,ISTAT) 00800 IF(ISTAT.GE.0) GO TO 150 00810 CALL FILERR(TDATA,3,ISTAT,LU) 00820 GO TO 900 008301 00840C**** FIRST CLEAR THE DLYWRK FILE 008501 00860 150 CONTINUE 00870 CALL CLEAR(DLYREQ,DDATA,ISTAT) 00880 DO 151 I = 1,24 00890 151 DLYREQ(I) = 0 009001 00910 CALL OPENFL(DLYREQ,DDATA,ISTAT) 00920 IF(ISTAT.GE.0) GO TO 200 00930 CALL FILERR(DDATA,3,ISTAT,LU) 00940 GO TO 900 009501 00960C READ THE TRANSACTION FILE BLOCK 00970 200 CALL GETS(TRNREQ,TRNREC,TRNREC,ISTAT) 00980 IF(AND(ISTAT,$8100).EQ.$8100) GO TO 800 00990 IF(ISTAT.GE.0) GO TO 250 01000 CALL FILERR(TDATA,14,ISTAT,LU) 01010 GO TO 900 010201 01030C PROCESS THE BLOCK 01040 250 DO 700 I = 1, MAXREC 010501 01060 J = 138*I-137 010701 01080C SEE IF THIS WAS AN ACTION RECORD 01090 CALL CCSCST(TRNREC,J+28,2,ACTREC,1,2,COMPIN) 01100 IF(COMPIN.NE.0) GO TO 700 011101 01120C SEE IF IT WAS A SUPERVISOR REQUEST 01130 CALL CCSCST(TRNREC,J+36,2,SR,1,2,COMPIN) 01140 IF(COMPIN.NE.0) GO TO 700 011501 011601 01170C READ THE UTILITY FILE RECORD WITH COID TO GET SUPERVISOR 01180 260 CALL CCSMVA(TRNREC,J+16,4,COID,1,4) 01190 CALL READR(UTIREQ,UTIREC,COID,ISTAT) 01200 IF(AND(ISTAT,$100).EQ.$100.OR.ISTAT.EQ.$200) GO TO 300 01210 IF(ISTAT.GE.0) GO TO 270 01220 CALL FILERR(UDATA,13,ISTAT,LU) 01230 GO TO 800 012401 01250C FOUND RECORD LOOK FOR SUPERVISOR 01260 270 CALL CCSMVA(UTIREC, 37 ,4,SRID,1,4) 01270 CALL CCSCST(SRID,1,4,BLANK,1,4,COMPIN) 01280 IF(COMPIN.EQ.0) CALL CCSMVA(SR,1,4,SRID,1,4) 012901 01300C NOW BUILD DLYWRK FILE 01310 CALL CCSMVA(TRNREC,J,16,DLYWRK,1,16) 01320 CALL CCSMVA(SRID,1,4,DLYWRK,17,4) 01330 CALL CCSMVA(DATE,1,6,DLYWRK,21,6) 01340C IS COMPLETE WRITE IT AND GO GET NEXT RECORD 01350 CALL PUTS(DLYREQ,DLYWRK,1,ISTAT) 01360 IF(ISTAT.GE.0) GO TO 290 01370 CALL FILERR(DDATA,11,ISTAT,LU) 01380 GO TO 900 013901 01400 290 CALL CCSBLK(DLYWRK,40) 01410 GO TO 700 014201 01430C ERROR ON READING THE COLLECTOR ID IN UTILITY FILE-REPORT IT 01440C AND CONTINUE 01450 300 CALL CCSMVA(TRNREC,J+16,4,ERRMSG,28,4) 01460 CALL WTREAD(LU,XYN,ERRMSG,ERRLEN,0,0,0,TC) 014701 01480 700 CONTINUE 014901 01500C ALL TRANSACTIONS FROM THIS BLOCK PROCESSED, CHECK IF THIS IS 01510C THE LAST BLOCK FROM TRANSACTION FILE, IF NOT GET NEXT BLOCK 01520 710 GO TO 200 015301 01540C LAST BLOCK PROCESSED CLOSE FILES AND EXIT 01550 800 CALL CLOSFL(UTIREQ,ISTAT) 01560 CALL CLOSFL(TRNREQ,ISTAT) 01570 CALL CLOSFL(DLYREQ,ISTAT) 015801 01590 900 CALL PGMOUT 01600 END 01610 END/ 01620 END/ 01630*REW,7 01640*K,I7,P21,L14 01650*FTN 01660*EOF 01670*CLOSE 01680*K,I13,L14 01690*Z 01700*Z 01710__ CALL WTREAD(LU,XYN,ERRMSG,ERRLEN,0,0,0,TC) 014701 01480 700 CONTINUE 014901 01500(4 " +J.DALISTCCS149 P(*JOB,,TWB.JOB DALIST INSTALL 09/26/84 00010*K,L14 00020*CTO, DALIST WEAVED AS OF 09/26/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.DALIST , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.DALIST,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120DALIST DCK/ I=13,H 00130DALIST HOL/ 00140 PROGRAM DALIST 00150 1 /CCS3.0 DAILY ASSIGNMENT LIST SL-XXX 001601 00170C** CYBERCREDIT FINANCIAL SERVICES. 00180C** CYBERCREDIT FIELD SUPPORT GROUPS 00190C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00200C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00210C** 00220C** ************ 04/24/84 ************ PROGRAMMER : RWE 002301 00240C**** PROGRAM DESCRIPTION : DALIST PROVIDES HARDCOPY BACKUP 00250C OF DAILY ASSIGNMENTS BY QUEUE. 002601 00270 EXTERNAL FMRDEL,FMEOFC 00280 INTEGER FMRDEL,FDEL,FMEOFC,FEOF 002901 00300 INTEGER DAT1(15),LD1(4),REQ1(24),R1KY(15),REC1(0102) 00310 +, DAT2(15),LD2(4),REQ2(24),R2KY(15),REC2(1002) 003201 00330 INTEGER UTFILE(4),SYPFIL(4) 00340 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 003501 00360 EQUIVALENCE ( REQ1(15), NUMRD ) 00370 INTEGER HEAD(18) 003801 00390 DATA HEAD/$0D0A,$0A17,'EXECUTING DALIST ',$0F16/ 00400 DATA DAT1 /'LADLYASNLA ',00,05,00/,REQ1/24*0/ 00410 +, DAT2 /'LADLQMSTLA ',01,01,00/,REQ2/24*0/ 004201 00430 DATA LD1/'DLYASSN '/,LD2/'DELQMST '/ 004401 00450 INTEGER USER(4),U(8),GRPBUF(10),DATE(3),HDR(20,3) 00460 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 00470 +, IPAGE,DALT(2),DLTREC(40),AEND(2),ALL(2) 00480 +, SVQID(2),IOSW,LTH(2),MNUPRO(3),QA(2,6),QN(6) 004901 00500 DATA PLU/12/,IPAGE/0/,DALT/'DALT'/,AEND/'END '/,ALL/'ALL '/ 00510 +, SVQID/2*$FFFF/,KFLG/0/,LTH/'0360'/,IDUN/0/,IFOUND/0/ 00520 +, JFLG/0/,IMAX/32000/, IWAY/3/,MNUPRO/'MNUPRO'/,IMODE/3/ 005301 00540 INTEGER STG(36),TEMP(10),A00(6),A01(6),RTOT(6),STOT(6) 00550 +, TOT14(7),APAGE(6) 005601 00570 DATA A00 /'000000000000'/, A01 /'000000000001'/ 00580 +, RTOT/'000000000000'/, STOT/'000000000000'/ 00590 +, APAGE/'000000000000'/,TOT14/'00000000000000'/ 006001 00610C**** SYSPRT PARAMETERS........ 006201 00630 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 006401 00650 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 00660 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 00670 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 006801 00690 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 007001 00710C**** SCREEN INPUT AND OUTPUT BUFFERS 00720 INTEGER INP(41),MSG01(31),NAA(16),TAA(14),MSGEOF(09) 007301 00740 DATA MSG01/$0D0A,$0D0A,'HOW MANY ACCOUNTS TO PRINT ? ENTER' 00750 +, ' NNN,ALL, END OR (CR) ',$1616 / 00760 DATA NAA /' NUMBER OF ACCOUNTS ASSIGNED '/ 00770 +, TAA /' TOTAL ACCOUNTS ASSIGNED: '/ 00780 +, MSGEOF/'- END OF REPORT - '/ 007901 00800 INTEGER L01(66),L02(66),L03(66),L04(66),L05(66),L06(66),L07(66) 00810 +, L08(66),L09(66),L10(66),L11(66),L12(66),L13(66),L14(66) 008201 00830C POS. 01 +------------------ THRU ------------------+ 44 00840 DATA L01/'1---------- HDR1 GOES HERE -------------- ' 00850 +, ' DAILY ASSIGNMENTS FOR QUEUE ' 00860 +, ' PAGE '/ 008701 00880C POS. 01 +------------------ THRU ------------------+ 44 00890 DATA L02/' ---------- HDR2 GOES HERE -------------- ' 00900 +, ' AS OF: ' 00910 +, ' '/ 009201 00930C POS. 01 +------------------ THRU ------------------+ 44 00940 DATA L03/' ---------- HDR3 GOES HERE -------------- ' 00950 +, ' ' 00960 +, ' '/ 009701 00980C POS. 01 +------------------ THRU ------------------+ 44 00990 DATA L04/' ' 01000 +, ' ' 01010 +, ' '/ 010201 01030C POS. 01 +------------------ THRU ------------------+ 44 01040 DATA L05/' ' 01050 +, ' AMOUNT DELQ ' 01060 +, ' PAYOFF/TOTAL DUE '/ 010701 01080C POS. 01 +------------------ THRU ------------------+ 44 01090 DATA L06/' ' 01100 +, ' DELQ DATE ' 01110 +, ' CONTACT DATE '/ 011201 01130C POS. 01 +------------------ THRU ------------------+ 44 01140 DATA L07/' ' 01150 +, ' HOME PHONE & EXT. ' 01160 +, ' PRIORITY '/ 01170 01180C POS. 01 +------------------ THRU ------------------+ 44 01190 DATA L08/' ' 01200 +, ' BUS. NAME ' 01210 +, ' '/ 012201 01230C POS. 01 +------------------ THRU ------------------+ 44 01240 DATA L09/' ' 01250 +, ' BUS. PHONE & EXT. ' 01260 +, ' '/ 012701 01280C POS. 01 +------------------ THRU ------------------+ 44 01290 DATA L10/' DATE ACTION RESULT LETTER COLLECT' 01300 +, 'OR-ID ***** COMMENTS ***** ' 01310 +, ' '/ 013201 01330C POS. 01 +------------------ THRU ------------------+ 44 01340 DATA L11/' ' 01350 +, ' ' 01360 +, ' '/ 013701 01380C POS. 01 +------------------ THRU ------------------+ 44 01390 DATA L12/' **************************' 01400 +, '********************************************' 01410 +, '************************ '/ 014201 01430+C POS. 01 +------------------ THRU ------------------+ 44 01440 DATA L13/' ***** ACCOUNTS ASSIGNED TO QUEUE ' 01450 +, ' ' 01460 +, ' '/ 014701 01480C POS. 01 +------------------ THRU ------------------+ 44 01490 DATA L14/' **DALIST** ERROR IN FILE : XXXXXXXX ' 01500 +, ' RUN ABORTED ********** ' 01510 +, ' '/ 015201 01530C**** 01540C**** BEGIN PROGRAM ....... 015501 01560C**** GET RECORD DELETE CODE AND END OF FILE CODE. 01570 ASSEM $C000,FMRDEL,$6800,FDEL 01580 ASSEM $C000,FMEOFC,$6800,FEOF 015901 01600C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 016101 01620 CALL GETSW ( U(1) ) 01630 CALL PGMIN ( USER,LU,MODE,NPORT ) 016401 01650C*** CCS/LA LOOK-ALIKE..... 016601 01670 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 01680 IF ( ICM.EQ.0 ) GO TO 5 01690 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 01700 CALL CCSMVA( LD2,1,8,DAT2,1,16 ) 01710 5 CONTINUE 017201 01730 CALL CCSMVA( USER,1,8,HEAD,23,8 ) 01740 CALL WTREAD( LU,-1,HEAD,36,0,0,0,ITC ) 01750 CALL UTHEAD( HDR,DATE ) 017601 01770 CALL GTSYSP( IWAY, 05 ) 01780 CALL GTSYSP( IMODE, 06 ) 01790 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01800 CALL GETGRP( GRPBUF,IALL,IMODE ) 018101 01820C**** OPEN FILES AND GET UTIFIL RECORDS 018301 01840 CALL SYSPRT( L01,0,SYSPRM,0 ) 01850 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01860 IF( ISERR.LT.0 ) GO TO 9820 018701 01880 CALL OPENFL( REQ1,DAT1,ISTAT ) 01890 IF ( ISTAT.LT.0 ) GO TO 9800 01900 REQ1(23) = 1 019101 01920 CALL OPENFL( REQ2,DAT2,ISTAT ) 01930 IF ( ISTAT.LT.0 ) GO TO 9810 01940 REQ2(23) = 1 019501 01960 CALL GETUTI( DALT,DLTREC,IFOUND,IFER,1 ) 01970 IF ( IFOUND.NE.0 ) GO TO 9820 019801 01990C*** BUILD DALT QUEUES..... 020001 02010 DO 35 I = 1,6 02020 JI = I * 9 02030 CALL CCSMVA( DLTREC,JI,4,QA(1,I),1,4 ) 02040 CALL CCSMVA( DLTREC,JI+5,3,INP,1,3 ) 02050 CALL INTGR ( INP,3,QN(I) ) 02060 IF( QN(I).LE.0 ) QN(I) = 1 02070 35 CONTINUE 020801 02090C*** MOVE IN HEADERS AND SYSTEM DATE.... 021001 02110 CALL EDIT( DATE,1,L02,70,1) 02120C--- CALL CCSTIM( L02(40) ) 02130 CALL CCSMVA( HDR(01,01),1,40,L01,2,40 ) 02140 CALL CCSMVA( HDR(01,02),1,40,L02,2,40 ) 02150 CALL CCSMVA( HDR(01,03),1,40,L03,2,40 ) 02160 IF(NPORT.NE.0 .AND. IPF.NE.1) CALL CCSPUT( $0C,1,L01 ) 021701 02180C**** SCREEN INTERACTION SECTION 021901 02200 50 CONTINUE 02210 CALL CCSMVA(INP,1,0,INP,1,82) 02220 CALL WTREAD(LU,-1,MSG01,62,-1,INP,80,ITC) 02230 IF (ITC.EQ.4) GO TO 50 02240 ICH = INP(41) 02250 IF (ICH.GT.3) GO TO 50 02260 IF (ICH.EQ.0) GO TO 80 022701 02280 CALL CCSCST(AEND,1,3,INP,1,3,ICM) 02290 IF (ICM.EQ.0) GO TO 9900 02300 CALL CCSCST(ALL,1,3,INP,1,3,IAL) 02310 IF (IAL.EQ.0) GO TO 180 023201 02330C*** VALIDATE NUMBER OF ACCOUNTS TO PRINT 023401 02350 IAL = 0 02360 DO 60 I = 1,ICH 02370 CALL CCSGET( INP,I,JCH ) 02380 IF( JCH.GE.$30 .AND. JCH.LE.$39 ) GO TO 60 02390 IF( JCH.EQ.$20 ) GO TO 60 024001 02410 IAL = -1 02420 60 CONTINUE 02430 IF( IAL.LT.0 ) GO TO 50 02440 CALL INTGR( INP,ICH,IMAX ) 02450 GO TO 180 024601 02470C**** SET UP DALT RECORD AND QUEUES... 024801 02490 80 CONTINUE 02500 CALL CCSCST( DLTREC,5,3,ALL,1,3,ICM ) 02510 IF ( ICM.EQ.0 ) GO TO 180 025201 02530C**** GET NUMBER OF ACCOUNTS TO PRINT FROM DALT RECORD 025401 02550 CALL INTGR( DLTREC(3),3,IMAX ) 025601 02570 180 CONTINUE 02580 JFLG = IMAX 02590 IF(JFLG.EQ.0) CALL CCSMVA(NAA,1,32,L01,54,44) 026001 02610C**** RETRIEVE RECORDS....... AND PROCESS 026201 02630 200 CONTINUE 02640 IOF = 0 02650 CALL GETS( REQ1,REC1,R1KY,ISTAT ) 02660 IF( AND(ISTAT,$100).EQ.$100 ) IOF = 1 02670 IF( AND(ISTAT,$8100).EQ.$8100) GO TO 440 02680 IF( ISTAT.LT.0 ) GO TO 9800 026901 02700 220 CONTINUE 02710 DO 400 J = 1, NUMRD 02720C----- REMEMBER TO ADJUST CALC FOR RECORD SIZE 02730 IP = J *20 -19 027401 02750 IF(REC1(IP).EQ.FDEL) GO TO 400 02760 IF(REC1(IP).EQ.FEOF) GO TO 400 027701 02780C*** CHECK IF OK TO USE THIS ACCOUNT GROUP....... 027901 02800 IF (ICKGRP(GRPBUF,IALL,REC1(IP),1).EQ.1 )GO TO 400 028101 02820 IF( JFLG.EQ.0 ) GO TO 230 02830 IF( KFLG.GT.JFLG ) GO TO 230 028401 02850 230 CONTINUE 02860 CALL CCSCST(REC1(IP),17,4,SVQID,1,4,ICM) 02870 IF( ICM.EQ.0 ) GO TO 260 028801 02890C*** NEW QUEUE PRINT BREAKS AND HEADINGS 02900 240 CONTINUE 02910 IF (IPAGE.EQ.0) GO TO 242 029201 02930 CALL CCSADD(STOT,4,RTOT,1,RTOT,1) 02940 CALL CCSMVA(STOT,1,12,TOT14,1,12) 02950 CALL EDIT ( TOT14,6,TEMP,1,3) 02960 CALL CCSMVA(TEMP,2,6,L13,10,6) 02970 CALL CCSMVA(SVQID,1,4,L13,46,4) 02980 CALL SYSPRT( L13,1,SYSPRM,0 ) 02990 IBRK = 0 03000 CALL CCSMVA(A00,1,12,STOT,1,12) 03010 IF(IDUN.EQ.1) GO TO 440 03020 242 CONTINUE 03030 CALL CCSMVA(REC1(IP),17,4,SVQID,1,4) 030401 03050 KFLG = 0 03060 IF( IPAGE.EQ.0 ) GO TO 244 03070 IF(JFLG.EQ.0) GO TO 260 030801 03090C*** CHECK FOR QUEUE OVERRIDE........ 031001 03110 244 CONTINUE 03120 JFLG = IMAX 03130 IF( JFLG.EQ.0 ) GO TO 250 031401 03150 DO 245 I = 1,6 03160 CALL CCSCST( QA(1,I),1,4,SVQID,1,0,ICM ) 03170 IF(ICM.EQ.0) GO TO 245 03180 CALL CCSCST( QA(1,I),1,4,SVQID,1,4,ICM ) 03190 IF(ICM.NE.0) GO TO 245 03200 JFLG = QN(I) 03210 245 CONTINUE 03220C**** OUTPUT HEADER INFO........... 032301 03240 250 CONTINUE 03250 NLINE = 0 03260 IPAGE = IPAGE+1 03270 CALL CCSMVA( REC1(IP),17,4,SVQID,1,4 ) 03280 IF(JFLG.NE.0)CALL CCSMVA( SVQID,1,4,L01,83,4 ) 032901 03300 CALL CCSADD( A01,4,APAGE,1,APAGE,1) 03310 CALL CCSMVA( APAGE,1,12,TOT14,1,12 ) 03320 CALL EDIT ( TOT14,6,TEMP,1,3 ) 03330 CALL CCSMVA(TEMP,3,5,L01,124,5) 033401 03350 CALL SYSPRT( L01,1,SYSPRM,0 ) 03360 CALL SYSPRT( L02,1,SYSPRM,0 ) 03370 CALL SYSPRT( L03,1,SYSPRM,0 ) 03380 CALL SYSPRT( L04,1,SYSPRM,0 ) 033901 03400 IF(IDUN.EQ.1) GO TO 450 034101 03420C**** OUTPUT RECORD INFO.......... 034301 03440 260 CONTINUE 03450 IF ( NLINE.GE.58 ) GO TO 250 03460 CALL CCSADD(A01,4,STOT,1,STOT,1) 03470 IBRK = 1 03480 IF( JFLG.EQ.0 ) GO TO 400 03490 KFLG = KFLG+1 03500 IF( KFLG.GT.JFLG ) GO TO 400 035101 03520 CALL CCSMVA(REC1(IP),1,16,R2KY,1,30) 03530 CALL READR( REQ2,REC2,R2KY,ISTAT ) 03540 IF(AND(ISTAT,$300).NE.0) GO TO 400 03550 IF(ISTAT.LT.0) GO TO 9810 035601 03570 CALL CCSMVA( REC2,1,16,L05,26,16) 03580 CALL EDIT ( REC2,887,L05,75,3 ) 03590 CALL EDIT ( REC2,905,L05,123,3 ) 036001 03610 CALL CCSMVA( REC2,18,30,L06,2,30 ) 03620 CALL EDIT ( REC2,875,L06,77,1 ) 03630 CALL EDIT ( REC2,275,L06,125,1 ) 036401 03650 CALL CCSMVA( REC2,48,30,L07,2,30 ) 03660 CALL EDIT ( REC2,133,L07,73,4 ) 03670 CALL CCSMVA( REC2,143,4,L07,86,4 ) 03680 CALL CCSMVA( REC2,281,4,L07,129,4 ) 036901 03700 CALL CCSMVA( REC2,78,30,L08,2,30 ) 03710 CALL CCSMVA( REC2,147,30,L08,73,30 ) 037201 03730 CALL CCSMVA( REC2,108,20,L09,2,20 ) 03740 CALL CCSMVA( REC2,128,5,L09,24,5 ) 03750 CALL EDIT ( REC2,232,L09,73,4 ) 03760 CALL CCSMVA( REC2,242,4,L09,86,4 ) 037701 03780 CALL SYSPRT( L05,1,SYSPRM,0 ) 03790 CALL SYSPRT( L06,1,SYSPRM,0 ) 03800 CALL SYSPRT( L07,1,SYSPRM,0 ) 03810 CALL SYSPRT( L08,1,SYSPRM,0 ) 03820 CALL SYSPRT( L09,1,SYSPRM,0 ) 03830 CALL SYSPRT( L10,1,SYSPRM,0 ) 038401 03850C**** OUTPUT THE ON-LINE ACTIVITY BLOCK. (MAX OF 4 ACTIVITIES) 038601 03870 DO 290 MA = 1,4 03880 CALL CCSMVA( L11,1,0,L11,1,PLN ) 038901 03900 IOSW = A00 03910 CALL GETACF( STG,REC2(154),LTH,IOSW ) 03920 IF (IOSW.EQ.$3031) GO TO 280 039301 03940 CALL EDIT( STG,1,L11,2,1 ) 03950 CALL CCSMVA( STG,7,2,L11,13,2 ) 03960 CALL CCSMVA( STG,9,2,L11,22,2 ) 03970 CALL CCSMVA( STG,11,2,L11,31,2 ) 03980 CALL CCSMVA( STG,13,4,L11,42,4 ) 03990 CALL CCSMVA( STG,17,56,L11,54,56 ) 040001 04010 CALL SYSPRT( L11,1,SYSPRM,0 ) 04020 GO TO 290 040301 04040C*** NO MORE ACTIVITIES PRINT BLANK LINES. 04050 280 CONTINUE 04060 NL = 5 - MA 04070 CALL SYSPRT( L11,NL,SYSPRM,0 ) 04080 GO TO 300 04090 290 CONTINUE 04100 300 CONTINUE 04110 CALL SYSPRT( L12,1,SYSPRM,0 ) 041201 04130 400 CONTINUE 04140 IF( ISERR.LT.0 ) GO TO 9900 04150 420 CONTINUE 04160 IF (IOF.NE.1) GO TO 200 04170 440 CONTINUE 04180 IDUN = 1 04190 IF(IBRK.EQ.1) GO TO 240 042001 04210C*** SET UP AND PRINT FINAL PAGE OF REPORT..... 042201 04230 CALL CCSMVA(NAA,1,32,L01,54,44) 04240 JFLG = 0 04250 GO TO 250 042601 04270 450 CONTINUE 04280 CALL CCSMVA(TAA,1,28,L12,47,37) 04290 CALL CCSMVA(RTOT,1,12,TOT14,1,12) 04300 CALL EDIT (TOT14,6,TEMP,1,3) 04310 CALL CCSMVA(TEMP,2,6,L12,75,6) 043201 04330 CALL SYSPRT( L04,10,SYSPRM,0 ) 04340 CALL SYSPRT( L12,08,SYSPRM,0 ) 04350 CALL SYSPRT( L04,10,SYSPRM,0 ) 04360 CALL CCSMVA( MSGEOF,1,18,L04,57,18 ) 04370 CALL SYSPRT( L04,01,SYSPRM,0 ) 04380 GO TO 9900 043901 04400C**** ERROR SECTION FILE 1 04410 9800 CONTINUE 04420 IREQ = AND(REQ1(4),$FF) 04430 IF (IREQ.LT.11) IREQ = IREQ-1 04440 IF (IREQ.EQ.18) IREQ = 10 04450 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 04460 CALL CCSMVA( DAT1,1,8,L14,32,8 ) 04470 IERR = 1 04480 GO TO 9900 044901 04500C**** ERROR SECTION FILE 2 04510 9810 CONTINUE 04520 IREQ = AND(REQ2(4),$FF) 04530 IF (IREQ.LT.11) IREQ = IREQ-1 04540 IF (IREQ.EQ.18) IREQ = 10 04550 CALL FILERR( DAT2,IREQ,ISTAT,LU ) 04560 CALL CCSMVA( DAT2,1,8,L14,32,8 ) 04570 IERR = 1 04580 GO TO 9900 045901 04600C**** ERROR SECTION FILE 3 04610 9820 CONTINUE 04620 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 04630 IERR = 1 04640 GO TO 9900 046501 04660C**** CLOSE THE FILES AND EXIT........ 04670 9900 CONTINUE 04680 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 046901 04700 CALL CLOSFL( REQ1,ISTAT ) 04710 CALL CLOSFL( REQ2,ISTAT ) 04720 CALL SYSPRT( L04,0,SYSPRM,1 ) 047301 04740 CALL PGMOUT 04750 END 04760 END/ 04770GETSW DCK/ I=13,H 04780GETSW HOL/ 04790 SUBROUTINE GETSW ( U ) 04800 1 /CCS3.0 SUBROUTINE GETSW SL-XXX 048101 04820C** CYBERCREDIT FINANCIAL SERVICES. 04830C** CYBERCREDIT FIELD SUPPORT GROUPS 04840C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 04850C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 04860C** 04870C** ************ 04/06/84 ************ PROGRAMMER : RWE 048801 04890C**** PROGRAM DESCRIPTION : RETRIEVE RPG EXTERNAL SWITCH SETTINGS 049001 04910C*** CALLING SEQUENCE : CALL GETSW( U ) 049201 04930C PARAMETERS 049401 04950C U : AN 8 WORD ARRAY, WHERE EACH WORD CORRESPONDS 04960C TO AN RPG EXTERNAL SWITCH 04970C RPG ARRAY 04980C U1 = U(1) 04990C U2 = U(2) 05000C ETC... 05010C RETURNED VALUES ARE 0 = SWITCH IS OFF, 1 = SWITCH IS ON 050201 05030 INTEGER U(1),I,J,SWITCH 050401 05050C**** 05060C**** BEGIN PROGRAM ....... 050701 05080C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 050901 05100 ASSEM $C400,$00E3,$6800,SWITCH 051101 05120 J = 2 051301 05140C*** CRACK THE SWITCHS 051501 05160 DO 100 I = 1,8 05170 U(I) = AND( SWITCH,J )/J 05180 J = J*2 05190 100 CONTINUE 05200 RETURN 05210 END 05220 END/ 05230GTSYSP DCK/ I=13,H 05240GTSYSP HOL/ 05250 SUBROUTINE GTSYSP( IPARM,IPOS ) 05260 1 /CCS3.0 SUBROUTINE GTSYSP SL-XXX 052701 05280C** CYBERCREDIT FINANCIAL SERVICES. 05290C** CYBERCREDIT FIELD SUPPORT GROUPS 05300C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 05310C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 05320C** 05330C** ************ 04/06/84 ************ PROGRAMMER : RWE 053401 05350C**** PROGRAM DESCRIPTION : GET SYSTEM PARAMETER FROM THE 05360C EXTERNAL FLAG RECORD IN THE UTIFIL. 053701 05380C*** CALLING SEQUENCE : CALL GTSYSP( IPARM,IPOS ) 053901 05400C PARAMETERS 054101 05420C IPARM : RETURNED VALUE ($0 TO $F WHICH IS 0 TO 15 DECIMAL) 05430C WHICH IS RETRIEVED FROM THE 'EXTERNAL FLAG RECORD' 05440C IN THE UTIFIL. 05450C IPOS : THE STARTING BYTE OF THE FLAG IN THE FLAG RECORD. 05460C ( SEE LAYOUT OF 'EXTERNAL FLAG RECORD' ) 054701 05480C EXAMPLE : CALL GTSYSP( IMODE,30 ) 05490C THIS WOULD RETRIEVE THE FLAG 2 FOR THE 05500C LTRSTA PROGRAM AND SET THE IMODE FLAG FOR 05510C SUBROUTINE GETGRP 05520C LTRSTA FLAGS START IN POS. 29, THERE ARE 4 FLAGS 05530C FLAG 1 = IWAY FOR SUBROUTINE PRTORF 05540C FLAG 2 = IMODE FOR SUBROUTINE GETGRP 05550C FLAG 3 = 05560C FLAG 4 = 055701 05580 INTEGER IPARM,IPOS 05590 +, SYSREC(42),SYSP(2),IGOT 056001 05610 DATA SYSP /'SYSP'/, IGOT / 0/ 056201 05630C**** 05640C**** BEGIN PROGRAM ....... 056501 05660 IF ( IGOT.NE.0 ) GO TO 100 05670 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 05680 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 05690 IGOT = 1 057001 05710 100 CONTINUE 05720 CALL CCSGET( SYSREC,IPOS,IFLG ) 057301 05740 IPARM = AND( IFLG,$F ) 05750 RETURN 05760 END 05770 END/ 05780GETUTI DCK/ I=13,H 05790GETUTI HOL/ 05800 SUBROUTINE GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 05810 1 /CCS3.0 SUBROUTINE GETUTI SL-XXX 058201 05830C** CYBERCREDIT FINANCIAL SERVICES. 05840C** CYBERCREDIT FIELD SUPPORT GROUPS 05850C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 05860C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 05870C** 05880C** ************ 04/06/84 ************ PROGRAMMER : RWE 058901 05900C**** PROGRAM DESCRIPTION : RETRIEVE RECORD BY KEY FROM UTIFIL. 059101 05920C*** CALLING SEQUENCE : CALL GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 059301 05940C PARAMETERS 059501 05960C KEYB : KEY OF UTIFIL RECORD TO BE RETRIEVED ( 2 WORDS ) 05970C REC : BUFFER TO RECIEVE THE RETRIEVED RECORD(40 WORDS ) 05980C BUFFER WILL BE BLANKS IF RECORD IS NOT FOUND. 05990C IFOUND : RETURNED VALUE DESIGNATING IF RECORD WAS FOUND. 06000C 0 = RECORD FOUND , 1 = RECORD NOT FOUND 06010C IFER : ISTAT OF FILE MANAGER CALL. (FROM UTIFIL) 06020C NOPT : PASSED. OPTION OF WHAT TO DO. 06030C 0 = RETRIEVE RECORD (LEAVE FILE OPEN) 06040C 1 = RETRIEVE RECORD (CLOSE FILE WHEN DONE) 06050C 2 = CLOSE FILE. 060601 06070 INTEGER KEYB(1),REC(1),IFOUND,IFER,NOPT 06080 +, DAT1(15),REQ1(24),R1KY(15),REC1(0042) 06090 +, USER(4),LU,NPORT,MODE 061001 06110 DATA DAT1 /'LAUTIFIL ',01,01,00/,REQ1/24*0/ 06120 DATA IOPN/0/ , IDUN/0/ 061301 06140C**** 06150C**** BEGIN PROGRAM ....... 061601 06170 IF ( NOPT.EQ.2 ) GO TO 500 06180 IF ( IOPN.EQ.1 ) GO TO 100 061901 06200C*** CHECK FOR LA LOOK-ALIKE 062101 06220 IF( IDUN.EQ.1 ) GO TO 5 06230 IDUN = 1 06240 CALL PGMIN( USER,LU,MODE,NPORT ) 06250 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 06260 IF ( ICM.EQ.0 ) GO TO 5 06270 CALL CCSMVA( DAT1,3,6,DAT1,1,16 ) 062801 06290 5 CONTINUE 06300 DO 20 I = 1,24 06310 REQ1(I) = 0 06320 20 CONTINUE 063301 06340 CALL OPENFL( REQ1,DAT1,ISTAT ) 06350 IF( ISTAT.LT.0 ) GO TO 800 06360 REQ1(23) = 1 06370 IOPN = 1 063801 06390 100 CONTINUE 06400 CALL CCSMVA( KEYB,1,4,R1KY,1,30 ) 06410 CALL READR ( REQ1,REC1,R1KY,ISTAT ) 06420 IF ( AND(ISTAT,$300).NE.0 ) GO TO 200 06430 IF ( ISTAT.LT.0 ) GO TO 800 064401 06450C*** RECORD FOUND PASS INFO BACK TO CALLER 064601 06470 120 CONTINUE 06480 IFER = ISTAT 06490 IFOUND = 0 06500 CALL CCSMVA( REC1,1,80,REC,1,80 ) 06510 IF( NOPT.EQ.1 ) GO TO 500 06520 GO TO 900 065301 06540C**** RECORD NOT FOUND RETURN BLANKS 065501 06560 200 CONTINUE 06570 IFER = AND( ISTAT,$7FFF ) 06580 IFOUND = 1 06590 CALL CCSMVA( REC1,1,0,REC,1,40 ) 06600 IF( NOPT.EQ.1 ) GO TO 500 06610 GO TO 900 066201 06630C**** CLOSE FILE AND RETURN 066401 06650 500 CONTINUE 06660 CALL CLOSFL( REQ1,ISTAT ) 06670 IOPN = 0 06680 GO TO 900 066901 06700C**** ERROR SECTION FOR FILE 067101 06720 800 CONTINUE 06730 IFOUND = 1 06740 IFER = ISTAT 06750 IF( AND(ISTAT,$8002).EQ.$8002 ) GO TO 900 06760 IREQ = AND(REQ1(4),$FF) 06770 IF(IREQ.LT.11) IREQ = IREQ-1 06780 IF(IREQ.EQ.18) IREQ = 10 06790 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 06800 GO TO 900 068101 06820 900 CONTINUE 06830 RETURN 06840 END 06850 END/ 06860PRTORF DCK/ I=13,H 06870PRTORF HOL/ 06880 SUBROUTINE PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 06890 1 /CCS3.0 SUBROUTINE PRTORF SL-XXX 069001 06910C** CYBERCREDIT FINANCIAL SERVICES. 06920C** CYBERCREDIT FIELD SUPPORT GROUPS 06930C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 06940C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 06950C** 06960C** ************ 04/06/84 ************ PROGRAMMER : RWE 069701 06980C**** PROGRAM DESCRIPTION : VALIDATE OUTPUT LOGICAL UNIT AND 06990C SET DIRECTION OF OUTPUT. 070001 07010C*** CALLING SEQUENCE : CALL PRTORF( IPF,LU,NLU,NPORT,IWAY ) 070201 07030C PARAMETERS 070401 07050C IPF : RETURNED VALUE DESIGNATING OUTPUT DIRECTION. 07060C 0 = OUTPUT TO LOCIGAL UNIT 'NLU' 07070C 1 = OUTPUT TO SYSPRT FILE 07080C LU : LOGICAL UNIT NUMBER OF REQUESTED OUTPUT DEVICE. 07090C NLU : RETURNED VALUE DESIGNATING VALIDATED LOGICAL 07100C UNIT TO OUTPUT TO. 07110C NPORT : CURRENT TERMINAL # ( FROM PGMIN ) 07120C IWAY : FLAG TO DETERMINE WHICH ACTION TO TAKE : 07130C 0 = FORCE OUTPUT TO DESIGNATED LOGICAL UNIT 07140C 1 = FORCE OUTPUT TO SYSPRT FILE 07150C 2 = NOT USED AT PRESENT TIME 07160C 3 = PROMPT OPERATOR FROM SCREEN, FOR OUTPUT DIRECTION 07170C 4 = GET 'IWAY' FLAG FROM UTIFIL 071801 07190 INTEGER IPF,PLU,NLU,NPORT,IWAY 07200 +, INP(41),CRT(4),PRINT(4),TAPE(5),MSGY(18) 07210 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 072201 07230 DATA MSG1/$180A,$0A07,'** SELECT DIRECTION OF OUTPUT ',$160A/ 07240 +, MSG2/$0D0A,' 0 = OUTPUT TO LOGICAL UNIT ',$1616/ 07250 +, MSG3/$0D0A,' 1 = OUTPUT TO SYSPRT FILE ',$1616/ 07260 +, MSG4/$0D0A,' ',$160A/ 07270 +, MSG5/$0D0A,' PLEASE ENTER SELECTION (0,1) : ',$1616/ 072801 07290 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 073001 07310 DATA CRT /'TERMINAL'/, PRINT /'PRINTER '/ 07320 +, TAPE /'TAPE DRIVE'/ 073301 07340C**** BEGIN PROGRAM ....... 073501 07360 MWAY = IWAY 07370 10 CONTINUE 07380 PLU = AND( PLU,$FF ) 07390 IF ( MWAY.EQ.1 ) GO TO 200 074001 07410 NLU = PLU 07420 IF ( NPORT.NE.00 ) NLU = 05 07430 IF ( NPORT.EQ.00 .AND. NLU.EQ.05 ) NLU = 04 07440 IF ( MWAY.EQ.3 ) GO TO 300 07450 IF ( MWAY.EQ.4 ) GO TO 400 074601 07470 100 CONTINUE 07480 IPF = 0 07490 IF ( MWAY.EQ.2 ) IPF = 0 07500 GO TO 800 075101 07520C*** OUTPUT FORCED TO SYSPRT FILE...... 075301 07540 200 CONTINUE 07550 IPF = 1 07560 GO TO 800 075701 07580C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 075901 07600 300 CONTINUE 07610 IF(NLU.EQ.05.OR.NLU.EQ.04) CALL CCSMVA( CRT,1,8,MSG2,18,12 ) 07620 IF(NLU.EQ.09.OR.NLU.EQ.12) CALL CCSMVA( PRINT,1,8,MSG2,18,12 ) 07630 IF(NLU.EQ.06.OR.NLU.EQ.16) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 07640 IF(NLU.EQ.17.OR.NLU.EQ.18) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 076501 07660 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 07670 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 07680 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 07690 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 077001 07710 310 CONTINUE 07720 CALL CCSMVA(INP,1,0,INP,1,82) 07730 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 07740 IF (ITC.EQ.4) GO TO 310 077501 07760C*** VALIDATE SELECTION.... 077701 07780 CALL CCSGET( INP,1,ICH ) 077901 07800 IF( INP(41).EQ.0 ) GO TO 320 07810 IF ( ICH.LT.$30 .OR. ICH.GT.$31 ) GO TO 310 078201 07830 320 IPF = AND( ICH,$F ) 07840 IF( IPF.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 07850 IF( IPF.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 078601 07870 CALL CCSMVA(INP,1,0,INP,1,82) 07880 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 07890 CALL CCSGET(INP,1,ICH) 07900 IF ( INP(41).EQ.0 ) GO TO 330 07910 IF ( ICH.NE.$59 ) GO TO 300 07920 330 CONTINUE 07930 GO TO 800 079401 07950C**** GET 'IWAY' WHAT TO DO FLAG FROM UTIFIL... 079601 07970 400 CONTINUE 07980 CALL GTSYSP( MWAY,73 ) 07990 IF ( MWAY.LT.0 .OR. MWAY.GT.3 ) MWAY = 0 08000 GO TO 10 080101 08020 800 RETURN 08030 END 08040 END/ 08050GETGRP DCK/ I=13,H 08060GETGRP HOL/ 08070 SUBROUTINE GETGRP( GRPBUF,IALL,IMODE ) 08080 1 /CCS3.0 SUBROUTINE GETGRP SL-XXX 080901 08100C** CYBERCREDIT FINANCIAL SERVICES. 08110C** CYBERCREDIT FIELD SUPPORT GROUPS 08120C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 08130C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 08140C** 08150C** ************ 04/06/84 ************ PROGRAMMER : RWE 081601 08170C**** PROGRAM DESCRIPTION : SELECT WHICH ACCOUNT GROUPS TO USE 081801 08190C*** CALLING SEQUENCE : CALL GETGRP( GRPBUF,IALL,IMODE ) 082001 08210C PARAMETERS 082201 08230C GRPBUF : 10 WORD ARRAY RETURNED TO PROGRAM WITH FROM 1 08240C TO 10 VALID ACCOUNT GROUPS 08250C ( FOR USE WITH FUNCTION 'ICKGRP' ) 08260C IALL : FLAG RETURNED DESIGNATING USE OF ACCOUNT GROUPS 08270C 0 = USE ALL ACCOUNT GROUPS 08280C 1 = USE ONLY ACCOUNT GROUPS IN GRPBUF ARRAY 08290C IMODE : FLAG TO DETERMINE WHICH ACTION TO TAKE : 08300C 0 = USE ALL ACCOUNT GROUPS 08310C 1 = USE ACCOUNT GROUPS 0-4 ONLY 08320C 2 = USE ACCOUNT GROUPS 5-9 ONLY 08330C 3 = PROMPT FROM SCREEN, WHICH OF (0-9) GROUPS TO USE 08340C 4 = PROMPT FROM SCREEN, EITHER ALL, OR 0-4, OR 5-9. 08350C 5 = GET 'IMODE' FLAG FROM UTIFIL 083601 08370 INTEGER GRPBUF(1),IALL,IMODE 08380 +, INP(41),MSGY(18),AGRPS(10),MINUS(10),ALL 08390 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 08400 +, MSGA(18),MSGB(18),MSGC(18),MSGD(18),MSGE(18),MSGF(20) 084101 08420 DATA MSG1/$180A,$0A0D,'** SELECT ACCOUNT GROUP OPTION',$160A/ 08430 +, MSG2/$0D0A,' 0 = ALL ACCOUNT GROUPS ',$1616/ 08440 +, MSG3/$0D0A,' 1 = ACCOUNT GROUPS 0-4 ONLY ',$1616/ 08450 +, MSG4/$0D0A,' 2 = ACCOUNT GROUPS 5-9 ONLY ',$160A/ 08460 +, MSG5/$0D0A,' PLEASE ENTER SELECTION(0,1,2) :',$1616/ 084701 08480 DATA MSGA/$180A,$0A0D,'* SELECT ACCOUNT GROUPS TO USE',$160A/ 08490 +, MSGB/$0D0A,' SEPARATE GROUPS BY COMMAS, ',$1616/ 08500 +, MSGC/$0D0A,' (I.E. 0,1,2,3, ETC...) OR ',$1616/ 08510 +, MSGD/$0D0A,' ENTER A FOR ALL GROUPS ',$160A/ 08520 +, MSGE/$0D0A,' PLEASE ENTER SELECTION -- :',$1616/ 085301 08540 DATA MSGF/$180A,'INVALID ENTRY : ',$160A/ 085501 08560 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 08570 +, AGRPS/'0,1,2,3,4,5,6,7,8,9,'/,MINUS/10*$FFFF/,ALL/'A,'/ 085801 08590C**** BEGIN PROGRAM ....... 086001 08610 MODE = IMODE 08620 IALL = 0 08630 CALL CCSMVA( MINUS,1,20,GRPBUF,1,20 ) 086401 08650 10 CONTINUE 08660 IF ( MODE.EQ.0 ) GO TO 50 08670 IF ( MODE.EQ.1 ) GO TO 100 08680 IF ( MODE.EQ.2 ) GO TO 200 08690 IF ( MODE.EQ.3 ) GO TO 300 08700 IF ( MODE.EQ.4 ) GO TO 400 08710 IF ( MODE.EQ.5 ) GO TO 500 087201 08730C**** SET AND USE ALL ACCOUNT GROUPS 087401 08750 50 CONTINUE 08760 IALL = 0 08770 CALL CCSMVA( AGRPS,1,20,GRPBUF,1,20 ) 08780 GO TO 800 087901 08800C**** SET AND USE GROUPS 0-4 ONLY 088101 08820 100 CONTINUE 08830 IALL = 1 08840 CALL CCSMVA( AGRPS,1,10,GRPBUF,1,10 ) 08850 GO TO 800 088601 08870C**** SET AND USE GROUPS 5-9 ONLY 088801 08890 200 CONTINUE 08900 IALL = 1 08910 CALL CCSMVA( AGRPS,11,10,GRPBUF,1,10 ) 08920 GO TO 800 089301 08940C**** ASK OPERATOR FROM SCREEN WHICH ACCOUNT GROUPS..... 089501 08960 300 CONTINUE 08970 CALL CCSMVA( MSG2,8,18,MSG2,4,30 ) 08980 CALL CCSMVA( MSG3,16,6,MSG3,4,30 ) 089901 09000 305 CONTINUE 09010 ASSIGN 305 TO IRTN 09020 ASSIGN 10 TO IRTN2 09030 CALL WTREAD(05,-1,MSGA ,36,0,0,0,ITC) 09040 CALL WTREAD(05,-1,MSGB ,36,0,0,0,ITC) 09050 CALL WTREAD(05,-1,MSGC ,36,0,0,0,ITC) 09060 CALL WTREAD(05,-1,MSGD ,36,0,0,0,ITC) 09070 MSGA = MSG1 090801 09090 310 CONTINUE 09100 CALL CCSMVA(INP,1,0,INP,1,82) 09110 CALL WTREAD(05,-1,MSGE ,36,-1,INP,80,ITC) 09120 IF (ITC.EQ.4) GO TO 310 09130 NCH = INP(41) 09140 NCH = (NCH+1)/2 09150 N2H = NCH*2 09160 CALL CCSPUT( $2C,N2H,INP ) 09170 IF ( INP.EQ.ALL ) GO TO 320 09180 GO TO 330 091901 09200C**** VERIFY ALL GROUPS TO BE USED... 092101 09220 320 CONTINUE 09230 MODE = 0 09240 CALL WTREAD( 05,-1,MSG2,36,0,0,0,ITC ) 09250 GO TO 425 092601 09270C**** VALIDATE INPUT FOR VALID GROUPS..... 092801 09290 330 CONTINUE 093001 09310 K = 1 09320 MELM= NCH-1 09330 IF (MELM.LE.1) GO TO 370 09340 DO 360 I=1,MELM 093501 09360 IF(INP(I).LT.INP(I+1))GO TO 360 09370 340 TEMP = INP(I) 09380 INP(I) = INP(I+1) 09390 INP(I+1) = TEMP 09400 DO 350 J=I,2,-K 09410 IF(INP(J).GT.INP(J-1))GO TO 360 09420 TEMP = INP(J) 09430 INP(J) = INP(J-1) 09440 INP(J-1) = TEMP 09450 350 CONTINUE 09460 360 CONTINUE 094701 09480C*** CHECK FOR DUPLICATE NUMBERS 094901 09500 JJ = NCH-1 09510 DO 365 I = 1,JJ 09520 IF ( INP(I).EQ.INP(I+1) ) GO TO 390 09530 365 CONTINUE 095401 09550C*** DISPLAY CHOICES AND VERIFY... 095601 09570 370 CONTINUE 09580 IF( INP(1).EQ.INP(2) ) GO TO 390 09590 DO 375 I = 1,NCH 09600 L = ( AND(INP(I),$FF00) )/256 09610 IF ( L.LT.$30 .OR. L.GT.$39 ) GO TO 390 09620 375 CONTINUE 09630 CALL CCSMVA( INP,1,N2H,MSG4,1,N2H ) 09640 CALL CCSMVA( INP,1,N2H-1,MSG3,11,20 ) 09650 CALL WTREAD( 05,-1,MSG3,36,0,0,0,ITC ) 09660 ASSIGN 380 TO IRTN2 09670 GO TO 425 096801 09690C*** SET GROUPS..... 097001 09710 380 CONTINUE 09720 IALL = 1 09730 CALL CCSMVA( MSG4,1,N2H,GRPBUF,1,N2H ) 09740 GO TO 800 097501 09760C*** ERROR IN NUMBER ENTRY ..... REPEAT PROMPT 097701 09780 390 CONTINUE 09790 MSGA = MSGB 09800 CALL CCSMVA( INP,1,N2H-1,MSGF,19,20 ) 09810 CALL WTREAD( 05,-1,MSGF,40,0,0,0,ITC ) 09820 GO TO IRTN 098301 09840C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 098501 09860 400 CONTINUE 09870 ASSIGN 400 TO IRTN 09880 ASSIGN 10 TO IRTN2 09890 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 09900 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 09910 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 09920 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 099301 09940 410 CONTINUE 09950 CALL CCSMVA(INP,1,0,INP,1,82) 09960 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 09970 IF (ITC.EQ.4) GO TO 410 099801 09990C*** VALIDATE SELECTION.... 100001 10010 CALL CCSGET( INP,1,ICH ) 100201 10030 IF( INP(41).EQ.0 ) GO TO 420 10040 IF ( ICH.LT.$30 .OR. ICH.GT.$32 ) GO TO IRTN 100501 10060 420 MODE = AND( ICH,$F ) 10070 IF( MODE.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,35,0,0,0,ITC) 10080 IF( MODE.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,35,0,0,0,ITC) 10090 IF( MODE.EQ.2 ) CALL WTREAD(05,-1,MSG4 ,35,0,0,0,ITC) 101001 10110 425 CONTINUE 10120 CALL CCSMVA(INP,1,0,INP,1,82) 10130 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 10140 CALL CCSGET(INP,1,ICH) 10150 IF ( INP(41).EQ.0 ) GO TO 430 10160 IF ( ICH.NE.$59 ) GO TO IRTN 10170 430 CONTINUE 10180 GO TO IRTN2 101901 10200C**** GET 'IMODE' WHAT TO DO FLAG FROM UTIFIL... 102101 10220 500 CONTINUE 10230 CALL GTSYSP( MODE,77 ) 10240 IF ( MODE.LT.0 .OR. MODE.GT.4 ) MODE = 0 10250 GO TO 10 102601 10270 800 RETURN 10280 END 10290 END/ 10300SYSPRT DCK/ I=13,H 10310SYSPRT HOL/ 10320 SUBROUTINE SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 10330 1 /CCS3.0 SUBROUTINE SYSPRT SL-XXX 103401 10350C** CYBERCREDIT FINANCIAL SERVICES. 10360C** CYBERCREDIT FIELD SUPPORT GROUPS 10370C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 10380C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 10390C** 10400C** ************ 04/06/84 ************ PROGRAMMER : RWE 104101 10420C**** PROGRAM DESCRIPTION : OUTPUT BUFFER TO LOGICAL UNIT OR 10430C TO A FILE 'SYSPRT'. 104401 10450C*** CALLING SEQUENCE : CALL SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 104601 10470C PARAMETERS 104801 10490C BUFFER : BUFFER CONTAINING CHARACTERS TO OUTPUT FROM. 10500C NTIMES : # OF TIMES TO OUTPUT THE BUFFER 10510C SYSPRM : 6 WORD ARRAY HOLDING PARAMETERS FOR SYSPRT 10520C SYSPRM(1) : PLN - NUMBER OF BYTES TO OUTPUT FROM BUFFER 10530C SYSPRM(2) : NLU - LOGICAL UNIT TO OUTPUT TO ( IGNORED IF 10540C OUTPUT IS TO FILE ) 10550C SYSPRM(3) : IPF - SWITCH DESIGNATING OUTPUT TO FILE OR LU 10560C 0 = LOGICAL UNIT. 1 = FILE. 2 = BOTH. 10570C SYSPRM(4) : NLINE - CURRENT LINE OR RECORD JUST OUTPUT. 10580C (INITIALIZED TO 0 BY CALLING PROGRAM) 10590C SYSPRM(5) : ISERR - ISTAT OF FILE MANAGER CALL TO FILE 10600C SYSPRM(6) : NU - NOT USED AT PRESENT TIME 10610C IOPT : WHAT TO DO FLAG. 0 = OUTPUT BUFFER TO FILE OR LU 10620C 1 = CLOSE FILE 106301 10640C**** SYSPRT PARAMETERS........ 106501 10660 INTEGER BUFFER(1),NTIMES,IOPT 10670 +, SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 106801 10690 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 10700 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 10710 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 107201 10730C**** FWRITE PARAMETERS..... 10740 INTEGER IFLAG,ITEMP(8) 107501 10760 DATA IFLAG /0/, ITEMP /8*0/ 107701 10780 INTEGER DAT1(15),REQ1(24),R1KY(15),REC1(0068) 10790 +, HEDR(18) 108001 10810 DATA HEDR/$0D0A,$0717,'ABORTED--PRINT FILE IS FULL FN='/ 10820 DATA DAT1 /'SYSPRT ',00,01,-1/,REQ1/24*0/ 10830 +, IOPN/0/ 108401 10850C**** 10860C**** BEGIN PROGRAM ....... 108701 10880 IF ( ISERR.LT.0 ) GO TO 800 10890 ISERR = 0 10900 LINE = NLINE 10910 LU = AND( NLU,$FF ) 10920 LENW = (PLN+1)/2 109301 10940 IF ( IOPT.NE.0 ) GO TO 950 10950 IF ( IPF.EQ.1 ) GO TO 400 10960 IF ( NTIMES.LE.0 ) GO TO 800 109701 10980 IF ( LU.EQ.05 .OR. LU.EQ.04 ) GO TO 20 10990 IF ( LU.EQ.09 .OR. LU.EQ.12 ) GO TO 20 11000 I = LENW 11010 GO TO 40 110201 11030 20 CONTINUE 11040 DO 30 I = LENW, 2, -1 11050 IF ( BUFFER(I).NE.$2020 ) GO TO 40 11060 30 CONTINUE 110701 11080 40 CONTINUE 11090 LENB = I * 2 111001 11110C*** WRITE BUFFER TO LOGICAL UNIT..... 111201 11130 IF ( LU.EQ.05 ) GO TO 140 11140 50 CONTINUE 111501 11160 DO 80 I = 1,NTIMES 111701 11180 ASSIGN 60 TO ICOMP 11190 CALL FWRITE( LU,BUFFER,LENB,ICOMP,IFLAG,ITEMP ) 11200 CALL DISP 11210 60 CONTINUE 112201 11230 80 CONTINUE 11240 GO TO 200 112501 11260C**** WRITE OUTPUT TO TERMINAL (MAX OF 132 BYTES)......... 112701 11280 140 CONTINUE 11290 DO 150 I = 1,NTIMES 113001 11310 ILN = LENB 11320 JLN = LENB 11330 IF ( ILN.GE.80 ) JLN = 80 113401 11350 CALL WTREAD( LU,-1,HEDR,2,0,0,0,ITC ) 11360 CALL WTREAD( LU,-1,BUFFER,JLN,0,0,0,ITC ) 113701 11380 JLN = ILN-80 11390 IF( JLN.LE.0 ) GO TO 150 114001 11410 CALL WTREAD( LU,-1,BUFFER(41),JLN,0,0,0,ITC ) 114201 11430 150 CONTINUE 114401 11450C**** INCREMENT LINE COUNT....... 114601 11470 200 CONTINUE 11480 NLINE = NLINE + NTIMES 11490 GO TO 800 115001 11510C**** WRITE BUFFER TO SYSPRT FILE.......... 115201 11530 400 CONTINUE 11540 IF ( IOPN.EQ.1 ) GO TO 420 115501 11560 DO 410 I = 1,24 11570 REQ1(I) = 0 11580 410 CONTINUE 115901 11600 CALL OPENFL( REQ1,DAT1,ISTAT ) 11610 IF( ISTAT.LT.0 ) GO TO 900 11620 IOPN = 1 116301 11640C**** OUTPUT BUFFER TO SYSPRT FILE.... 116501 11660 420 CONTINUE 11670 IF( NTIMES.LE.0 ) GO TO 800 11680 ILN = PLN 11690 IF( ILN.GT.132 ) ILN = 132 11700 CALL CCSMVA( BUFFER,1,ILN,REC1,1,132 ) 117101 11720 DO 440 I = 1,NTIMES 11730 CALL PUTS( REQ1,REC1,1,ISTAT ) 11740 IF( AND(ISTAT,$9000).EQ.$9000 ) GO TO 500 11750 IF( ISTAT.LT.0 ) GO TO 900 11760 440 CONTINUE 117701 11780 NLINE = NLINE+NTIMES 11790 GO TO 800 118001 11810C**** INFORM OPERATOR FILE IS FULL..... 118201 11830 500 CONTINUE 11840 ISERR = -1 11850 CALL CCSMVA( HEDR,1,36,REC1,1,132 ) 11860 CALL CCSMVA( DAT1,1,24,REC1,37,24 ) 11870 CALL WTREAD( 05,-1,REC1,64,0,0,0,ITC ) 11880 GO TO 950 118901 11900 800 CONTINUE 11910 RETURN 119201 11930C*** ERROR SECTION.... 119401 11950 900 CONTINUE 11960 ISERR = -1 11970 IREQ = AND(REQ1(4),$FF) 11980 IF(IREQ.LT.11) IREQ = IREQ-1 11990 IF(IREQ.EQ.18) IREQ = 10 12000 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 120101 12020C**** CLOSE FILE AND RETURN 120301 12040 950 CONTINUE 12050 CALL CLOSFL( REQ1,ISTAT ) 12060 IOPN = 0 12070 RETURN 12080 END 12090 END/ 12100ICKGRP DCK/ I=13,H 12110ICKGRP HOL/ 12120 INTEGER FUNCTION ICKGRP( GRPBUF,IALL,REC,IPOS ) 12130 1 /CCS3.0 SUBROUTINE ICKGRP SL-XXX 121401 12150C** CYBERCREDIT FINANCIAL SERVICES. 12160C** CYBERCREDIT FIELD SUPPORT GROUPS 12170C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 12180C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 12190C** 12200C** ************ 04/06/84 ************ PROGRAMMER : RWE 122101 12220C**** PROGRAM DESCRIPTION : VALIDATE RECORD FOR MATCH OF ACCT GROUP 122301 12240C*** CALLING SEQUENCE : 12250C ITF = ICKGRP( GRPBUF,IALL,REC,IPOS ) 12260C OR... IF ( ICKGRP( GRPBUF,IALL,REC,IPOS ).EQ. 1 ) GO TO 122701 12280C PARAMETERS 122901 12300C ICKGRP : RETURNED VALUE OF 0 = TRUE, OK TO USE RECORD 12310C 1 = FALSE, DON'T USE RECORD 12320C GRPBUF : 10 WORD ARRAY PASSED, CONTAINING VALID GROUPS 12330C ( BUILT BY SUBROUTINE 'GETGRP' ) 12340C IALL : PASSED FLAG DESIGNATING 12350C 0 = USE ALL ACCOUNT GROUPS ( FORCE ICKGRP TO TRUE ) 12360C 1 = LOOK FOR MATCH OF GROUP FROM RECORD, IN THE 12370C GRPBUF ARRAY 12380C REC : PASSED BUFFER OF RECORD CONTAING ACCT GROUP. 12390C IPOS : STARTING BYTE POS. IN REC OF ACCOUNT GROUP 124001 12410 INTEGER GRPBUF(1),IALL,REC(1),IPOS,TRUE,FALSE 124201 12430 DATA TRUE / 0/, FALSE / 1/ 124401 12450C**** 12460C**** BEGIN PROGRAM ....... 124701 12480 ICKGRP = TRUE 12490 IF ( IALL.EQ.0 ) GO TO 900 125001 12510 CALL CCSGET( REC,IPOS,IGRP ) 125201 12530 DO 200 I = 1,10 12540 J = I*2-1 12550 CALL CCSGET( GRPBUF,J,ICH ) 125601 12570 IF( ICH.EQ.$FF ) GO TO 800 12580 IF( ICH.EQ.IGRP ) GO TO 900 12590 200 CONTINUE 126001 12610C*** NO MATCH SET ICKGRP TO FALSE 126201 12630 800 CONTINUE 12640 ICKGRP = FALSE 12650 GO TO 900 126601 12670 900 RETURN 12680 END 12690 END/ 12700INTGR DCK/ I,H 12710R9FLDL DCK/ I,H 12720R9BASE DCK/ I,H 12730 END/ 12740*REW,7 12750*K,I7,P21,L14 12760*FTN 12770*EOF 12780*CLOSE 12790*K,I13,L14 12800*Z 12810*Z 12820__ IF( ICH.EQ.$FF ) GO TO 800 12580 IF( ICH.EQ.IGRP ) GO TO 900 12590 200 CONTINUE 126001 12610C*** NO MATCH SET ICKGRP TO FALSE 126201 12630 800 CONTINUE 12640 ICKGRP = FALSE 12650 GO TO 900 126601 12670 900 RETURN 12680 END 12690 END/ 12700INTGR DCK/ I,H 12710R9FLDL DCK/ I,H 12720R9BASE DCK/ I,H 12730 END/ 12740*REW,7 12750(r1@ @TFCOLCHGCCS149 P( PROGRAM COLCHG 00010 1 /CCS3.0 COLLECTOR CHANGES REPORT SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/27/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : THIS PROGRAM PRODUCES THE NON FINANCIAL 00110C CHANGES REPORT. LISTING ALL CHANGES MADE BY COLLECTORS, 00120C CLERICAL, AND SUPERVISORS. 001301 00140 EXTERNAL FMRDEL,FMEOFC 00150 INTEGER FMRDEL,FDEL,FMEOFC,FEOF 001601 00170 INTEGER DAT1(15),LD1(4),REQ1(24),R1KY(15),REC1(0072) 001801 00190 INTEGER UTFILE(4),SYPFIL(4) 00200 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 002101 00220 EQUIVALENCE ( REQ1(15), NUMRD ) 00230 INTEGER HEAD(18) 002401 00250 DATA HEAD/$0D0A,$0A17,'EXECUTING COLCHG ',$0F16/ 00260 DATA DAT1 /'LATRNSFLLA ',00,01,00/,REQ1/24*0/ 002701 00280 DATA LD1/'TRNSFL '/ 002901 00300 INTEGER USER(4),GRPBUF(10),DATE(3),HDR(20,3) 00310 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 00320 +, IPAGE,DLTREC(40),AEND(2),ALL(2) 00330 +, SVQID(2),MNUPRO(3) 00340 +, SVAN(08),T1(4),T2(4),T3(5) 003501 00360 DATA PLU/12/,IPAGE/0/,AEND/'END '/,ALL/'ALL '/ 00370 +, SVQID/2*$FFFF/,IDUN/0/,IFOUND/0/ 00380 +, IHMS/0/,IWAY/3/,MNUPRO/'MNUPRO'/,IMODE/3/ 00390 +, SVAN/8*0/,T1/'BORROWER'/,T2/'COSIGNER'/,T3/'SUPERVISOR'/ 004001 00410 INTEGER TEMP(10),A00(6),A01(6),RTOT(6),STOT(6) 00420 +, TOT14(7),APAGE(6) 004301 00440 DATA A00 /'000000000000'/, A01 /'000000000001'/ 00450 +, RTOT/'000000000000'/, STOT/'000000000000'/ 00460 +, APAGE/'000000000000'/,TOT14/'00000000000000'/ 004701 00480C**** SYSPRT PARAMETERS........ 004901 00500 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 005101 00520 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 00530 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 00540 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 005501 00560 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 005701 00580C**** SCREEN INPUT AND OUTPUT BUFFERS 00590 INTEGER INP(41),MSGEOF(09) 006001 00610 DATA MSGEOF/'- END OF REPORT - '/ 006201 00630 INTEGER L01(66),L02(66),L03(66),L04(66),L05(66),L06(66) 00640 +, L08(66),L14(66) 006501 00660C POS. 01 +------------------ THRU ------------------+ 44 00670 DATA L01/'1---------- HDR1 GOES HERE -------------- ' 00680 +, ' COLLECTOR CHANGES REPORT ' 00690 +, ' PAGE '/ 007001 00710C POS. 01 +------------------ THRU ------------------+ 44 00720 DATA L02/' ---------- HDR2 GOES HERE -------------- ' 00730 +, ' AS OF: ' 00740 +, ' '/ 007501 00760C POS. 01 +------------------ THRU ------------------+ 44 00770 DATA L03/' ---------- HDR3 GOES HERE -------------- ' 00780 +, ' ' 00790 +, ' '/ 008001 00810C POS. 01 +------------------ THRU ------------------+ 44 00820 DATA L04/' ' 00830 +, ' ' 00840 +, ' '/ 008501 00860C POS. 01 +------------------ THRU ------------------+ 44 00870 DATA L05/' COLLECTOR: ' 00880 +, ' QUEUES: ' 00890 +, ' '/ 009001 00910C POS. 01 +------------------ THRU ------------------+ 44 00920 DATA L06/' ACCOUNT NUMBER FIELD #/SCREEN ' 00930 +, ' NEW DATA OLD' 00940 +, ' DATA '/ 009501 00960C POS. 01 +------------------ THRU ------------------+ 44 00970 DATA L08/' : : : ' 00980 +, ' ' 00990 +, ' '/ 010001 01010C POS. 01 +------------------ THRU ------------------+ 44 01020 DATA L14/' **COLCHG** ERROR IN FILE : XXXXXXXX ' 01030 +, ' RUN ABORTED ********** ' 01040 +, ' '/ 010501 01060C**** 01070C**** BEGIN PROGRAM ....... 010801 01090C**** GET RECORD DELETE CODE AND END OF FILE CODE. 01100 ASSEM $C000,FMRDEL,$6800,FDEL 01110 ASSEM $C000,FMEOFC,$6800,FEOF 011201 01130C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 011401 01150 CALL PGMIN ( USER,LU,MODE,NPORT ) 011601 01170C*** CCS/LA LOOK-ALIKE..... 011801 01190 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 01200 IF ( ICM.EQ.0 ) GO TO 5 01210 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 01220 5 CONTINUE 012301 01240 CALL CCSMVA( USER,1,8,HEAD,23,8 ) 01250 CALL WTREAD( LU,-1,HEAD,36,0,0,0,ITC ) 01260 CALL UTHEAD( HDR,DATE ) 012701 01280 CALL GTSYSP( IWAY, 13 ) 01290 CALL GTSYSP( IMODE, 14 ) 01300 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01310 CALL GETGRP( GRPBUF,IALL,IMODE ) 013201 01330C**** OPEN FILES AND GET UTIFIL RECORDS 013401 01350 CALL SYSPRT( L01,0,SYSPRM,0 ) 01360 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01370 IF( ISERR.LT.0 ) GO TO 9820 013801 01390 CALL OPENFL( REQ1,DAT1,ISTAT ) 01400 IF ( ISTAT.LT.0 ) GO TO 9800 01410 REQ1(23) = 1 014201 01430C*** MOVE IN HEADERS AND SYSTEM DATE.... 014401 01450 CALL EDIT( DATE,1,L02,70,1) 01460C--- CALL CCSTIM( L02(40) ) 01470 CALL CCSMVA( HDR(01,01),1,40,L01,2,40 ) 01480 CALL CCSMVA( HDR(01,02),1,40,L02,2,40 ) 01490 CALL CCSMVA( HDR(01,03),1,40,L03,2,40 ) 01500 IF(NPORT.NE.0 .AND. IPF.NE.1) CALL CCSPUT( $0C,1,L01 ) 015101 01520 180 CONTINUE 015301 01540C**** RETRIEVE RECORDS....... AND PROCESS 015501 01560 200 CONTINUE 01570 IOF = 0 01580 CALL GETS( REQ1,REC1,R1KY,ISTAT ) 01590 IF( AND(ISTAT,$100).EQ.$100 ) IOF = 1 01600 IF( AND(ISTAT,$8100).EQ.$8100) GO TO 440 01610 IF( ISTAT.LT.0 ) GO TO 9800 016201 01630 220 CONTINUE 01640 DO 400 J = 1, NUMRD 01650C----- REMEMBER TO ADJUST CALC FOR RECORD SIZE (WORDS) 01660 IP = J *69 -68 016701 01680 IF(REC1(IP).EQ.FDEL) GO TO 400 01690 IF(REC1(IP).EQ.FEOF) GO TO 400 017001 01710 JJ = IP+14 01720 IF ( REC1(JJ).NE.$3032 ) GO TO 400 017301 01740C*** CHECK IF OK TO USE THIS ACCOUNT GROUP....... 017501 01760 IF (ICKGRP(GRPBUF,IALL,REC1(IP),1).EQ.1 )GO TO 400 017701 01780 230 CONTINUE 01790 CALL CCSCST(REC1(IP),17,4,SVQID,1,4,ICM) 01800 IF( ICM.EQ.0 ) GO TO 260 018101 01820C*** NEW COID PRINT BREAKS AND HEADINGS 01830 240 CONTINUE 01840 IF (IPAGE.EQ.0) GO TO 250 018501 01860 CALL SYSPRT( L04,1,SYSPRM,0 ) 01870 IBRK = 0 01880 SVAN = -1 01890 CALL CCSMVA(A00,1,12,STOT,1,12) 01900 IF(IDUN.EQ.1) GO TO 440 01910 CALL CCSMVA(REC1(IP),17,4,SVQID,1,4) 019201 019301 01940C**** OUTPUT HEADER INFO........... 019501 01960 250 CONTINUE 01970 NLINE = 0 01980 IPAGE = IPAGE+1 01990 CALL CCSMVA( REC1(IP),17,4,SVQID,1,4 ) 020001 02010 CALL GETUTI( SVQID,DLTREC,IFOUND,IFER,0 ) 02020 IF( IFER.LT.0 ) GO TO 9820 02030 IF( IFOUND.NE.0 ) CALL CCSMVA( SVQID,1,4,DLTREC,5,74 ) 020401 02050 CALL CCSMVA( DLTREC,20,1,L05,21,1 ) 02060 CALL CCSMVA( DLTREC,5,15,L05,24,15 ) 02070 CALL EDIT ( DLTREC,22,L05,38,4 ) 02080 CALL CCSMVA( DLTREC,32,4,L05,51,4 ) 02090 CALL CCSMVA( DLTREC,41,4,L05,064,4 ) 02100 CALL CCSMVA( DLTREC,45,4,L05,070,4 ) 02110 CALL CCSMVA( DLTREC,49,4,L05,076,4 ) 02120 CALL CCSMVA( DLTREC,53,4,L05,082,4 ) 02130 CALL CCSMVA( DLTREC,57,4,L05,088,4 ) 02140 CALL CCSMVA( DLTREC,61,4,L05,094,4 ) 02150 CALL CCSMVA( DLTREC,65,4,L05,100,4 ) 02160 CALL CCSMVA( DLTREC,69,4,L05,106,4 ) 021701 02180 CALL CCSADD( A01,4,APAGE,1,APAGE,1) 02190 CALL CCSMVA( APAGE,1,12,TOT14,1,12 ) 02200 CALL EDIT ( TOT14,6,TEMP,1,3 ) 02210 CALL CCSMVA(TEMP,3,5,L01,124,5) 022201 02230 CALL SYSPRT( L01,1,SYSPRM,0 ) 02240 CALL SYSPRT( L02,1,SYSPRM,0 ) 02250 CALL SYSPRT( L03,1,SYSPRM,0 ) 02260 CALL SYSPRT( L04,1,SYSPRM,0 ) 02270 IF(IDUN.EQ.1) GO TO 450 02280 CALL SYSPRT( L05,1,SYSPRM,0 ) 02290 CALL SYSPRT( L04,1,SYSPRM,0 ) 02300 CALL SYSPRT( L06,1,SYSPRM,0 ) 02310 CALL SYSPRT( L04,1,SYSPRM,0 ) 023201 02330C**** OUTPUT RECORD INFO.......... 023401 02350 260 CONTINUE 02360 IF ( NLINE.GE.58 ) GO TO 250 023701 02380 CALL CCSCST( REC1(IP),1,16,SVAN,1,16,ICM ) 02390 IF ( ICM.NE.0 ) GO TO 265 024001 02410 CALL CCSMVA( REC1(IP),1,0,REC1(IP),1,16 ) 02420 GO TO 270 024301 02440 265 CONTINUE 02450 CALL CCSMVA( REC1(IP),1,16,SVAN,1,16 ) 02460 CALL CCSADD(A01,4,STOT,1,STOT,1) 024701 02480 270 CONTINUE 02490 IBRK = 1 02500 CALL CCSGET( REC1(IP),134,IA ) 02510 CALL CCSMVA( L08,1,0,L08,1,132 ) 025201 02530 CALL CCSMVA( REC1(IP),1,16,L08,04,16) 02540 CALL CCSMVA( REC1(IP),33,30,L08,52,30 ) 02550 CALL CCSMVA( REC1(IP),63,30,L08,86,30 ) 02560 CALL CCSGET( REC1(IP),31,IA ) 02570 IA = IA - $30 02580 IB = 0 02590 IF( IA.GE.3 ) IB = $300 02600 IF( IA.GE.6 ) IB = $600 02610 IF( IA.GE.9 ) IB = 0 02620 REC1(16) = REC1(16)-IB 02630 CALL CCSMVA( REC1(IP),31,2,L08,30,2 ) 02640 CALL CCSMVA( T1,1,8,L08,35,10 ) 02650 IF( IA.GE.9 ) CALL CCSMVA( L08,1,0,L08,35,10 ) 02660 IF( IB.EQ.$300 ) CALL CCSMVA( T2,1,8,L08,35,10 ) 02670 IF( IB.EQ.$600 ) CALL CCSMVA( T3,1,10,L08,35,10 ) 026801 02690 CALL SYSPRT( L08,1,SYSPRM,0 ) 027001 02710C*** NOW UPDATE COLLECTOR STATS... 027201 02730 300 CONTINUE 027401 02750 400 CONTINUE 02760 IF( ISERR.LT.0 ) GO TO 9900 02770 420 CONTINUE 02780 IF (IOF.NE.1) GO TO 200 02790 440 CONTINUE 02800 IDUN = 1 02810 IF(IBRK.EQ.1) GO TO 240 028201 02830C*** SET UP AND PRINT FINAL PAGE OF REPORT..... 028401 02850 GO TO 250 028601 02870 450 CONTINUE 028801 02890 CALL SYSPRT( L04,20,SYSPRM,0 ) 02900 CALL CCSMVA( MSGEOF,1,18,L04,57,18 ) 02910 CALL SYSPRT( L04,01,SYSPRM,0 ) 02920 GO TO 9900 029301 02940C**** ERROR SECTION FILE 1 02950 9800 CONTINUE 02960 IREQ = AND(REQ1(4),$FF) 02970 IF (IREQ.LT.11) IREQ = IREQ-1 02980 IF (IREQ.EQ.18) IREQ = 10 02990 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 03000 CALL CCSMVA( DAT1,1,8,L14,32,8 ) 03010 IERR = 1 03020 GO TO 9900 030301 03040C**** ERROR SECTION FILE 3 03050 9820 CONTINUE 03060 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 03070 IERR = 1 03080 GO TO 9900 030901 03100C**** CLOSE THE FILES AND EXIT........ 03110 9900 CONTINUE 03120 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 031301 03140 CALL CLOSFL( REQ1,ISTAT ) 03150 CALL GETUTI( SVQID,DLTREC,IFOUND,IFER,2 ) 03160 CALL SYSPRT( L04,0,SYSPRM,1 ) 031701 03180 CALL PGMOUT 03190 END 03200__0 CONTINUE 02960 IREQ = AND(REQ1(4),$FF) 02970 IF (IREQ.LT.11) IREQ = IREQ-1 02980 IF (IREQ.EQ.18) IREQ = 10 02990 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 03000(u D CJ.COLCHGCCS149 P(*JOB,,TWB.JOB COLCHG INSTALL 08/23/84 00010*K,L14 00020*CTO, COLCHG WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.COLCHG , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.COLCHG,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120COLCHG DCK/ I=13,H 00130COLCHG HOL/ 00140 PROGRAM COLCHG 00150 1 /CCS3.0 COLLECTOR CHANGES REPORT SL-XXX 001601 00170C** CYBERCREDIT FINANCIAL SERVICES. 00180C** CYBERCREDIT FIELD SUPPORT GROUPS 00190C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00200C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00210C** 00220C** ************ 04/27/84 ************ PROGRAMMER : RWE 002301 00240C**** PROGRAM DESCRIPTION : THIS PROGRAM PRODUCES THE NON FINANCIAL 00250C CHANGES REPORT. LISTING ALL CHANGES MADE BY COLLECTORS, 00260C CLERICAL, AND SUPERVISORS. 002701 00280 EXTERNAL FMRDEL,FMEOFC 00290 INTEGER FMRDEL,FDEL,FMEOFC,FEOF 003001 00310 INTEGER DAT1(15),LD1(4),REQ1(24),R1KY(15),REC1(0072) 003201 00330 INTEGER UTFILE(4),SYPFIL(4) 00340 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 003501 00360 EQUIVALENCE ( REQ1(15), NUMRD ) 00370 INTEGER HEAD(18) 003801 00390 DATA HEAD/$0D0A,$0A17,'EXECUTING COLCHG ',$0F16/ 00400 DATA DAT1 /'LATRNSFLLA ',00,01,00/,REQ1/24*0/ 004101 00420 DATA LD1/'TRNSFL '/ 004301 00440 INTEGER USER(4),GRPBUF(10),DATE(3),HDR(20,3) 00450 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 00460 +, IPAGE,DLTREC(40),AEND(2),ALL(2) 00470 +, SVQID(2),MNUPRO(3) 00480 +, SVAN(08),T1(4),T2(4),T3(5) 004901 00500 DATA PLU/12/,IPAGE/0/,AEND/'END '/,ALL/'ALL '/ 00510 +, SVQID/2*$FFFF/,IDUN/0/,IFOUND/0/ 00520 +, IHMS/0/,IWAY/3/,MNUPRO/'MNUPRO'/,IMODE/3/ 00530 +, SVAN/8*0/,T1/'BORROWER'/,T2/'COSIGNER'/,T3/'SUPERVISOR'/ 005401 00550 INTEGER TEMP(10),A00(6),A01(6),RTOT(6),STOT(6) 00560 +, TOT14(7),APAGE(6) 005701 00580 DATA A00 /'000000000000'/, A01 /'000000000001'/ 00590 +, RTOT/'000000000000'/, STOT/'000000000000'/ 00600 +, APAGE/'000000000000'/,TOT14/'00000000000000'/ 006101 00620C**** SYSPRT PARAMETERS........ 006301 00640 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 006501 00660 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 00670 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 00680 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 006901 00700 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 007101 00720C**** SCREEN INPUT AND OUTPUT BUFFERS 00730 INTEGER INP(41),MSGEOF(09) 007401 00750 DATA MSGEOF/'- END OF REPORT - '/ 007601 00770 INTEGER L01(66),L02(66),L03(66),L04(66),L05(66),L06(66) 00780 +, L08(66),L14(66) 007901 00800C POS. 01 +------------------ THRU ------------------+ 44 00810 DATA L01/'1---------- HDR1 GOES HERE -------------- ' 00820 +, ' COLLECTOR CHANGES REPORT ' 00830 +, ' PAGE '/ 008401 00850C POS. 01 +------------------ THRU ------------------+ 44 00860 DATA L02/' ---------- HDR2 GOES HERE -------------- ' 00870 +, ' AS OF: ' 00880 +, ' '/ 008901 00900C POS. 01 +------------------ THRU ------------------+ 44 00910 DATA L03/' ---------- HDR3 GOES HERE -------------- ' 00920 +, ' ' 00930 +, ' '/ 009401 00950C POS. 01 +------------------ THRU ------------------+ 44 00960 DATA L04/' ' 00970 +, ' ' 00980 +, ' '/ 009901 01000C POS. 01 +------------------ THRU ------------------+ 44 01010 DATA L05/' COLLECTOR: ' 01020 +, ' QUEUES: ' 01030 +, ' '/ 010401 01050C POS. 01 +------------------ THRU ------------------+ 44 01060 DATA L06/' ACCOUNT NUMBER FIELD #/SCREEN ' 01070 +, ' NEW DATA OLD' 01080 +, ' DATA '/ 010901 01100C POS. 01 +------------------ THRU ------------------+ 44 01110 DATA L08/' : : : ' 01120 +, ' ' 01130 +, ' '/ 011401 01150C POS. 01 +------------------ THRU ------------------+ 44 01160 DATA L14/' **COLCHG** ERROR IN FILE : XXXXXXXX ' 01170 +, ' RUN ABORTED ********** ' 01180 +, ' '/ 011901 01200C**** 01210C**** BEGIN PROGRAM ....... 012201 01230C**** GET RECORD DELETE CODE AND END OF FILE CODE. 01240 ASSEM $C000,FMRDEL,$6800,FDEL 01250 ASSEM $C000,FMEOFC,$6800,FEOF 012601 01270C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 012801 01290 CALL PGMIN ( USER,LU,MODE,NPORT ) 013001 01310C*** CCS/LA LOOK-ALIKE..... 013201 01330 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 01340 IF ( ICM.EQ.0 ) GO TO 5 01350 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 01360 5 CONTINUE 013701 01380 CALL CCSMVA( USER,1,8,HEAD,23,8 ) 01390 CALL WTREAD( LU,-1,HEAD,36,0,0,0,ITC ) 01400 CALL UTHEAD( HDR,DATE ) 014101 01420 CALL GTSYSP( IWAY, 13 ) 01430 CALL GTSYSP( IMODE, 14 ) 01440 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01450 CALL GETGRP( GRPBUF,IALL,IMODE ) 014601 01470C**** OPEN FILES AND GET UTIFIL RECORDS 014801 01490 CALL SYSPRT( L01,0,SYSPRM,0 ) 01500 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01510 IF( ISERR.LT.0 ) GO TO 9820 015201 01530 CALL OPENFL( REQ1,DAT1,ISTAT ) 01540 IF ( ISTAT.LT.0 ) GO TO 9800 01550 REQ1(23) = 1 015601 01570C*** MOVE IN HEADERS AND SYSTEM DATE.... 015801 01590 CALL EDIT( DATE,1,L02,70,1) 01600C--- CALL CCSTIM( L02(40) ) 01610 CALL CCSMVA( HDR(01,01),1,40,L01,2,40 ) 01620 CALL CCSMVA( HDR(01,02),1,40,L02,2,40 ) 01630 CALL CCSMVA( HDR(01,03),1,40,L03,2,40 ) 01640 IF(NPORT.NE.0 .AND. IPF.NE.1) CALL CCSPUT( $0C,1,L01 ) 016501 01660 180 CONTINUE 016701 01680C**** RETRIEVE RECORDS....... AND PROCESS 016901 01700 200 CONTINUE 01710 IOF = 0 01720 CALL GETS( REQ1,REC1,R1KY,ISTAT ) 01730 IF( AND(ISTAT,$100).EQ.$100 ) IOF = 1 01740 IF( AND(ISTAT,$8100).EQ.$8100) GO TO 440 01750 IF( ISTAT.LT.0 ) GO TO 9800 017601 01770 220 CONTINUE 01780 DO 400 J = 1, NUMRD 01790C----- REMEMBER TO ADJUST CALC FOR RECORD SIZE (WORDS) 01800 IP = J *69 -68 018101 01820 IF(REC1(IP).EQ.FDEL) GO TO 400 01830 IF(REC1(IP).EQ.FEOF) GO TO 400 018401 01850 JJ = IP+14 01860 IF ( REC1(JJ).NE.$3032 ) GO TO 400 018701 01880C*** CHECK IF OK TO USE THIS ACCOUNT GROUP....... 018901 01900 IF (ICKGRP(GRPBUF,IALL,REC1(IP),1).EQ.1 )GO TO 400 019101 01920 230 CONTINUE 01930 CALL CCSCST(REC1(IP),17,4,SVQID,1,4,ICM) 01940 IF( ICM.EQ.0 ) GO TO 260 019501 01960C*** NEW COID PRINT BREAKS AND HEADINGS 01970 240 CONTINUE 01980 IF (IPAGE.EQ.0) GO TO 250 019901 02000 CALL SYSPRT( L04,1,SYSPRM,0 ) 02010 IBRK = 0 02020 SVAN = -1 02030 CALL CCSMVA(A00,1,12,STOT,1,12) 02040 IF(IDUN.EQ.1) GO TO 440 02050 CALL CCSMVA(REC1(IP),17,4,SVQID,1,4) 020601 020701 02080C**** OUTPUT HEADER INFO........... 020901 02100 250 CONTINUE 02110 NLINE = 0 02120 IPAGE = IPAGE+1 02130 CALL CCSMVA( REC1(IP),17,4,SVQID,1,4 ) 021401 02150 CALL GETUTI( SVQID,DLTREC,IFOUND,IFER,0 ) 02160 IF( IFER.LT.0 ) GO TO 9820 02170 IF( IFOUND.NE.0 ) CALL CCSMVA( SVQID,1,4,DLTREC,5,74 ) 021801 02190 CALL CCSMVA( DLTREC,20,1,L05,21,1 ) 02200 CALL CCSMVA( DLTREC,5,15,L05,24,15 ) 02210 CALL EDIT ( DLTREC,22,L05,38,4 ) 02220 CALL CCSMVA( DLTREC,32,4,L05,51,4 ) 02230 CALL CCSMVA( DLTREC,41,4,L05,064,4 ) 02240 CALL CCSMVA( DLTREC,45,4,L05,070,4 ) 02250 CALL CCSMVA( DLTREC,49,4,L05,076,4 ) 02260 CALL CCSMVA( DLTREC,53,4,L05,082,4 ) 02270 CALL CCSMVA( DLTREC,57,4,L05,088,4 ) 02280 CALL CCSMVA( DLTREC,61,4,L05,094,4 ) 02290 CALL CCSMVA( DLTREC,65,4,L05,100,4 ) 02300 CALL CCSMVA( DLTREC,69,4,L05,106,4 ) 023101 02320 CALL CCSADD( A01,4,APAGE,1,APAGE,1) 02330 CALL CCSMVA( APAGE,1,12,TOT14,1,12 ) 02340 CALL EDIT ( TOT14,6,TEMP,1,3 ) 02350 CALL CCSMVA(TEMP,3,5,L01,124,5) 023601 02370 CALL SYSPRT( L01,1,SYSPRM,0 ) 02380 CALL SYSPRT( L02,1,SYSPRM,0 ) 02390 CALL SYSPRT( L03,1,SYSPRM,0 ) 02400 CALL SYSPRT( L04,1,SYSPRM,0 ) 02410 IF(IDUN.EQ.1) GO TO 450 02420 CALL SYSPRT( L05,1,SYSPRM,0 ) 02430 CALL SYSPRT( L04,1,SYSPRM,0 ) 02440 CALL SYSPRT( L06,1,SYSPRM,0 ) 02450 CALL SYSPRT( L04,1,SYSPRM,0 ) 024601 02470C**** OUTPUT RECORD INFO.......... 024801 02490 260 CONTINUE 02500 IF ( NLINE.GE.58 ) GO TO 250 025101 02520 CALL CCSCST( REC1(IP),1,16,SVAN,1,16,ICM ) 02530 IF ( ICM.NE.0 ) GO TO 265 025401 02550 CALL CCSMVA( REC1(IP),1,0,REC1(IP),1,16 ) 02560 GO TO 270 025701 02580 265 CONTINUE 02590 CALL CCSMVA( REC1(IP),1,16,SVAN,1,16 ) 02600 CALL CCSADD(A01,4,STOT,1,STOT,1) 026101 02620 270 CONTINUE 02630 IBRK = 1 02640 CALL CCSGET( REC1(IP),134,IA ) 02650 CALL CCSMVA( L08,1,0,L08,1,132 ) 026601 02670 CALL CCSMVA( REC1(IP),1,16,L08,04,16) 02680 CALL CCSMVA( REC1(IP),33,30,L08,52,30 ) 02690 CALL CCSMVA( REC1(IP),63,30,L08,86,30 ) 02700 CALL CCSGET( REC1(IP),31,IA ) 02710 IA = IA - $30 02720 IB = 0 02730 IF( IA.GE.3 ) IB = $300 02740 IF( IA.GE.6 ) IB = $600 02750 IF( IA.GE.9 ) IB = 0 02760 REC1(16) = REC1(16)-IB 02770 CALL CCSMVA( REC1(IP),31,2,L08,30,2 ) 02780 CALL CCSMVA( T1,1,8,L08,35,10 ) 02790 IF( IA.GE.9 ) CALL CCSMVA( L08,1,0,L08,35,10 ) 02800 IF( IB.EQ.$300 ) CALL CCSMVA( T2,1,8,L08,35,10 ) 02810 IF( IB.EQ.$600 ) CALL CCSMVA( T3,1,10,L08,35,10 ) 028201 02830 CALL SYSPRT( L08,1,SYSPRM,0 ) 028401 02850C*** NOW UPDATE COLLECTOR STATS... 028601 02870 300 CONTINUE 028801 02890 400 CONTINUE 02900 IF( ISERR.LT.0 ) GO TO 9900 02910 420 CONTINUE 02920 IF (IOF.NE.1) GO TO 200 02930 440 CONTINUE 02940 IDUN = 1 02950 IF(IBRK.EQ.1) GO TO 240 029601 02970C*** SET UP AND PRINT FINAL PAGE OF REPORT..... 029801 02990 GO TO 250 030001 03010 450 CONTINUE 030201 03030 CALL SYSPRT( L04,20,SYSPRM,0 ) 03040 CALL CCSMVA( MSGEOF,1,18,L04,57,18 ) 03050 CALL SYSPRT( L04,01,SYSPRM,0 ) 03060 GO TO 9900 030701 03080C**** ERROR SECTION FILE 1 03090 9800 CONTINUE 03100 IREQ = AND(REQ1(4),$FF) 03110 IF (IREQ.LT.11) IREQ = IREQ-1 03120 IF (IREQ.EQ.18) IREQ = 10 03130 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 03140 CALL CCSMVA( DAT1,1,8,L14,32,8 ) 03150 IERR = 1 03160 GO TO 9900 031701 03180C**** ERROR SECTION FILE 3 03190 9820 CONTINUE 03200 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 03210 IERR = 1 03220 GO TO 9900 032301 03240C**** CLOSE THE FILES AND EXIT........ 03250 9900 CONTINUE 03260 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 032701 03280 CALL CLOSFL( REQ1,ISTAT ) 03290 CALL GETUTI( SVQID,DLTREC,IFOUND,IFER,2 ) 03300 CALL SYSPRT( L04,0,SYSPRM,1 ) 033101 03320 CALL PGMOUT 03330 END 03340 END/ 03350GTSYSP DCK/ I=13,H 03360GTSYSP HOL/ 03370 SUBROUTINE GTSYSP( IPARM,IPOS ) 03380 1 /CCS3.0 SUBROUTINE GTSYSP SL-XXX 033901 03400C** CYBERCREDIT FINANCIAL SERVICES. 03410C** CYBERCREDIT FIELD SUPPORT GROUPS 03420C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 03430C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 03440C** 03450C** ************ 04/06/84 ************ PROGRAMMER : RWE 034601 03470C**** PROGRAM DESCRIPTION : GET SYSTEM PARAMETER FROM THE 03480C EXTERNAL FLAG RECORD IN THE UTIFIL. 034901 03500C*** CALLING SEQUENCE : CALL GTSYSP( IPARM,IPOS ) 035101 03520C PARAMETERS 035301 03540C IPARM : RETURNED VALUE ($0 TO $F WHICH IS 0 TO 15 DECIMAL) 03550C WHICH IS RETRIEVED FROM THE 'EXTERNAL FLAG RECORD' 03560C IN THE UTIFIL. 03570C IPOS : THE STARTING BYTE OF THE FLAG IN THE FLAG RECORD. 03580C ( SEE LAYOUT OF 'EXTERNAL FLAG RECORD' ) 035901 03600C EXAMPLE : CALL GTSYSP( IMODE,30 ) 03610C THIS WOULD RETRIEVE THE FLAG 2 FOR THE 03620C LTRSTA PROGRAM AND SET THE IMODE FLAG FOR 03630C SUBROUTINE GETGRP 03640C LTRSTA FLAGS START IN POS. 29, THERE ARE 4 FLAGS 03650C FLAG 1 = IWAY FOR SUBROUTINE PRTORF 03660C FLAG 2 = IMODE FOR SUBROUTINE GETGRP 03670C FLAG 3 = 03680C FLAG 4 = 036901 03700 INTEGER IPARM,IPOS 03710 +, SYSREC(42),SYSP(2),IGOT 037201 03730 DATA SYSP /'SYSP'/, IGOT / 0/ 037401 03750C**** 03760C**** BEGIN PROGRAM ....... 037701 03780 IF ( IGOT.NE.0 ) GO TO 100 03790 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 03800 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 03810 IGOT = 1 038201 03830 100 CONTINUE 03840 CALL CCSGET( SYSREC,IPOS,IFLG ) 038501 03860 IPARM = AND( IFLG,$F ) 03870 RETURN 03880 END 03890 END/ 03900GETUTI DCK/ I=13,H 03910GETUTI HOL/ 03920 SUBROUTINE GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 03930 1 /CCS3.0 SUBROUTINE GETUTI SL-XXX 039401 03950C** CYBERCREDIT FINANCIAL SERVICES. 03960C** CYBERCREDIT FIELD SUPPORT GROUPS 03970C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 03980C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 03990C** 04000C** ************ 04/06/84 ************ PROGRAMMER : RWE 040101 04020C**** PROGRAM DESCRIPTION : RETRIEVE RECORD BY KEY FROM UTIFIL. 040301 04040C*** CALLING SEQUENCE : CALL GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 040501 04060C PARAMETERS 040701 04080C KEYB : KEY OF UTIFIL RECORD TO BE RETRIEVED ( 2 WORDS ) 04090C REC : BUFFER TO RECIEVE THE RETRIEVED RECORD(40 WORDS ) 04100C BUFFER WILL BE BLANKS IF RECORD IS NOT FOUND. 04110C IFOUND : RETURNED VALUE DESIGNATING IF RECORD WAS FOUND. 04120C 0 = RECORD FOUND , 1 = RECORD NOT FOUND 04130C IFER : ISTAT OF FILE MANAGER CALL. (FROM UTIFIL) 04140C NOPT : PASSED. OPTION OF WHAT TO DO. 04150C 0 = RETRIEVE RECORD (LEAVE FILE OPEN) 04160C 1 = RETRIEVE RECORD (CLOSE FILE WHEN DONE) 04170C 2 = CLOSE FILE. 041801 04190 INTEGER KEYB(1),REC(1),IFOUND,IFER,NOPT 04200 +, DAT1(15),REQ1(24),R1KY(15),REC1(0042) 04210 +, USER(4),LU,NPORT,MODE 042201 04230 DATA DAT1 /'LAUTIFIL ',01,01,00/,REQ1/24*0/ 04240 DATA IOPN/0/ , IDUN/0/ 042501 04260C**** 04270C**** BEGIN PROGRAM ....... 042801 04290 IF ( NOPT.EQ.2 ) GO TO 500 04300 IF ( IOPN.EQ.1 ) GO TO 100 043101 04320C*** CHECK FOR LA LOOK-ALIKE 043301 04340 IF( IDUN.EQ.1 ) GO TO 5 04350 IDUN = 1 04360 CALL PGMIN( USER,LU,MODE,NPORT ) 04370 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 04380 IF ( ICM.EQ.0 ) GO TO 5 04390 CALL CCSMVA( DAT1,3,6,DAT1,1,16 ) 044001 04410 5 CONTINUE 04420 DO 20 I = 1,24 04430 REQ1(I) = 0 04440 20 CONTINUE 044501 04460 CALL OPENFL( REQ1,DAT1,ISTAT ) 04470 IF( ISTAT.LT.0 ) GO TO 800 04480 REQ1(23) = 1 04490 IOPN = 1 045001 04510 100 CONTINUE 04520 CALL CCSMVA( KEYB,1,4,R1KY,1,30 ) 04530 CALL READR ( REQ1,REC1,R1KY,ISTAT ) 04540 IF ( AND(ISTAT,$300).NE.0 ) GO TO 200 04550 IF ( ISTAT.LT.0 ) GO TO 800 045601 04570C*** RECORD FOUND PASS INFO BACK TO CALLER 045801 04590 120 CONTINUE 04600 IFER = ISTAT 04610 IFOUND = 0 04620 CALL CCSMVA( REC1,1,80,REC,1,80 ) 04630 IF( NOPT.EQ.1 ) GO TO 500 04640 GO TO 900 046501 04660C**** RECORD NOT FOUND RETURN BLANKS 046701 04680 200 CONTINUE 04690 IFER = AND( ISTAT,$7FFF ) 04700 IFOUND = 1 04710 CALL CCSMVA( REC1,1,0,REC,1,40 ) 04720 IF( NOPT.EQ.1 ) GO TO 500 04730 GO TO 900 047401 04750C**** CLOSE FILE AND RETURN 047601 04770 500 CONTINUE 04780 CALL CLOSFL( REQ1,ISTAT ) 04790 IOPN = 0 04800 GO TO 900 048101 04820C**** ERROR SECTION FOR FILE 048301 04840 800 CONTINUE 04850 IFOUND = 1 04860 IFER = ISTAT 04870 IF( AND(ISTAT,$8002).EQ.$8002 ) GO TO 900 04880 IREQ = AND(REQ1(4),$FF) 04890 IF(IREQ.LT.11) IREQ = IREQ-1 04900 IF(IREQ.EQ.18) IREQ = 10 04910 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 04920 GO TO 900 049301 04940 900 CONTINUE 04950 RETURN 04960 END 04970 END/ 04980PRTORF DCK/ I=13,H 04990PRTORF HOL/ 05000 SUBROUTINE PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 05010 1 /CCS3.0 SUBROUTINE PRTORF SL-XXX 050201 05030C** CYBERCREDIT FINANCIAL SERVICES. 05040C** CYBERCREDIT FIELD SUPPORT GROUPS 05050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 05060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 05070C** 05080C** ************ 04/06/84 ************ PROGRAMMER : RWE 050901 05100C**** PROGRAM DESCRIPTION : VALIDATE OUTPUT LOGICAL UNIT AND 05110C SET DIRECTION OF OUTPUT. 051201 05130C*** CALLING SEQUENCE : CALL PRTORF( IPF,LU,NLU,NPORT,IWAY ) 051401 05150C PARAMETERS 051601 05170C IPF : RETURNED VALUE DESIGNATING OUTPUT DIRECTION. 05180C 0 = OUTPUT TO LOCIGAL UNIT 'NLU' 05190C 1 = OUTPUT TO SYSPRT FILE 05200C LU : LOGICAL UNIT NUMBER OF REQUESTED OUTPUT DEVICE. 05210C NLU : RETURNED VALUE DESIGNATING VALIDATED LOGICAL 05220C UNIT TO OUTPUT TO. 05230C NPORT : CURRENT TERMINAL # ( FROM PGMIN ) 05240C IWAY : FLAG TO DETERMINE WHICH ACTION TO TAKE : 05250C 0 = FORCE OUTPUT TO DESIGNATED LOGICAL UNIT 05260C 1 = FORCE OUTPUT TO SYSPRT FILE 05270C 2 = NOT USED AT PRESENT TIME 05280C 3 = PROMPT OPERATOR FROM SCREEN, FOR OUTPUT DIRECTION 05290C 4 = GET 'IWAY' FLAG FROM UTIFIL 053001 05310 INTEGER IPF,PLU,NLU,NPORT,IWAY 05320 +, INP(41),CRT(4),PRINT(4),TAPE(5),MSGY(18) 05330 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 053401 05350 DATA MSG1/$180A,$0A07,'** SELECT DIRECTION OF OUTPUT ',$160A/ 05360 +, MSG2/$0D0A,' 0 = OUTPUT TO LOGICAL UNIT ',$1616/ 05370 +, MSG3/$0D0A,' 1 = OUTPUT TO SYSPRT FILE ',$1616/ 05380 +, MSG4/$0D0A,' ',$160A/ 05390 +, MSG5/$0D0A,' PLEASE ENTER SELECTION (0,1) : ',$1616/ 054001 05410 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 054201 05430 DATA CRT /'TERMINAL'/, PRINT /'PRINTER '/ 05440 +, TAPE /'TAPE DRIVE'/ 054501 05460C**** BEGIN PROGRAM ....... 054701 05480 MWAY = IWAY 05490 10 CONTINUE 05500 PLU = AND( PLU,$FF ) 05510 IF ( MWAY.EQ.1 ) GO TO 200 055201 05530 NLU = PLU 05540 IF ( NPORT.NE.00 ) NLU = 05 05550 IF ( NPORT.EQ.00 .AND. NLU.EQ.05 ) NLU = 04 05560 IF ( MWAY.EQ.3 ) GO TO 300 05570 IF ( MWAY.EQ.4 ) GO TO 400 055801 05590 100 CONTINUE 05600 IPF = 0 05610 IF ( MWAY.EQ.2 ) IPF = 0 05620 GO TO 800 056301 05640C*** OUTPUT FORCED TO SYSPRT FILE...... 056501 05660 200 CONTINUE 05670 IPF = 1 05680 GO TO 800 056901 05700C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 057101 05720 300 CONTINUE 05730 IF(NLU.EQ.05.OR.NLU.EQ.04) CALL CCSMVA( CRT,1,8,MSG2,18,12 ) 05740 IF(NLU.EQ.09.OR.NLU.EQ.12) CALL CCSMVA( PRINT,1,8,MSG2,18,12 ) 05750 IF(NLU.EQ.06.OR.NLU.EQ.16) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 05760 IF(NLU.EQ.17.OR.NLU.EQ.18) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 057701 05780 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 05790 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 05800 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 05810 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 058201 05830 310 CONTINUE 05840 CALL CCSMVA(INP,1,0,INP,1,82) 05850 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 05860 IF (ITC.EQ.4) GO TO 310 058701 05880C*** VALIDATE SELECTION.... 058901 05900 CALL CCSGET( INP,1,ICH ) 059101 05920 IF( INP(41).EQ.0 ) GO TO 320 05930 IF ( ICH.LT.$30 .OR. ICH.GT.$31 ) GO TO 310 059401 05950 320 IPF = AND( ICH,$F ) 05960 IF( IPF.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 05970 IF( IPF.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 059801 05990 CALL CCSMVA(INP,1,0,INP,1,82) 06000 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 06010 CALL CCSGET(INP,1,ICH) 06020 IF ( INP(41).EQ.0 ) GO TO 330 06030 IF ( ICH.NE.$59 ) GO TO 300 06040 330 CONTINUE 06050 GO TO 800 060601 06070C**** GET 'IWAY' WHAT TO DO FLAG FROM UTIFIL... 060801 06090 400 CONTINUE 06100 CALL GTSYSP( MWAY,73 ) 06110 IF ( MWAY.LT.0 .OR. MWAY.GT.3 ) MWAY = 0 06120 GO TO 10 061301 06140 800 RETURN 06150 END 06160 END/ 06170GETGRP DCK/ I=13,H 06180GETGRP HOL/ 06190 SUBROUTINE GETGRP( GRPBUF,IALL,IMODE ) 06200 1 /CCS3.0 SUBROUTINE GETGRP SL-XXX 062101 06220C** CYBERCREDIT FINANCIAL SERVICES. 06230C** CYBERCREDIT FIELD SUPPORT GROUPS 06240C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 06250C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 06260C** 06270C** ************ 04/06/84 ************ PROGRAMMER : RWE 062801 06290C**** PROGRAM DESCRIPTION : SELECT WHICH ACCOUNT GROUPS TO USE 063001 06310C*** CALLING SEQUENCE : CALL GETGRP( GRPBUF,IALL,IMODE ) 063201 06330C PARAMETERS 063401 06350C GRPBUF : 10 WORD ARRAY RETURNED TO PROGRAM WITH FROM 1 06360C TO 10 VALID ACCOUNT GROUPS 06370C ( FOR USE WITH FUNCTION 'ICKGRP' ) 06380C IALL : FLAG RETURNED DESIGNATING USE OF ACCOUNT GROUPS 06390C 0 = USE ALL ACCOUNT GROUPS 06400C 1 = USE ONLY ACCOUNT GROUPS IN GRPBUF ARRAY 06410C IMODE : FLAG TO DETERMINE WHICH ACTION TO TAKE : 06420C 0 = USE ALL ACCOUNT GROUPS 06430C 1 = USE ACCOUNT GROUPS 0-4 ONLY 06440C 2 = USE ACCOUNT GROUPS 5-9 ONLY 06450C 3 = PROMPT FROM SCREEN, WHICH OF (0-9) GROUPS TO USE 06460C 4 = PROMPT FROM SCREEN, EITHER ALL, OR 0-4, OR 5-9. 06470C 5 = GET 'IMODE' FLAG FROM UTIFIL 064801 06490 INTEGER GRPBUF(1),IALL,IMODE 06500 +, INP(41),MSGY(18),AGRPS(10),MINUS(10),ALL 06510 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 06520 +, MSGA(18),MSGB(18),MSGC(18),MSGD(18),MSGE(18),MSGF(20) 065301 06540 DATA MSG1/$180A,$0A0D,'** SELECT ACCOUNT GROUP OPTION',$160A/ 06550 +, MSG2/$0D0A,' 0 = ALL ACCOUNT GROUPS ',$1616/ 06560 +, MSG3/$0D0A,' 1 = ACCOUNT GROUPS 0-4 ONLY ',$1616/ 06570 +, MSG4/$0D0A,' 2 = ACCOUNT GROUPS 5-9 ONLY ',$160A/ 06580 +, MSG5/$0D0A,' PLEASE ENTER SELECTION(0,1,2) :',$1616/ 065901 06600 DATA MSGA/$180A,$0A0D,'* SELECT ACCOUNT GROUPS TO USE',$160A/ 06610 +, MSGB/$0D0A,' SEPARATE GROUPS BY COMMAS, ',$1616/ 06620 +, MSGC/$0D0A,' (I.E. 0,1,2,3, ETC...) OR ',$1616/ 06630 +, MSGD/$0D0A,' ENTER A FOR ALL GROUPS ',$160A/ 06640 +, MSGE/$0D0A,' PLEASE ENTER SELECTION -- :',$1616/ 066501 06660 DATA MSGF/$180A,'INVALID ENTRY : ',$160A/ 066701 06680 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 06690 +, AGRPS/'0,1,2,3,4,5,6,7,8,9,'/,MINUS/10*$FFFF/,ALL/'A,'/ 067001 06710C**** BEGIN PROGRAM ....... 067201 06730 MODE = IMODE 06740 IALL = 0 06750 CALL CCSMVA( MINUS,1,20,GRPBUF,1,20 ) 067601 06770 10 CONTINUE 06780 IF ( MODE.EQ.0 ) GO TO 50 06790 IF ( MODE.EQ.1 ) GO TO 100 06800 IF ( MODE.EQ.2 ) GO TO 200 06810 IF ( MODE.EQ.3 ) GO TO 300 06820 IF ( MODE.EQ.4 ) GO TO 400 06830 IF ( MODE.EQ.5 ) GO TO 500 068401 06850C**** SET AND USE ALL ACCOUNT GROUPS 068601 06870 50 CONTINUE 06880 IALL = 0 06890 CALL CCSMVA( AGRPS,1,20,GRPBUF,1,20 ) 06900 GO TO 800 069101 06920C**** SET AND USE GROUPS 0-4 ONLY 069301 06940 100 CONTINUE 06950 IALL = 1 06960 CALL CCSMVA( AGRPS,1,10,GRPBUF,1,10 ) 06970 GO TO 800 069801 06990C**** SET AND USE GROUPS 5-9 ONLY 070001 07010 200 CONTINUE 07020 IALL = 1 07030 CALL CCSMVA( AGRPS,11,10,GRPBUF,1,10 ) 07040 GO TO 800 070501 07060C**** ASK OPERATOR FROM SCREEN WHICH ACCOUNT GROUPS..... 070701 07080 300 CONTINUE 07090 CALL CCSMVA( MSG2,8,18,MSG2,4,30 ) 07100 CALL CCSMVA( MSG3,16,6,MSG3,4,30 ) 071101 07120 305 CONTINUE 07130 ASSIGN 305 TO IRTN 07140 ASSIGN 10 TO IRTN2 07150 CALL WTREAD(05,-1,MSGA ,36,0,0,0,ITC) 07160 CALL WTREAD(05,-1,MSGB ,36,0,0,0,ITC) 07170 CALL WTREAD(05,-1,MSGC ,36,0,0,0,ITC) 07180 CALL WTREAD(05,-1,MSGD ,36,0,0,0,ITC) 07190 MSGA = MSG1 072001 07210 310 CONTINUE 07220 CALL CCSMVA(INP,1,0,INP,1,82) 07230 CALL WTREAD(05,-1,MSGE ,36,-1,INP,80,ITC) 07240 IF (ITC.EQ.4) GO TO 310 07250 NCH = INP(41) 07260 NCH = (NCH+1)/2 07270 N2H = NCH*2 07280 CALL CCSPUT( $2C,N2H,INP ) 07290 IF ( INP.EQ.ALL ) GO TO 320 07300 GO TO 330 073101 07320C**** VERIFY ALL GROUPS TO BE USED... 073301 07340 320 CONTINUE 07350 MODE = 0 07360 CALL WTREAD( 05,-1,MSG2,36,0,0,0,ITC ) 07370 GO TO 425 073801 07390C**** VALIDATE INPUT FOR VALID GROUPS..... 074001 07410 330 CONTINUE 074201 07430 K = 1 07440 MELM= NCH-1 07450 IF (MELM.LE.1) GO TO 370 07460 DO 360 I=1,MELM 074701 07480 IF(INP(I).LT.INP(I+1))GO TO 360 07490 340 TEMP = INP(I) 07500 INP(I) = INP(I+1) 07510 INP(I+1) = TEMP 07520 DO 350 J=I,2,-K 07530 IF(INP(J).GT.INP(J-1))GO TO 360 07540 TEMP = INP(J) 07550 INP(J) = INP(J-1) 07560 INP(J-1) = TEMP 07570 350 CONTINUE 07580 360 CONTINUE 075901 07600C*** CHECK FOR DUPLICATE NUMBERS 076101 07620 JJ = NCH-1 07630 DO 365 I = 1,JJ 07640 IF ( INP(I).EQ.INP(I+1) ) GO TO 390 07650 365 CONTINUE 076601 07670C*** DISPLAY CHOICES AND VERIFY... 076801 07690 370 CONTINUE 07700 IF( INP(1).EQ.INP(2) ) GO TO 390 07710 DO 375 I = 1,NCH 07720 L = ( AND(INP(I),$FF00) )/256 07730 IF ( L.LT.$30 .OR. L.GT.$39 ) GO TO 390 07740 375 CONTINUE 07750 CALL CCSMVA( INP,1,N2H,MSG4,1,N2H ) 07760 CALL CCSMVA( INP,1,N2H-1,MSG3,11,20 ) 07770 CALL WTREAD( 05,-1,MSG3,36,0,0,0,ITC ) 07780 ASSIGN 380 TO IRTN2 07790 GO TO 425 078001 07810C*** SET GROUPS..... 078201 07830 380 CONTINUE 07840 IALL = 1 07850 CALL CCSMVA( MSG4,1,N2H,GRPBUF,1,N2H ) 07860 GO TO 800 078701 07880C*** ERROR IN NUMBER ENTRY ..... REPEAT PROMPT 078901 07900 390 CONTINUE 07910 MSGA = MSGB 07920 CALL CCSMVA( INP,1,N2H-1,MSGF,19,20 ) 07930 CALL WTREAD( 05,-1,MSGF,40,0,0,0,ITC ) 07940 GO TO IRTN 079501 07960C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 079701 07980 400 CONTINUE 07990 ASSIGN 400 TO IRTN 08000 ASSIGN 10 TO IRTN2 08010 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 08020 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 08030 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 08040 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 080501 08060 410 CONTINUE 08070 CALL CCSMVA(INP,1,0,INP,1,82) 08080 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 08090 IF (ITC.EQ.4) GO TO 410 081001 08110C*** VALIDATE SELECTION.... 081201 08130 CALL CCSGET( INP,1,ICH ) 081401 08150 IF( INP(41).EQ.0 ) GO TO 420 08160 IF ( ICH.LT.$30 .OR. ICH.GT.$32 ) GO TO IRTN 081701 08180 420 MODE = AND( ICH,$F ) 08190 IF( MODE.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,35,0,0,0,ITC) 08200 IF( MODE.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,35,0,0,0,ITC) 08210 IF( MODE.EQ.2 ) CALL WTREAD(05,-1,MSG4 ,35,0,0,0,ITC) 082201 08230 425 CONTINUE 08240 CALL CCSMVA(INP,1,0,INP,1,82) 08250 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 08260 CALL CCSGET(INP,1,ICH) 08270 IF ( INP(41).EQ.0 ) GO TO 430 08280 IF ( ICH.NE.$59 ) GO TO IRTN 08290 430 CONTINUE 08300 GO TO IRTN2 083101 08320C**** GET 'IMODE' WHAT TO DO FLAG FROM UTIFIL... 083301 08340 500 CONTINUE 08350 CALL GTSYSP( MODE,77 ) 08360 IF ( MODE.LT.0 .OR. MODE.GT.4 ) MODE = 0 08370 GO TO 10 083801 08390 800 RETURN 08400 END 08410 END/ 08420SYSPRT DCK/ I=13,H 08430SYSPRT HOL/ 08440 SUBROUTINE SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 08450 1 /CCS3.0 SUBROUTINE SYSPRT SL-XXX 084601 08470C** CYBERCREDIT FINANCIAL SERVICES. 08480C** CYBERCREDIT FIELD SUPPORT GROUPS 08490C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 08500C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 08510C** 08520C** ************ 04/06/84 ************ PROGRAMMER : RWE 085301 08540C**** PROGRAM DESCRIPTION : OUTPUT BUFFER TO LOGICAL UNIT OR 08550C TO A FILE 'SYSPRT'. 085601 08570C*** CALLING SEQUENCE : CALL SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 085801 08590C PARAMETERS 086001 08610C BUFFER : BUFFER CONTAINING CHARACTERS TO OUTPUT FROM. 08620C NTIMES : # OF TIMES TO OUTPUT THE BUFFER 08630C SYSPRM : 6 WORD ARRAY HOLDING PARAMETERS FOR SYSPRT 08640C SYSPRM(1) : PLN - NUMBER OF BYTES TO OUTPUT FROM BUFFER 08650C SYSPRM(2) : NLU - LOGICAL UNIT TO OUTPUT TO ( IGNORED IF 08660C OUTPUT IS TO FILE ) 08670C SYSPRM(3) : IPF - SWITCH DESIGNATING OUTPUT TO FILE OR LU 08680C 0 = LOGICAL UNIT. 1 = FILE. 2 = BOTH. 08690C SYSPRM(4) : NLINE - CURRENT LINE OR RECORD JUST OUTPUT. 08700C (INITIALIZED TO 0 BY CALLING PROGRAM) 08710C SYSPRM(5) : ISERR - ISTAT OF FILE MANAGER CALL TO FILE 08720C SYSPRM(6) : NU - NOT USED AT PRESENT TIME 08730C IOPT : WHAT TO DO FLAG. 0 = OUTPUT BUFFER TO FILE OR LU 08740C 1 = CLOSE FILE 087501 08760C**** SYSPRT PARAMETERS........ 087701 08780 INTEGER BUFFER(1),NTIMES,IOPT 08790 +, SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 088001 08810 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 08820 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 08830 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 088401 08850C**** FWRITE PARAMETERS..... 08860 INTEGER IFLAG,ITEMP(8) 088701 08880 DATA IFLAG /0/, ITEMP /8*0/ 088901 08900 INTEGER DAT1(15),REQ1(24),R1KY(15),REC1(0068) 08910 +, HEDR(18) 089201 08930 DATA HEDR/$0D0A,$0717,'ABORTED--PRINT FILE IS FULL FN='/ 08940 DATA DAT1 /'SYSPRT ',00,01,-1/,REQ1/24*0/ 08950 +, IOPN/0/ 089601 08970C**** 08980C**** BEGIN PROGRAM ....... 089901 09000 IF ( ISERR.LT.0 ) GO TO 800 09010 ISERR = 0 09020 LINE = NLINE 09030 LU = AND( NLU,$FF ) 09040 LENW = (PLN+1)/2 090501 09060 IF ( IOPT.NE.0 ) GO TO 950 09070 IF ( IPF.EQ.1 ) GO TO 400 09080 IF ( NTIMES.LE.0 ) GO TO 800 090901 09100 IF ( LU.EQ.05 .OR. LU.EQ.04 ) GO TO 20 09110 IF ( LU.EQ.09 .OR. LU.EQ.12 ) GO TO 20 09120 I = LENW 09130 GO TO 40 091401 09150 20 CONTINUE 09160 DO 30 I = LENW, 2, -1 09170 IF ( BUFFER(I).NE.$2020 ) GO TO 40 09180 30 CONTINUE 091901 09200 40 CONTINUE 09210 LENB = I * 2 092201 09230C*** WRITE BUFFER TO LOGICAL UNIT..... 092401 09250 IF ( LU.EQ.05 ) GO TO 140 09260 50 CONTINUE 092701 09280 DO 80 I = 1,NTIMES 092901 09300 ASSIGN 60 TO ICOMP 09310 CALL FWRITE( LU,BUFFER,LENB,ICOMP,IFLAG,ITEMP ) 09320 CALL DISP 09330 60 CONTINUE 093401 09350 80 CONTINUE 09360 GO TO 200 093701 09380C**** WRITE OUTPUT TO TERMINAL (MAX OF 132 BYTES)......... 093901 09400 140 CONTINUE 09410 DO 150 I = 1,NTIMES 094201 09430 ILN = LENB 09440 JLN = LENB 09450 IF ( ILN.GE.80 ) JLN = 80 094601 09470 CALL WTREAD( LU,-1,HEDR,2,0,0,0,ITC ) 09480 CALL WTREAD( LU,-1,BUFFER,JLN,0,0,0,ITC ) 094901 09500 JLN = ILN-80 09510 IF( JLN.LE.0 ) GO TO 150 095201 09530 CALL WTREAD( LU,-1,BUFFER(41),JLN,0,0,0,ITC ) 095401 09550 150 CONTINUE 095601 09570C**** INCREMENT LINE COUNT....... 095801 09590 200 CONTINUE 09600 NLINE = NLINE + NTIMES 09610 GO TO 800 096201 09630C**** WRITE BUFFER TO SYSPRT FILE.......... 096401 09650 400 CONTINUE 09660 IF ( IOPN.EQ.1 ) GO TO 420 096701 09680 DO 410 I = 1,24 09690 REQ1(I) = 0 09700 410 CONTINUE 097101 09720 CALL OPENFL( REQ1,DAT1,ISTAT ) 09730 IF( ISTAT.LT.0 ) GO TO 900 09740 IOPN = 1 097501 09760C**** OUTPUT BUFFER TO SYSPRT FILE.... 097701 09780 420 CONTINUE 09790 IF( NTIMES.LE.0 ) GO TO 800 09800 ILN = PLN 09810 IF( ILN.GT.132 ) ILN = 132 09820 CALL CCSMVA( BUFFER,1,ILN,REC1,1,132 ) 098301 09840 DO 440 I = 1,NTIMES 09850 CALL PUTS( REQ1,REC1,1,ISTAT ) 09860 IF( AND(ISTAT,$9000).EQ.$9000 ) GO TO 500 09870 IF( ISTAT.LT.0 ) GO TO 900 09880 440 CONTINUE 098901 09900 NLINE = NLINE+NTIMES 09910 GO TO 800 099201 09930C**** INFORM OPERATOR FILE IS FULL..... 099401 09950 500 CONTINUE 09960 ISERR = -1 09970 CALL CCSMVA( HEDR,1,36,REC1,1,132 ) 09980 CALL CCSMVA( DAT1,1,24,REC1,37,24 ) 09990 CALL WTREAD( 05,-1,REC1,64,0,0,0,ITC ) 10000 GO TO 950 100101 10020 800 CONTINUE 10030 RETURN 100401 10050C*** ERROR SECTION.... 100601 10070 900 CONTINUE 10080 ISERR = -1 10090 IREQ = AND(REQ1(4),$FF) 10100 IF(IREQ.LT.11) IREQ = IREQ-1 10110 IF(IREQ.EQ.18) IREQ = 10 10120 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 101301 10140C**** CLOSE FILE AND RETURN 101501 10160 950 CONTINUE 10170 CALL CLOSFL( REQ1,ISTAT ) 10180 IOPN = 0 10190 RETURN 10200 END 10210 END/ 10220ICKGRP DCK/ I=13,H 10230ICKGRP HOL/ 10240 INTEGER FUNCTION ICKGRP( GRPBUF,IALL,REC,IPOS ) 10250 1 /CCS3.0 SUBROUTINE ICKGRP SL-XXX 102601 10270C** CYBERCREDIT FINANCIAL SERVICES. 10280C** CYBERCREDIT FIELD SUPPORT GROUPS 10290C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 10300C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 10310C** 10320C** ************ 04/06/84 ************ PROGRAMMER : RWE 103301 10340C**** PROGRAM DESCRIPTION : VALIDATE RECORD FOR MATCH OF ACCT GROUP 103501 10360C*** CALLING SEQUENCE : 10370C ITF = ICKGRP( GRPBUF,IALL,REC,IPOS ) 10380C OR... IF ( ICKGRP( GRPBUF,IALL,REC,IPOS ).EQ. 1 ) GO TO 103901 10400C PARAMETERS 104101 10420C ICKGRP : RETURNED VALUE OF 0 = TRUE, OK TO USE RECORD 10430C 1 = FALSE, DON'T USE RECORD 10440C GRPBUF : 10 WORD ARRAY PASSED, CONTAINING VALID GROUPS 10450C ( BUILT BY SUBROUTINE 'GETGRP' ) 10460C IALL : PASSED FLAG DESIGNATING 10470C 0 = USE ALL ACCOUNT GROUPS ( FORCE ICKGRP TO TRUE ) 10480C 1 = LOOK FOR MATCH OF GROUP FROM RECORD, IN THE 10490C GRPBUF ARRAY 10500C REC : PASSED BUFFER OF RECORD CONTAING ACCT GROUP. 10510C IPOS : STARTING BYTE POS. IN REC OF ACCOUNT GROUP 105201 10530 INTEGER GRPBUF(1),IALL,REC(1),IPOS,TRUE,FALSE 105401 10550 DATA TRUE / 0/, FALSE / 1/ 105601 10570C**** 10580C**** BEGIN PROGRAM ....... 105901 10600 ICKGRP = TRUE 10610 IF ( IALL.EQ.0 ) GO TO 900 106201 10630 CALL CCSGET( REC,IPOS,IGRP ) 106401 10650 DO 200 I = 1,10 10660 J = I*2-1 10670 CALL CCSGET( GRPBUF,J,ICH ) 106801 10690 IF( ICH.EQ.$FF ) GO TO 800 10700 IF( ICH.EQ.IGRP ) GO TO 900 10710 200 CONTINUE 107201 10730C*** NO MATCH SET ICKGRP TO FALSE 107401 10750 800 CONTINUE 10760 ICKGRP = FALSE 10770 GO TO 900 107801 10790 900 RETURN 10800 END 10810 END/ 10820 END/ 10830*REW,7 10840*K,I7,P21,L14 10850*FTN 10860*EOF 10870*CLOSE 10880*K,I13,L14 10890*Z 10900*Z 10910__ J = I*2-1 10670 CALL CCSGET( GRPBUF,J,ICH ) 106801 10690 IF( ICH.EQ.$FF ) GO TO 800 10700 IF( ICH.EQ.IGRP ) GO TO 900 10710 200 CONTINUE 107201 10730C*** NO MATCH SET ICKGRP TO FALSE 107401 10750( P  I.LTRPRTCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING LTRPRT FROM B.LTRPRT, CCS149 FILE 00030*OPEN,FN=B.LTRPRT,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,LTRPRT,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM LTRPRT HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ IF( ICH.EQ.$FF ) GO TO 800 10700 IF( ICH.EQ.IGRP ) GO TO 900 10710 200 CONTINUE 107201 10730C*** NO MATCH SET ICKGRP TO FALSE 107401 10750<I u0B.LTRSTACCS149 x999984050384< PLTRSTA B78 F CCS 3.0 .LA/LETTER STATS 05/84 SL-149@P@P@P@P$@P@PF( @P@P@P@P@PE@P@P2@P@P~@PJ@Pv@P @P@PLATRNSFL  @P@P01@P@P@P@P000000@P@P000000@P@P@P@P@P@PG@P[@P@P00@P0000@P @P@P@P'@PR@Pf@P@P@P@P@P@P#@PN@Pb@P@P@P@P@P @P@PJ@P^@P@P@P@P@P@P@PF@PZ@P@P@P@P@P@P@PB@PV@P@P@P@P@P@P@P>@PR@P}@P@P@P@P@P @P :@P N@P y@P @P @P @P @P @P 6@P J@P u@P @P @P @P @P @P 2@P F@P q@P @P @P @P @P @P .@P B@P m@P @P @P @P @P @P *@P >@P i@P }@P @P @P @P @P&@P:@Pe@Py@P@P@P@P@P"@P6@Pa@Pu@P@P@P@P@P@P2@P]@Pq@P@P@P@P@P@P.@PY@Pm@P@P@P@P@P@P*@PU@Pi@P@P@P@P@P@P&@PQ@Pe@P@P@P@P@P@P"@PM@Pa@P@P@P@P@P @P@PI@P]@P@P@P@P@P@P@PE@PY  @P @P  @P @P2@P@P**TOTALS@PLTR1@P000000@P1---------- HDR1 GOES HERE -------------- COLLECTOR LETTER STATISTICS @P PAGE @P @P ---------- HDR2 GOES HERE -------------- AS OF:  @PE @PY @P\ ---------- HDR3 GOES HERE --------------  @P @P @P LETTERS REQUESTED  @P @P @P COLLECTOR  @P @P @P" COLLECTOR  @PM @Pa @Pd COLLECTOR  @P @P @P COLLECTOR  @P @P @P[ TOTALS  @P @P @P LTR1 RECORD NOT FOUND  @P @P @PUTIFIL SYSPRT @P EXECUTING LTRSTA @PP @PU@PV **LTRSTA** ERROR IN FILE : XXXXXXXX RUN ABORTED **********  @P @P @P@PTQTȸ T\T@PTTR\STPQRT TST '\ "@P2T " dT\\(\<\@P]Q T dT3U "U  \ d$@P d  d d  dT3 -\3@P ! B,݀hT3@P\3f4ܲ 1ܑ 1\T  @P "d  2 d" $d $d hX\ @Pm̈  )hHT m  h6T T m @PC )h)T md h\ m W 214 d lw@Pn l lTq d f 24 f d d,h f 21 d1@P  d h\ mq h\ m d8̒4 @Pd d,h d,h "λ n'@P l d̙! l= d,dmΕnܺ l̶! @Pl= d,ڌl줆nܞ lݜ6Ǝl̓d # lp4@P3 d d",d d d2 $ d,d̦ "̢ll@P^"7  d LTTF 1 d̴ d B@P,h\@P ll 3̞ l B,hT@P  \ 1Ts\qTk3U "@PU \3\3 #d 2 l d!$  d@P$ d d$h Tp@P Tt 1h\@P"̿ l\T%  !G BTa d̝!@PM  l̨, lh\@P]\[ /\ d\[\\[@P>@P̶ n3@P>@P@Pd # l  lTTV d@Pv@PT/@P3@P\V l \VTT3U\TTPLTRSTAPQ8STP PGMIN CCSCST'CCSMVAWTREADUTHEADGTSYSP PRTORFGETGRPSYSPRTOPENFL5EDIT CCCSPUTcGETUTIPGETS ICKGRP9CCSBLKDBHXDEC FILERRCLOSFLPGMOUTPLTRSTA PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVAh hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPBHXDECcPQ8PKUPkQ8PREPhP __h"  T h h\  1hՀ@P-HTTh\h\h\hPICKGRP1PQ8PKUP7Q8PREP4CCSGETP PwBHXDEC HEX TO DECIMAL W/LEADING BLANKS @P@P @P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPBHXDECcPQ8PKUPkQ8PREPh<w |lrB.MHUPDTCCS149 x032883< P+MHUPDT B79 F CCS CCS 3.0 .LA - PSRD 07-83 SL-149@P@P@P@P (@Pd @P@P @P@P2m@P 51@P.@P@P @P1@PX@Pg@P@P@P@P@P@P@P@P!HDR0RSW1@P  @P @P  @PA @PU  @P @P  @P @P  @P @P  @P= @PQ  @P| @P  @P @P  @P @P  @P9 @PM  @Px @P  @P @P  @P @P  @P5 @PI  @Pt @P  @P @P@P@PRSW@P@P@P@PRELEASED SATISFIED WRITTEN-OFF @PDELQMST COSIGNERSUMHIST TAPEARC @P"LAINACCT  @PILADLQMST  @PpLACOSIGN  @PLAACTFIL  @PLASUMHST  @PLATAPARC  @P LAUTIFIL  @P,3qw@P6}hZ @P@)@P&@P "RSW1" RECORD NOT PRESENT IN UTIFIL @P*@P VALUES IN "RSW1" RECORD -- NOT NUMERIC. @P%END OF HISTORY@P2@PJ@P END-OF-TAPE -- MOUNT ANOTHER REEL. CARRIAGE RETURN WHEN READY. READY @PTT ȿ 3T""\I\p \@P<\\\  Ȇ T "ȃ (T"@PgT\1I *\IT \\Xp ,\p\ \1\\@P /\\ \1\X\\ 1\\ \1\ X\@P\\̫ 1\\ \1\X\\\T[ ̍ 1Tc @P\ \1TxX\\\Ti d"T! @P )\ \ ,1hT%@P ( 1\#׬؜ .T\ d f ,d@P S lhT u 94 1\Tv@P v $ˎn ڬ$n Ь$췎n 1ܯ 1\@P dddTdTdTT # d@P d d.T xdTz  T@P \\\TA@P (1H0,9X,6HTOTALS,//,12X,13HRELEASED ,I5,/,12X,13HSATISFIED ,I5,/,12X,13HWRITTEN@P +-OFF ,I5,//,7X,18HMOVED TO HISTORY ,I5) @P @T T % d TlT\̂ (T" @P kTJ  \JT Z d d N@P 1 l dIfQ 1T 1R  '@P \I#T E\ l̷ ܰ 1T l  !@P \T ̷ *T a"T d$d u\d@P  " dIfQfafYfifr 1 T 1R @P B   '\Io  ldd @P md5h?h5h +hT @P @P 1dddd uݬlT m \@P T1 ,T I TZ 13\@P  T 8Z '\\T ̾ '\ @P dT A\Xb̨,̢&̜ '\p lT X @P 3'\pT J\d drh\@P Vj -լ cT hT J@P r Iπh\@P ̮ '\_\Jj̶h\J@P ޔ 1̤ l! d̙ d dKT  d#@P ? #  l l-\{T sQK (T@P a  d T{  @P (A2,1H/,A2,1H/,A2)@P  lf̥ l 1T <T ̴ '\*T  \J@P >\\JsT s̊ '\  T @P iza  dDh T @P w 1\T @P (1H1,20A2,8X,27HACCOUNT MOVEMENT TO HISTORY,42X,5HPAGE ,I3) @P \zc lȀXh\@P 1 dh\@P 1 ḽlh\@P ܧ 1\\\\@P (1X,20A2,12X,10HRUN DATE: ,A2,1H/,A2,1H/,A2,/,1X,20A2,9X,15HAS OF: RELEASED,I3,17H DAY@PS, SATISFIED ,I3,19H DAYS, WRITTEN-OFF ,I3,5H DAYS,/,1H0,15X,7HACCOUNT,9X,9HBORROWERS,@P+24X,8HINACTIVE,9X,4HDATE,5X,14HDATE LOST WITH,/,16X,6HNUMBER,10X,4HNAME,30X,6HSTATUS,8@PVX,28HINACTIVE TAPE ARCHIVE DATA,/)@Ph@P fj@PjT hzh  dh T u@P| 1 lh\@P 1 l $h\@P 1 lӀh\@P 1 dzh\@P 1T @P(11X,8A2,4X,R1,14A2,A1,3X,6A2,5X,A2,1H/,A2,1H/,A2,4X,4A2) @P̎  d@P @PdTTTdT U\T <@P l\\\lլTTPMHUPDTPQ8STP *Q8QINImQ8QX zQ8QENDAMONTO ADAYTO AYERTO STATITPGMIN CCSCST mCCSMVA !OPENFLFILERR PGMOUT(PCLOSFL pREADR WTREADCCSGET ICALJL ICCSAD CCSBLK 9GETS TAPMOTUPDREC )DELREC ,WRITER RENCODE FWRITEPDISP PMHUPDT__| 1 lh\@P 1 l $h\@P 1 lӀh\@P 1 dzh\@P 1T @P(11X,8A2,4X,R1,14A2,A1,3X,6A2,5X,A2,1H/,A2,1H/,A2,4X,4A2) @P̎  d@P @PdTTTdT U\T <<Ju* H|/B.NEWS CCS149 x032883< PNEWS B81 F CCS CCS 3.0 SL-149@P@P@P @P@@P(@PP@P'J @P @P*NEWS CCS20 @P @P COLECT @P7@P9EX @P>@PELALEGAL @PJ**************************************************************************@Po************************ N E W S XX/XX/XX ************************@PANSWER 1,2,3(CR)@PREADY @PNEWS  @P@P@P.@P@P TAdddhhAE TZ;@P5TTL@P;(A2,/,36HCHOOSE ONE OF THE FOLLOWING OPTIONS:,//,2X,12H1) NEWS ONLY,/,2X,34H2) DISPLAY@Pf NEWS THEN GO INTO LEGAL,/,2X,26H3) SKIP NEWS GO INTO LEGAL,//) @P d>T>H d 1 1 TET@P 2y T\\ 2yݬ \@PT0Z-T6T9M@P(A2,/,36HCHOOSE ONE OF THE FOLLOWING OPTIONS:,//,2X,12H1) NEWS ONLY,/,2X,35H2) DISPLAY@P NEWS THEN GO INTO COLECT,/,2X,27H3) SKIP NEWS GO INTO COLECT,//) @P: d>T>H d 1 1 TT@Pe / TTT Ɣ8 @P *\ d7d d" $d@P $d ο=  hT W d@Pd@PTZN d IhT@P %1T@P(1H ,37A2)@PTo\ZQ lnh\@P %1\\ZR lɀIh\@P/ %1\M h\̙ ll hTZ\Z@PZZl l̓h\@Pe܍ %1\@Pl(1H ,37A2)@Pq ddi)7 , d>T> @P> TZjTT@P(A2)@P lM@P@Pp@P@P@P@Pll-Ṯ )\Zs\\@P(A2,///,20X,25H***** NO NEWS TODAY *****) @P lll T 9@P@PX@PAE \F\ @P@P@Px@PTTPNEWS PQ8STP Q8QINIQ8QX Q8QENDAMONTOADAYTOAYERTOFMEOFC FMRDEL$PGMIN  WTREADCCSMVAQOPENFLbFILERRrPCCSBLKzGETS ~CCSCSTEDIT  CLOSFLCHAIN PGMOUTPNEWS __@Pll-Ṯ )\Zs\\@P(A2,///,20X,25H***** NO NEWS TODAY *****) @P lll T 9@P@PX@PAE \F\ @P<gN IoNB.TRENDFCCS149 x032883< PDTRENDF C25 F CCS CCS 3.0 .LA - PSRD RWE 10/82 SL-XXX@P@P>@P>@P>@P>2T0@P>z @NON Y @P>#@P>@P>*@P>@P>) 2@P>k@P>R @P>@P>nm000 @P>d@P> @P>@P+@PV@Pj@P @P  @P @P  @P @P  @P1 @PE  @Pp @P  @P @P  @P @P  @P- @PA  @Pl @P  @P @P  @P @P  @P) @P=  @Ph @P|  @P @P  @P @P  @P% @P9  @Pd @Px  @P @P  @P @P  @P! @P5  @P` @Pt  @P @P  @P @P  @P @P1  @P\ @Pp  @P @P  @P @P  @P @P-  @PX @Pl  @P @P  @P @P  @P @P)  @PT @Ph  @P @P  @P @P  @P  @P %  @P P @P d  @P @P  @P @P  @P @P !  @P L @P `  @P @P  @P @P  @P @P   @P H @P \  @P @P  @P @P  @P  @P   @P D @P X  @P @P  @P @P  @P  @P   @P @ @P T  @P  @P  @P @P  @P @P  @P< @PP  @P{ @P  @P @P  @P @P  @P8 @PL  @Pw @P  @P @P  @P @P  @P4 @PH  @Ps @P  @P @P  @P @P  @P0 @PD  @Po @P  @P @P  @P @P  @P, @P@  @Pk @P  @P @P  @P @P  @P( @P<  @Pg @P{  @P @P  @P @P  @P$ @P8  @Pc @Pw  @P @P  @P @P  @P @P4  @P_ @Ps  @P @P  @P @P  @P @P0  @P[ @Po  @P @P  @P @P  @P @P,  @PW @Pk  @P @P  @P @P  @P @P(  @PS @Pg  @P @P  @P @P  @P @P$  @PO @Pc  @P @P  @P @P  @P @P  @PK @P_  @P @P  @P @P  @P @P  @PG @P[  @P @P  @P @P  @P @P  @PC @PW  @P @P  @P @P  @P @P  @P? @PS  @P~ @P  @P @P  @P @P  @P; @PO  @Pz @P  @P @P  @P @P  @P7 @PK  @Pv @P  @P @P  @P @P   @P 3 @P G  @P r @P  @P @P  @P @P!  @P!/ @P!C  @P!n @P!  @P! @P!  @P! @P"  @P"+ @P"?  @P"j @P"~  @P" @P"  @P" @P"  @P#' @P#;  @P#f @P#z  @P# @P#  @P# @P#  @P$# @P$7  @P$b @P$v  @P$ @P$  @P$ @P$  @P% @P%3  @P%^ @P%r  @P% @P%  @P% @P%  @P& @P&/  @P&Z @P&n  @P& @P&  @P& @P&  @P' @P'+  @P'V @P'j  @P' @P'  @P' @P'  @P( @P('  @P(R @P(f  @P( @P(  @P( @P(  @P) @P)#  @P)N @P)b  @P) @P)  @P) @P)  @P* @P*  @P*J @P*^  @P* @P*  @P* @P*  @P+ @P+  @P+F @P+Z  @P+ @P+  @P+ @P+  @P, @P,  @P,B @P,V  @P, @P,  @P, @P,  @P, @P-  @P-> @P-R  @P-} @P-  @P- @P-  @P- @P.  @P.: @P.N  @P.y @P.  @P. @P.  @P. @P/  @P/6 @P/J  @P/u @P/  @P/ @P/  @P/ @P0  @P02 @P0F  @P0q @P0  @P0 @P0  @P0 @P1  @P1. @P1B  @P1m @P1  @P1 @P1  @P1 @P1  @P2* @P2>  @P2i @P2}  @P2 @P2  @P2 @P2  @P3& @P3:  @P3e @P3y  @P3 @P3  @P3 @P3  @P4" @P46  @P4a @P4u  @P4 @P4  @P4 @P4  @P5 @P52  @P5] @P5q  @P5 @P5  @P5 @P5  @P6 @P6.  @P6Y @P6m  @P6 @P6  @P6 @P6  @P7 @P7*  @P7U @P7i  @P7  @P9  @P: @P:  @P:I @P:]  @P: @P:  @P: @P:  @P; @P; @P;K @P;RSW 998 999 997 @P>^@P>?@P>_:@P@P;@P>d@P;a@P>e@P;S @P>[YES NO@P;#);&2D@P; @P;kw2);M@P; @P>C AS OF DATE WAS NOT GREATER THAN LAST RUN DATE @P;b PLEASE ENTER "AS OF" DATE FOR TREND ANALYSIS CALCULATION - ENTER : MMDDYY OR @P;CARRIAGE RETURN TO USE SYSTEM DATE @PpLAACCAGE  @P;fDELQMST @P>j THE DATE ENTERED IS . IS THIS THE CORRECT DATE? Y OR N @P>T;>>>T>;>>Ȱ T>>>\p>>p>\>f>;<>T@P>+p>Ȕ (Tp>>> d;S d;T d;UhT>T+C>@P?'>> d>d . '\p>>>\>\>C>>>  Od;@P?RPd; ll\CC>>\>\C> l l l l T>>>C>>;V>T>;V@P?};V>\>>;b>>;V>>> ;V>\;S>>j>>\;V>>j>>d@P?>\>>>j>>>>>>>>>[  ;\ T;V @P?!\;S>;V>>d 5 dO\C>>;]>;X;_ "?pT;] d>\;V@P?d> "?p; ; T?{;]>C>>\;V>C>> T+C>̷ @P@)T+C>> 1̪  d>̤  lT?p>>>T+>>c>"p 4>d>@P@Tp4>d> d|d}>d  d;Hd;I llT>̻ '\>> d@P@> f* f 1T>+p>̜ '\p>>>\;<>̎ '\;<> >>@P@\>> '\>>> d̤ T?"+>> d>_  (@P@T@?p>>>9d> 2 d>"$> d>>^  ;@PA hT@@PA >;K>T;K>̘̒>̋ '\;<>>>T>> d>\@PA6;>>>>  1 9; ; ) d>;h;h̗h@PAa;h ;h>h\@PAt 1 l׀;hӀ;hhˀ;h ǀ;hTA @PAܻ 1\>>;>> 1h hT>@PA>>;>>> i>a d>?$> d>;h ̠h\@PA>@PA>;h ,ˀ;h\@PA>@PA>>>h\;>@PA>>>b !T;>a>> (T@>>> l>` F$Bd> ΀@PBhTA;>@PB>>@PAB"@PA"B"@PB"h\;>@PB+>> l@P@B/@P B/ d>^@P@B2@PAB2@PB2>@P@B6@PB6T@*+> '\p>>>>_ @ l >a !>?  d  dTA@PBa+>̖ '\p>>>\;>>>\+>> 2TBp>>>@P@B@PBT@;K>> ḻ  '\;<>>>d> C d>"C@PB$>>d>; CT?C> d>;h;h;h ;hhT@PBB@PBC@PB 1̀h\@PB>>;>€h\@PB>C>̷ hTA.@PC>> d>\;>>>>  1 !'C)d>Cd^\;>C>>@PC1>eT@!+CC>> 1FTBp>>>>a$> d> , ;hTB@PCU>C>>;h\C>@PCc>>b !TA;>a> '\>>> l>` >&>_ B l@PC !q@PBC@PC d;d;d;T?;Vd>\;d>;X; Bd>d>Ŝ $>l @PC$>lٜl '>l>l*>ʜ"lp4>d>,dd>p4>d>,@PCdd> 0h 0Ȉ l 0 l@P?=C@P@EC@P@C@P@C@PCT@G+> @P@|D@P@D@P@D@PA,D@PBD@PBDD@PBXD@PBnD@PBD@PBD@PD\+>\>\>@P? D @PD TTPTRENDFPQ8STP DAMONTO? ADAYTO?AYERTO?FMRDEL?PGMIN >CCSCSTACCSMVACSOPENFL@FILERRC>CCSBLKBGETS BWTREAD?qIDATVR?PICALJLCWRITERC3UPDRECB7CLOSFLCCLEAR @oREADR B`CCSGETCPUTS ClPGMOUTDPTRENDF__@D@PA,D@PBD@PBDD@PBXD@PBnD@PBD<Aj #}{)B.ACTADDCCS149 x032883< PpACTADD B01 F CCS CCS 3.0 .LA - PSRD SL-149@P@P#@P&@P)01  +8<0050@P:@P>@PLATRNSFL  @PLAACTFIL  @PLAUTIFIL  @P!@PL@P0482@PBZ@P@P>T !"T#$% T&'$\&'$\&'$T@Pi!%ȸ (T&% T\9%ȩ &\&% \\% dș &\&% \@PT!Q(%Ȋf% &\*% \_+\Q,-T9%@P) &\.% \TRQ/00\% &\.% \\Q12 2\@P30.0\Q45/67d8dTE,Q,99 .!)T@PT9%% 2Tp:% Tv l̤; $ǔ<lT=\Q@P@,,̸lT--̨l\T9% 2\2% \T!%\@Pk9%\TPACTADDPQ8STP oPGMIN ?CCSCSTCCSMVAGOPENFLhFILERR'PGMOUT-GETS READR PUTACFUPDRECCCSBLK:WRITERVCLOSFLgPACTADD PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP __30.0\Q45/67d8dTE,Q,99 .!)T@PT9%% 2Tp:% Tv l̤; $ǔ<lT=\Q@P@,,̸lT--̨l\T9% 2\2% \T!%\@Pk9%\TPACTADDPQ8STP oPGMIN ?CCSCSTCCSMVAGOPENFLhFILERR'PGMOUT-GETS READR PUTACFUPDRECCCSBLK:WRITERVCLOSFLgPACTADD PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PH(Q T "J.PRETSRCCS149 P(*JOB,,TWB.JOB PRETSR INSTALL 08/23/84 00010*K,L14 00020*CTO, PRETSR WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.PRETSR , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.PRETSR,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120PRETSR DCK/ I,H 00130 DEL/ 2 00140 1 /C06 F CCS CCS 3.0 .LA SL-149 00150 DEL/ 22,23 00160 DATA IDATA / 'LATRNSFL',8*$2020,0,1,-1/ 001702 00180 DEL/ 26 00190 CALL CCSCST(IDATA,1,2,USER,1,8,ICM) 00200 IF(ICM.NE.0)CALL CCSMVA(IDATA,3,6,IDATA,1,8) 002101 00220 END/ 00230*REW,7 00240*K,I7,P21,L14 00250*FTN 00260*EOF 00270*CLOSE 00280*K,I13,L14 00290*Z 00300*Z 00310__N,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.PRETSR,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120PRETSR DCK/ I,H 00130 DEL/ 2 00140 1 /C06 F CCS CCS 3.0 .LA SL-149 00150 DEL/ 22,23 00160 DATA IDATA / 'LATRNSFL',8*$2020,0,1,-1/ 001702 00180 DEL/ 26 00190 CALL CCSCST(IDATA,1,2,USER,1,8,ICM) 00200 IF(ICM.NE.0)CALL CCSMVA(IDATA,3,6,IDATA,1,8) 002101 00220 END/ 00230*REW,7 00240*K,I7,P21,L14 00250<v }|aB.DHUPDTCCS149 x032883< PDHUPDT B42 F CCS CCS 3.0 .LA - PSRD 07-83 SL-149@P@Pp@Ps@PvЁ@P}@P @PS BT@P Z@P5100@Pd @PUDg@P@P`TAPEARC SUMHIST DELQMST @PdLAADDACT  @PsLATAPARC  @PLASUMHST  @PLADLQMST  @P LAACTFIL @PVTAPEARC RECORD ONLY @P@P/@PC@P A  @P @P'  @PR @Pf  @P @Pl@PD00000000000000@PK0000000010000000000000@P @PB@P03_@PU h@P96)Ge@P@PTmno TdpqrȺ %Tdstdq\`qsq\dq@Pq\hqq\ st qThTduȈ (Tdsum \@Psuu '\ssum\4u '\sum\Lu '\sum \ @P$ u '\ sumTvTuw̺x ̵ *\dyum@PO ddz d{" $}d| $d~  h7T @Pz  dC h"T T4< uu@P 5l܀ @PTum̭ h\ \L uդϬˤx '\@Pum| h\ \  u̬&̧ܜ!̢ >Cl @Pl\sumT tt ޜ dhh @P/hTx@P6 @P9  4   Zրh\@PTD Jƀh€h̾h̺ 8h\<@Pq@Pt2̮h̪8h̦h̢ h\@P<@P̰ hh 8hT<@P@P 2%T2<?  l lhhh\@P @P L dhh8h\<@P @P ,hhހhڀ 8h\<@P@Pπhˀ8h ǀhT @P<@Pܻ 1 1@P!%@P%TLuu (Tum| d\CCdT< @PPrr ET1 \ d d \< sT  z lT@P{ \ s \< T  u̚ '\ umT4<ű '\u@Pml  "BTZ dhT@P 1\BT+@P(1H1,4X,20A2,4X,29HACTIVE ACCOUNTS UPDATED FROM ,14HHISTORY SYSTEM,28X,6HPAGE: ,I3) @P\Z l̼h\@Pܶ (1\\\\@P(1H ,4X,20A2,15X,8HAS OF: ,A2,1H/,A2,1H/,A2) @P+\Z@ )l̋h\@P8 <1\ @P@(1H ,4X,20A2,/) @PHTRO;@PO(1H ,5X,14HACCOUNT NUMBER,10X,14HBORROWERS NAME,22X,13HFORMER STATUS,8X,13HINACTIVE DA@PzTE,3X,17HTAPE ARCHIVE DATE,/) @P dlTWT\}CT<\<@P\ \VTIZ dhT@P <1T΀@P(1H ,4X,60A2) @Pܤ̸TKPP@Ps@P@P@P{d@P^@PT&uu 'T/dumy 0 lTIP{D T P@P!{@P@#@P# 1\R.@P.(1H ) @P1\ZE l̖Oh\@P>ܐ 1\ @PE(1H ,4X,46HTOTAL NUMBER OF ACCOUNTS UPDATED FROM SUMHIST ,6A2)@PdTRk@Pk(1H ,/,44X,23H**** END OF REPORT ****)@P/~@PO~@P~@P~@P~@P5~@P~@P~@P~Tu\ u@P!@P\4u@P@P\u@P@P\u@P@P@PTTPDHUPDTPQ8STP Q8QINIeQ8QX Q8QENDFMRDELPGMIN CCSCSTCCSMVAUTHEADOPENFLFILERRCCSBLKGETS 5READR PUPDRECDECHEXqBINASCyWRITERDELRECEDIT CCSADDCLOSFLPGMOUTPDHUPDT__~@P~Tu\ u@P!( ' q?J.UPDATECCS149 P(*JOB,,TWB.JOB UPDATE INSTALL 08/23/84 00010*K,L14 00020*CTO, UPDATE WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.UPDATE , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.UPDATE,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120UPDATE DCK/ I,H 00130 END/ 00140*REW,7 00150*K,I7,P21,L14 00160*ASSEM 00170*REW,7,20 00180*K,I13,L2 00190*CSY,I20,P7 00200*COSY 00210R9BASE DCK/ I,H 00220R9FLDL DCK/ I,H 00230UPDMAC DCK/ I,H 00240 DEL/ 2 00250 1 /C36 F CCS CCS 3.0 PSR'D SL-149 00260 DEL/ 191,194 00270C ****************************************************** ???*A029 00280 INTEGER HDLIN(66,3), HDLINT(2) 00290 INTEGER COLHD(66,2), COLHDT(2) 00300 COMMON / UPD / HDLIN, HDLINT, COLHD, COLHDT 00310C ****************************************************** ???*A029 00320ADDIT DCK/ I,H 00330CHNGNF DCK/ I,H 00340 DEL/ 239 00350 300 DO 350 I=STAKPT,1,-1 00360CONUPD DCK/ I,H 00370 DEL/ 2 00380 1 /B32 F CCS CCS 3.0 PSR'D SL-149 00390 DEL/ 74 00400C 3. IF NAME HAS NOT CHANGED, RETURN. 00410C 4. IF ACCOUNT IS BEING ADDED, CONTINUE 00420 DEL/ 81,82 00430C 5. UPDATE NAME WITH NEW NAME. 00440C 6. RETURN. 00450 DEL/ 112 00460 + ( NONFTB (43), F15(1)) 00470 DEL/ 199 00480C ****************************************************** ???*A014 00490 IF ( COMPIN .EQ. 0 ) GO TO 200 00500 IF ( ACCTFD .EQ. 0) GO TO 150 00510C ****************************************************** ???*A014 00520 DEL/ 202 00530C ****************************************************** ???*A014 00540 IF (COMPIN .NE. 0) GO TO 150 00550C ****************************************************** ???*A014 00560COSUPD DCK/ I,H 00570FORMLN DCK/ I,H 00580FUPDAT DCK/ I,H 00590GETMAS DCK/ I,H 00600 DEL/ 2 00610 1 /B58 F CCS 3.0 09-22-81 SL-149 00620 INS/ 32 00630 INTEGER IWAIT(38) 00640 DATA IWAIT/$0D0A,'UPDATE WAITING ACCT. NO.',25*$2020/ 00650 INTEGER N46,N76 00660 DATA N46/46/,N76/76/ 00670 INTEGER N29,N21 00680 DATA N29/29/,N21/21/ 00690 DEL/ 53 00700 IF (AND(ISTAT,BUSY).NE.0) GO TO 126 00710 INS/ 57 00720C OUTPUT WAITING ACCT. NO. & NAME MSG IF NOT ALREADY OUTPUT 00730 126 CALL CCSCST (INPBUF, N4, N16, IWAIT, N29, N16, ICOMP) 00740 IF (ICOMP .EQ. 0) GO TO 110 00750C (MOVE ACCT. NO. & NAME TO MSG) 00760 CALL CCSMVA (INPBUF, N4, N16, IWAIT, N29, N16) 00770 CALL CCSMVA (INPBUF,N21, N30, IWAIT, N46, N30) 00780 CALL WTREAD (TLU, -1, IWAIT, N76, -1, 0, 0, ITC) 00790 GO TO 110 00800LABHAN DCK/ I,H 00810NXTRAN DCK/ I,H 00820PRTLIN DCK/ I,H 00830REACIT DCK/ I,H 00840 DEL/ 2 00850 1 /C14 F CCS CCS 3.0 PSR'D SL-149 00860 INS/ 85 00870C********************************************************* PSR CORR ??? 00880C BLANK OUT PROMISE TO PAY FLAG 00890 CALL CCSPUT($20,285,RECBDM) 00900C BLANK OUT QUEUE REASSIGN FEILD 00910 CALL CCSPUT($20,294,RECBDM) 00920C********************************************************* PSR CORR ??? 00930 INS/ 158 00940C ****************************************************** ???*0008 00950 RECBTF(15) = A01 00960C ****************************************************** ???*0008 00970RSWIT DCK/ I,H 00980TOTALP DCK/ I,H 00990UNCUPD DCK/ I,H 01000UPDBLK DCK/ I,H 01010UPDEND DCK/ I,H 01020UPDIT DCK/ I,H 01030UPINIT DCK/ I,H 01040 END/ 01050*REW,7 01060*K,I7,P21,L14 01070*FTN 01080*EOF 01090*CLOSE 01100*K,I13,L14 01110*Z 01120*Z 01130__LANK OUT PROMISE TO PAY FLAG 00890 CALL CCSPUT($20,285,RECBDM) 00900C BLANK OUT QUEUE REASSIGN FEILD 00910 CALL CCSPUT($20,294,RECBDM) 00920C********************************************************* PSR CORR ??? 00930 INS/ 158 00940C ****************************************************** ???*0008 00950 RECBTF(15) = A01 00960C ****************************************************** ???*0008 00970RSWIT DCK/ I,H 00980TOTALP DCK/ I,H 00990UNCUPD DCK/ I,H 01000( R  I.LTRSTACCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING LTRSTA FROM B.LTRSTA, CCS149 FILE 00030*OPEN,FN=B.LTRSTA,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,LTRSTA,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM LTRSTA HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ ****************************************************** ???*0008 00950 RECBTF(15) = A01 00960C ****************************************************** ???*0008 00970RSWIT DCK/ I,H 00980TOTALP DCK/ I,H 00990UNCUPD DCK/ I,H 01000( L XJ.DHUPDTCCS149 P(*JOB,,TWB.JOB DHUPDT INSTALL 08/23/84 00010*K,L14 00020*CTO, DHUPDT WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.DHUPDT , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.DHUPDT,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120DHUPDT DCK/ I,H 00130 DEL/ 2 00140 1 /B42 F CCS CCS 3.0 .LA - PSRD 07-83 SL-149 00150 DEL/ 9 00160 INS/ 20 00170C ???*A078 00180C 00190C PSR A078 MADE THE FOLLOWING CHANGES:- 00200C 1. THE ACTIVITY BLOCK FROM IS NOT 00210C MOVED TO . 00220C 2. THE ACTIVITY BLOCK FROM IS WRITTEN 00230C TO AS A NEW RECORD. 00240C 00250C THE REASON FOR THESE CHANGES IS THAT WILL READ 00260C WHEN IT NEEDS TO DISPLAY ACTIVITIES AND THE 00270C DATE OF ENTRIES IN DIFFERS FROM SYSTEM DATE. 00280C THE ORIGINAL IDEA WAS THAT THE LAST FEW ACTIVITIES WERE 00290C SAVED BOTH IN AND , BUT DOES NOT 00300C DISPLAY DUPLICATED ACTIVITIES ANYWAY. 00310C THEREFORE, THERE IS NO REASON TO STORE OLD ACTIVITIES 00320C IN . 00330C ???*A078 00340 INS/ 25 00350C ???*A078 00360 INTEGER ACTDAT(15), ACTREQ(24), ACTREC(252) 00370 1 , ROOM(3) 00380C ???*A078 00390 INS/ 30 00400C ****************************************************** ???*A012 00410 INTEGER MSG(10) 00420C ****************************************************** ???*A012 00430 DEL/ 32,35 00440 INTEGER TDAT(4),SDAT(4),DDAT(4) 004501 00460 DATA TDAT/'TAPEARC '/,SDAT/'SUMHIST '/,DDAT/'DELQMST '/ 00470 DATA ADATA/'LAADDACT',8*$2020,0,20,-1/ 00480 DATA TDATA/'LATAPARC',8*$2020,1, 1,-1/ 00490 DATA SDATA/'LASUMHST',8*$2020,1, 1,-1/ 00500 DATA DDATA/'LADLQMST',8*$2020,1,1,1/ 00510C ???*A078 00520 DATA ACTDAT/'LAACTFIL',8*$2020,1,1,0/ 00530 1 , ACTREQ/24*0/ 00540C ???*A078 00550C ****************************************************** ???*A012 00560 DATA MSG / 'TAPEARC RECORD ONLY ' / 00570C ****************************************************** ???*A012 00580 INS/ 71 00590 CALL CCSCST(ADATA,1,2,IDUSER,1,8,ICM) 00600 IF (ICM.EQ.0) GOTO 5 00610 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00620 CALL CCSMVA(TDAT ,1,8,TDATA,1,8) 00630 CALL CCSMVA(SDAT ,1,8,SDATA,1,8) 00640 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00650 CALL CCSMVA(ACTDAT,3,6,ACTDAT,1,8) 00660 5 CONTINUE 00670 DEL/ 97 00680C ???*A078 00690 IF(ISTAT.GE.0) GO TO 150 00700C ???*A078 00710 INS/ 99 00720C ???*A078 00730C OPEN ACTFIL 00740 150 CALL OPENFL(ACTREQ,ACTDAT,ISTAT) 00750 IF(ISTAT.GE.0) GO TO 200 00760 CALL FILERR(ACTDAT,3,ISTAT,LU) 00770 GO TO 950 00780C ???*A078 00790 DEL/ 122,123 00800C 2 CARDS DELETED ???*A078 00810 DEL/ 192 00820C*************** PSR TO CHECK FOR ZERO HOME PHONE ALSO *** 00830 IF ( II.EQ.2 .OR. II.EQ.4 ) GO TO 303 00840 GO TO 320 00850 303 CONTINUE 00860C*************** END PSR CORRECTION FOR ZERO HOME PHONE *** 00870 DEL/ 199 00880C ONE CARD DELETED ???*A078 00890 DEL/ 220 00900C ONE CARD CHANGED ???*A078 00910 CALL CCSCST(SUMREC,SPOS(7),90,BLK,1,90,ICOMP) 00920 DEL/ 248,251 00930 INS/ 254 00940C FIRST ???*A078 00950C--- CREATE RECORD. 00960C 00970C******** IF NO ACTIVITY SKIP THE CREATE OF THE ACTFIL RECORD - 03/83 00980 CALL CCSCST(SUMREC,193,4,ROOM,1,0,ICM) 00990 IF(ICM.EQ.0) GO TO 365 01000C******** PSR 03/83 END 01010C 01020 CALL CCSBLK(ACTREC,500) 01030C 01040C--- ACCOUNT GROUP & NUMBER 01050 CALL CCSMVA(DELQRC,1,16,ACTREC,1,16) 01060C--- SUFFIX = '51' 01070 ACTREC(9) = $3531 01080C 01090C--- ACTIVITY BLOCK FROM SUMHIST 01100C 01110C--- FIRST, ADD 122 BYTES TO AVAILABLE ROOM. 01120 ROOM = $3030 01130 CALL CCSMVA(SUMREC,193,4,ROOM,3,4) 01140 CALL DECHEX(ROOM,IROOM) 01150 IROOM = IROOM + 122 01160 CALL BINASC(IROOM,ROOM(2)) 01170 CALL CCSMVA(ROOM,3,4,ACTREC,19,4) 01180 CALL CCSMVA(SUMREC,197,356,ACTREC,145,356) 01190C 01200C--- WRITE THIS RECORD. 01210 CALL WRITER(ACTREQ,ACTREC,ACTREC,ISTAT) 01220 IF(ISTAT.GE.0) GO TO 365 01230 CALL FILERR(ACTDAT,12,ISTAT,LU) 01240 GO TO 950 01250 365 CONTINUE 01260C ???*A078 01270 DEL/ 284 01280C ************** ONE CARD DELETED HERE ************* ???*A012 01290 DEL/ 290 01300C ************** ONE CARD DELETED HERE ************* ???*A012 01310 INS/ 291 01320C ****************************************************** ???*A012 01330 IF (UPD .NE. $5400 ) GO TO 460 01340 CALL CCSMVA ( MSG, 1, 20, PRTLN, 68, 20 ) 01350C ****************************************************** ???*A012 01360 INS/ 296 01370C ****************************************************** ???*A012 01380 IF (UPD .EQ. $5400 ) GO TO 500 01390C ****************************************************** ???*A012 01400 INS/ 300 01410 CALL UPDREC(ADDREQ,ADDREC,ISTAT) 01420 IF(ISTAT.GE.0) GO TO 505 01430 CALL FILERR(ADATA,15,ISTAT,LU) 01440 GO TO 950 01450 505 CONTINUE 01460 DEL/ 305 01470 DEL/ 320,343 01480C ************** CARDS DELETED HERE **************** ???*0014 01490 INS/ 346 01500C ONE CARD ADDED ???*A078 01510 CALL CLOSFL(ACTREQ,ISTAT) 01520 END/ 01530*REW,7 01540*K,I7,P21,L14 01550*FTN 01560*EOF 01570*CLOSE 01580*K,I13,L14 01590*Z 01600*Z 01610__ INS/ 296 01370C ****************************************************** ???*A012 01380 IF (UPD .EQ. $5400 ) GO TO 500 01390C ****************************************************** ???*A012 01400 INS/ 300 01410 CALL UPDREC(ADDREQ,ADDREC,ISTAT) 01420 IF(ISTAT.GE.0) GO TO 505 01430 CALL FILERR(ADATA,15,ISTAT,LU) 01440 GO TO 950 01450 505 CONTINUE 01460 DEL/ 305 01470 DEL/ 320,343 01480C ************** CARDS DELETED HERE **************** ???*0014 01490 INS/ 346 01500( B QJ.CCSDMPCCS149 P(*JOB,,TWB.JOB CCSDMP INSTALL 08/23/84 00010*K,L14 00020*CTO, CCSDMP WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.CCSDMP , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.CCSDMP,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CCSDMP DCK/ I,H 00130 DEL/ 2 00140 1 /B20 F CCS CCS 3.0 2 WORD RRN - PSRD SL-149 00150 INS/ 13 00160 INTEGER ISTR(2),ISTP(2) 00170 REAL RSTR ,RSTP 00180 INS/ 22 00190 IF (NOPRT.NE.0) LU = 05 00200 INS/ 26 00210C*** SET UP PROGRAM INTERRUPT 00220 ASSIGN 100 TO INTRPT 00230 CALL PGMINT(INTRPT,0) 00240C*********** BLANK INPUT BUFFER 00250 CALL CCSMVA(INBF,1,0,INBF,1,60) 00260 INS/ 32 00270 IF (NOPRT.NE.0) GOTO 100 00280 DEL/ 38 00290C ****************************************************** ???*A027 00300 CALL CCSMVA ( INBF, 1, NCH, IDATA, 1, 24 ) 00310C ***************************************************** ???*A027 00320 INS/ 58 00330C***** ALLOW READ OF LOCKED RECORDS 00340 REQBUF(23) = 1 003501 00360 DEL/ 60 00370C NREC = NUMBER OF RECORDS IN FILE. 00380 DEL/ 65,67 00390 RRN = NRECM * 32767.0 + NRECL 00400 WRITE (LUNIT, 9002) LIT1, LIT2, RRN 00410 9002 FORMAT ( 'FILE IS ', 2A2,' AND CONTAINS ',2A2,F7.0, 00420 DEL/ 71 00430240 IF (IDX .EQ. 0) GO TO 300 00440 DEL/ 96,98 00450C***** CCSDMP NOW HANDLES DOUBLE PRECISION #'S FOR DUMP BY RRN. 00460 IF (NCH .GT. 6) GO TO 300 00470 CALL REALN (INBF, NCH, RSTR, ISTR(1) ) 00480 DEL/ 109,110 00490 IF (NCH .GT. 6) GO TO 400 00500 CALL REALN ( INBF, NCH, RSTP, ISTP(1) ) 00510 DEL/ 115 00520500 ISTP(1) = ISTR(1) 00530 ISTP(2) = ISTR(2) 00540 DEL/ 121 00550 RECSPC(1) = ISTR(1) 00560 RECSPC(2) = ISTR(2) 00570 DEL/ 138,141 00580 WRITE(LU,9008)(IDATA(I),I=1,4),LIT1,JRTYP,RSTR 005909008 FORMAT ( 4X, 4A2, 2X, 2A2, 5X, I1, 10X, F7.0 ) 00600 WRITE (LU,9009) RSTP 006109009 FORMAT ( 34X, F7.0, // ) 00620 DEL/ 154 00630 IF (IND .GT. 0) GO TO 240 00640 DEL/ 157,158 00650C ************* PRINT RELATIVE RECORD # IN FILE ******************** 00660 1200 RRN = REQBUF(16) * 32767.0 00670 RRN = RRN + REQBUF(17) 00680 1205 WRITE(LU,9026)RRN 00690 9026 FORMAT(1X,'RELATIVE RECORD # IN FILE =',F7.0 ) 00700 CALL SEEIT (LU,BUFFER,LREC,0) 00710 IF (EXACT .EQ. 1) GO TO 240 00720C ******************************************************************** 00730 DEL/ 165 00740 RNOW = REQBUF(16)*32767.0 + REQBUF(17) 00750 IF (RNOW .GE. RSTP ) GO TO 240 00760REALN DCK/ I=13,H 00770REALN HOL/ 00780 SUBROUTINE REALN ( INBF, NCH, ROUT, I2WRD ) 00790 1 /CONVERT ASCII TO REAL - 2 WORD INTEGER SL-*** 008001 00810C** CYBERCREDIT FINANCIAL SERVICES. 00820C** CYBERCREDIT FIELD SUPPORT GROUPS 00830C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00840C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00850C** 00860C** ************ 06/03/83 ************ PROGRAMMER : RWE 008701 00880 INTEGER INBF(1),I2WRD(1),R9SW,RPGSW 00890 DOUBLE PRECISION IDBL,JWK,JXP,J,J10,R2 00900 DATA R9SW /$E3/ 009101 00920C**** CLEAR FTN SCRATCH - DUE TO FTN BUG. 06/83 00930C** 00940C** ENA 0 / STA $C9 00950 ASSEM $0A00, $60C9 00960C*** LDQ LDA STA 00970 ASSEM $E400,+R9SW,$C622,$6400,+RPGSW 009801 00990 J = 0 01000 J10 = 10 01010 ROUT = 0.0 01020 IDBL = 0 01030 DO 100 I = NCH, 1, -1 01040 CALL CCSGET (INBF, I, IWK) 01050 IWK = AND (IWK, $F) 01060 JWK = IWK 01070 JXP = J10**J 01080 IDBL = (JWK * JXP) + IDBL 01090 J = J + 1 01100 100 CONTINUE 01110 ROUT = IDBL 01120 I2WRD(1) = 0 01130 I2WRD(2) = 0 01140 RTMP = ROUT 01150 200 IF ( RTMP.LT.32768.0 ) GOTO 300 01160 IDIV = RTMP/32767.0 01170 I2WRD(1) = IDIV 01180 R2 = IDIV*32767.0 01190 RTMP = RTMP - R2 01200 300 CONTINUE 01210 I2WRD(2) = RTMP 012201 01230C**** RESTORE RPG EXTERNAL SWITCH SETTINGS !! 012401 01250 ASSEM $C400,+RPGSW,$E400,+R9SW,$6622 012601 01270 RETURN 01280 END 01290 END/ 01300INPUT DCK/ I,H 01310INTGR DCK/ I,H 01320SEEIT DCK/ I,H 01330TAPE DCK/ I,H 01340XLAT DCK/ I,H 01350 END/ 01360*REW,7 01370*K,I7,P21,L14 01380*FTN 01390*EOF 01400*CLOSE 01410*K,I13,L14 01420*Z 01430*Z 01440__ RTMP = RTMP - R2 01200 300 CONTINUE 01210 I2WRD(2) = RTMP 012201 01230C**** RESTORE RPG EXTERNAL SWITCH SETTINGS !! 012401 01250(  WSUPD400CCS149 P032883($$TWB.JOB,WEAVE,,UPD400,CCS149 00010UPD400 DCK/ I,H 00020$$TWABINS,WEAVE 00030UP4MAC DCK/ I,H 00040UP4BLK DCK/ I,H 00050FUPD4X DCK/ I,H 00060UP4INI DCK/ I,H 00070UP4LAB DCK/ I,H 00080UP4NXT DCK/ I,H 00090UP4TOT DCK/ I,H 00100UP4END DCK/ I,H 00110UP4GTM DCK/ I,H 00120UP4GTC DCK/ I,H 00130UP4PRT DCK/ I,H 00140UP4FML DCK/ I,H 00150$$U.CHNGNF,CCS149 00160R9BASE DCK/ I,H 00170R9FLDL DCK/ I,H 00180$$TWFBEND,WEAVE 00190_  __AC DCK/ I,H 00040UP4BLK DCK/ I,H 00050FUPD4X DCK/ I,H 00060UP4INI DCK/ I,H 00070UP4LAB DCK/ I,H 00080UP4NXT DCK/ I,H 00090UP4TOT DCK/ I,H 00100UP4END DCK/ I,H 00110UP4GTM DCK/ I,H 00120UP4GTC DCK/ I,H 00130UP4PRT DCK/ I,H 00140UP4FML DCK/ I,H 00150$$U.CHNGNF,CCS149 00160R9BASE DCK/ I,H 00170R9FLDL DCK/ I,H 00180$$TWFBEND,WEAVE 00190_ (E IF9I.CCSFIXCCS149 P(*JOB,, INSTALL CCS CORRECTIONS 10/31/83 00010*CTO, CCS149 PSR INSTALL... AS OF 10/31/83 1244 00020*K,L14 00030*CTO, INSTALLING CCSADD FROM BNCCSADD, CCS149 FILE 00040*OPEN,FN=BNCCSADD,OW=CCS149,LU=21,R 00050*REW,21 00060*K,L14 00070*LIBEDT 00080*K,I21,P8 00090*L,CCSADD 00100*Z 00110*K,I13 00120*CLOSE 00130*CTO, SUBROUTINE CCSADD HAS BEEN INSTALLED 00140*CTO, 00150*CTO, INSTALLING CCSEAC FROM BNCCSEAC, CCS149 FILE 00160*OPEN,FN=BNCCSEAC,OW=CCS149,LU=21,R 00170*REW,21 00180*K,L14 00190*LIBEDT 00200*K,I21,P8 00210*L,CCSE2A 00220*Z 00230*K,I13 00240*CLOSE 00250*CTO, SUBROUTINE CCSEAC HAS BEEN INSTALLED 00260*CTO, 00270*CTO, INSTALLING CCSSBT FROM BNCCSSBT, CCS149 FILE 00280*OPEN,FN=BNCCSSBT,OW=CCS149,LU=21,R 00290*REW,21 00300*K,L14 00310*LIBEDT 00320*K,I21,P8 00330*L,CCSSBT 00340*Z 00350*K,I13 00360*CLOSE 00370*CTO, SUBROUTINE CCSSBT HAS BEEN INSTALLED 00380*CTO, 00390*CTO, INSTALLING CCSMTP FROM BNCCSMTP, CCS149 FILE 00400*OPEN,FN=BNCCSMTP,OW=CCS149,LU=21,R 00410*REW,21 00420*K,L14 00430*LIBEDT 00440*K,I21,P8 00450*L,CCSMTP 00460*Z 00470*K,I13 00480*CLOSE 00490*CTO, SUBROUTINE CCSMTP HAS BEEN INSTALLED 00500*CTO, 00510*CTO, INSTALLING CCSDVD FROM BNCCSDVD, CCS149 FILE 00520*OPEN,FN=BNCCSDVD,OW=CCS149,LU=21,R 00530*REW,21 00540*K,L14 00550*LIBEDT 00560*K,I21,P8 00570*L,CCSDVD 00580*Z 00590*K,I13 00600*CLOSE 00610*CTO, SUBROUTINE CCSDVD HAS BEEN INSTALLED 00620*CTO, 00630*CTO, INSTALLING EDIT FROM BNEDIT, CCS149 FILE 00640*OPEN,FN=BNEDIT,OW=CCS149,LU=21,R 00650*REW,21 00660*K,L14 00670*LIBEDT 00680*K,I21,P8 00690*L,EDIT 00700*Z 00710*K,I13 00720*CLOSE 00730*CTO, SUBROUTINE EDIT HAS BEEN INSTALLED 00740*CTO, 00750*CTO, INSTALLING FILERR FROM BNFILERR, CCS149 FILE 00760*OPEN,FN=BNFILERR,OW=CCS149,LU=21,R 00770*REW,21 00780*K,L14 00790*LIBEDT 00800*K,I21,P8 00810*L,FILERR 00820*Z 00830*K,I13 00840*CLOSE 00850*CTO, SUBROUTINE FILERR HAS BEEN INSTALLED 00860*CTO, 00870*CTO, INSTALLING LTPRNT FROM BNLTPRNT, CCS149 FILE 00880*OPEN,FN=BNLTPRNT,OW=CCS149,LU=21,R 00890*REW,21 00900*K,L14 00910*LIBEDT 00920*K,I21,P8 00930*L,LTPRNT 00940*Z 00950*K,I13 00960*CLOSE 00970*CTO, SUBROUTINE LTPRNT HAS BEEN INSTALLED 00980*CTO, 00990*CTO, INSTALLING QCST FROM BNQCST, CCS149 FILE 01000*OPEN,FN=BNQCST,OW=CCS149,LU=21,R 01010*REW,21 01020*K,L14 01030*LIBEDT 01040*K,I21,P8 01050*L,QCST 01060*Z 01070*K,I13 01080*CLOSE 01090*CTO, SUBROUTINE QCST HAS BEEN INSTALLED 01100*CTO, 01110*CTO, INSTALLING UTHEAD FROM BNUTHEAD, CCS149 FILE 01120*OPEN,FN=BNUTHEAD,OW=CCS149,LU=21,R 01130*REW,21 01140*K,L14 01150*LIBEDT 01160*K,I21,P8 01170*L,UTHEAD 01180*Z 01190*K,I13 01200*CLOSE 01210*CTO, SUBROUTINE UTHEAD HAS BEEN INSTALLED 01220*CTO, 01230*CTO, INSTALLING VFYACF FROM BNVFYACF, CCS149 FILE 01240*OPEN,FN=BNVFYACF,OW=CCS149,LU=21,R 01250*REW,21 01260*K,L14 01270*LIBEDT 01280*K,I21,P8 01290*L,VFYACF 01300*Z 01310*K,I13 01320*CLOSE 01330*CTO, SUBROUTINE VFYACF HAS BEEN INSTALLED 01340*CTO, 01350*CTO, INSTALLING ACTADD FROM B.ACTADD, CCS149 FILE 01360*OPEN,FN=B.ACTADD,OW=CCS149,LU=21,R 01370*REW,21 01380*K,L14 01390*LIBEDT 01400*K,I21,P8 01410*P,F,2 01420*K,I8 01430*N,ACTADD,,,B 01440*Z 01450*K,I13 01460*CLOSE 01470*CTO, PROGRAM ACTADD HAS BEEN INSTALLED 01480*CTO, 01490*CTO, INSTALLING ACTMTN FROM B.ACTMTN, CCS149 FILE 01500*OPEN,FN=B.ACTMTN,OW=CCS149,LU=21,R 01510*REW,21 01520*K,L14 01530*LIBEDT 01540*K,I21,P8 01550*P,F,2 01560*K,I8 01570*N,ACTMTN,,,B 01580*Z 01590*K,I13 01600*CLOSE 01610*CTO, PROGRAM ACTMTN HAS BEEN INSTALLED 01620*CTO, 01630*CTO, INSTALLING AVMCON FROM B.AVMCON, CCS149 FILE 01640*OPEN,FN=B.AVMCON,OW=CCS149,LU=21,R 01650*REW,21 01660*K,L14 01670*LIBEDT 01680*K,I21,P8 01690*P,F,2 01700*K,I8 01710*N,AVMCON,,,B 01720*Z 01730*K,I13 01740*CLOSE 01750*CTO, PROGRAM AVMCON HAS BEEN INSTALLED 01760*CTO, 01770*CTO, INSTALLING CCSDMP FROM B.CCSDMP, CCS149 FILE 01780*OPEN,FN=B.CCSDMP,OW=CCS149,LU=21,R 01790*REW,21 01800*K,L14 01810*LIBEDT 01820*K,I21,P8 01830*P,F,2 01840*K,I8 01850*N,CCSDMP,,,B 01860*Z 01870*K,I13 01880*CLOSE 01890*CTO, PROGRAM CCSDMP HAS BEEN INSTALLED 01900*CTO, 01910*CTO, INSTALLING CCSSPC FROM B.CCSSPC, CCS149 FILE 01920*OPEN,FN=B.CCSSPC,OW=CCS149,LU=21,R 01930*REW,21 01940*K,L14 01950*LIBEDT 01960*K,I21,P8 01970*P,F,2 01980*K,I8 01990*N,CCSSPC,,,B 02000*Z 02010*K,I13 02020*CLOSE 02030*CTO, PROGRAM CCSSPC HAS BEEN INSTALLED 02040*CTO, 02050*CTO, INSTALLING CHEKID FROM B.CHEKID, CCS149 FILE 02060*OPEN,FN=B.CHEKID,OW=CCS149,LU=21,R 02070*REW,21 02080*K,L14 02090*LIBEDT 02100*K,I21,P8 02110*P,F,2 02120*K,I8 02130*N,CHEKID,,,B 02140*Z 02150*K,I13 02160*CLOSE 02170*CTO, PROGRAM CHEKID HAS BEEN INSTALLED 02180*CTO, 02190*CTO, INSTALLING CHUPD2 FROM B.CHUPD2, CCS149 FILE 02200*OPEN,FN=B.CHUPD2,OW=CCS149,LU=21,R 02210*REW,21 02220*K,L14 02230*LIBEDT 02240*K,I21,P8 02250*P,F,2 02260*K,I8 02270*N,CHUPD2,,,B 02280*Z 02290*K,I13 02300*CLOSE 02310*CTO, PROGRAM CHUPD2 HAS BEEN INSTALLED 02320*CTO, 02330*CTO, INSTALLING CMPACC FROM B.CMPACC, CCS149 FILE 02340*OPEN,FN=B.CMPACC,OW=CCS149,LU=21,R 02350*REW,21 02360*K,L14 02370*LIBEDT 02380*K,I21,P8 02390*P,F,2 02400*K,I8 02410*N,CMPACC,,,B 02420*Z 02430*K,I13 02440*CLOSE 02450*CTO, PROGRAM CMPACC HAS BEEN INSTALLED 02460*CTO, 02470*CTO, INSTALLING COLECT FROM B.COLECT, CCS149 FILE 02480*OPEN,FN=B.COLECT,OW=CCS149,LU=21,R 02490*REW,21 02500*K,L14 02510*LIBEDT 02520*K,I21,P8 02530*P,F,2 02540*K,I8 02550*N,COLECT,,,B 02560*Z 02570*K,I13 02580*CLOSE 02590*CTO, PROGRAM COLECT HAS BEEN INSTALLED 02600*CTO, 02610*CTO, INSTALLING COLSTS FROM B.COLSTS, CCS149 FILE 02620*OPEN,FN=B.COLSTS,OW=CCS149,LU=21,R 02630*REW,21 02640*K,L14 02650*LIBEDT 02660*K,I21,P8 02670*P,F,2 02680*K,I8 02690*N,COLSTS,,,B 02700*Z 02710*K,I13 02720*CLOSE 02730*CTO, PROGRAM COLSTS HAS BEEN INSTALLED 02740*CTO, 02750*CTO, INSTALLING CPYIND FROM B.CPYIND, CCS149 FILE 02760*OPEN,FN=B.CPYIND,OW=CCS149,LU=21,R 02770*REW,21 02780*K,L14 02790*LIBEDT 02800*K,I21,P8 02810*P,F,2 02820*K,I8 02830*N,CPYIND,,,B 02840*Z 02850*K,I13 02860*CLOSE 02870*CTO, PROGRAM CPYIND HAS BEEN INSTALLED 02880*CTO, 02890*CTO, INSTALLING DECMTN FROM B.DECMTN, CCS149 FILE 02900*OPEN,FN=B.DECMTN,OW=CCS149,LU=21,R 02910*REW,21 02920*K,L14 02930*LIBEDT 02940*K,I21,P8 02950*P,F,2 02960*K,I8 02970*N,DECMTN,,,B 02980*Z 02990*K,I13 03000*CLOSE 03010*CTO, PROGRAM DECMTN HAS BEEN INSTALLED 03020*CTO, 03030*CTO, INSTALLING DHUPDT FROM B.DHUPDT, CCS149 FILE 03040*OPEN,FN=B.DHUPDT,OW=CCS149,LU=21,R 03050*REW,21 03060*K,L14 03070*LIBEDT 03080*K,I21,P8 03090*P,F,2 03100*K,I8 03110*N,DHUPDT,,,B 03120*Z 03130*K,I13 03140*CLOSE 03150*CTO, PROGRAM DHUPDT HAS BEEN INSTALLED 03160*CTO, 03170*CTO, INSTALLING DMPFIL FROM B.DMPFIL, CCS149 FILE 03180*OPEN,FN=B.DMPFIL,OW=CCS149,LU=21,R 03190*REW,21 03200*K,L14 03210*LIBEDT 03220*K,I21,P8 03230*P,F,2 03240*K,I8 03250*N,DMPFIL,,,B 03260*Z 03270*K,I13 03280*CLOSE 03290*CTO, PROGRAM DMPFIL HAS BEEN INSTALLED 03300*CTO, 03310*CTO, INSTALLING FIXINA FROM B.FIXINA, CCS149 FILE 03320*OPEN,FN=B.FIXINA,OW=CCS149,LU=21,R 03330*REW,21 03340*K,L14 03350*LIBEDT 03360*K,I21,P8 03370*P,F,2 03380*K,I8 03390*N,FIXINA,,,B 03400*Z 03410*K,I13 03420*CLOSE 03430*CTO, PROGRAM FIXINA HAS BEEN INSTALLED 03440*CTO, 03450*CTO, INSTALLING LODFIL FROM B.LODFIL, CCS149 FILE 03460*OPEN,FN=B.LODFIL,OW=CCS149,LU=21,R 03470*REW,21 03480*K,L14 03490*LIBEDT 03500*K,I21,P8 03510*P,F,2 03520*K,I8 03530*N,LODFIL,,,B 03540*Z 03550*K,I13 03560*CLOSE 03570*CTO, PROGRAM LODFIL HAS BEEN INSTALLED 03580*CTO, 03590*CTO, INSTALLING LTRBLD FROM B.LTRBLD, CCS149 FILE 03600*OPEN,FN=B.LTRBLD,OW=CCS149,LU=21,R 03610*REW,21 03620*K,L14 03630*LIBEDT 03640*K,I21,P8 03650*P,F,2 03660*K,I8 03670*N,LTRBLD,,,B 03680*Z 03690*K,I13 03700*CLOSE 03710*CTO, PROGRAM LTRBLD HAS BEEN INSTALLED 03720*CTO, 03730*CTO, INSTALLING LTRPRT FROM B.LTRPRT, CCS149 FILE 03740*OPEN,FN=B.LTRPRT,OW=CCS149,LU=21,R 03750*REW,21 03760*K,L14 03770*LIBEDT 03780*K,I21,P8 03790*P,F,2 03800*K,I8 03810*N,LTRPRT,,,B 03820*Z 03830*K,I13 03840*CLOSE 03850*CTO, PROGRAM LTRPRT HAS BEEN INSTALLED 03860*CTO, 03870*CTO, INSTALLING LTRSTA FROM B.LTRSTA, CCS149 FILE 03880*OPEN,FN=B.LTRSTA,OW=CCS149,LU=21,R 03890*REW,21 03900*K,L14 03910*LIBEDT 03920*K,I21,P8 03930*P,F,2 03940*K,I8 03950*N,LTRSTA,,,B 03960*Z 03970*K,I13 03980*CLOSE 03990*CTO, PROGRAM LTRSTA HAS BEEN INSTALLED 04000*CTO, 04010*CTO, INSTALLING MHUPDT FROM B.MHUPDT, CCS149 FILE 04020*OPEN,FN=B.MHUPDT,OW=CCS149,LU=21,R 04030*REW,21 04040*K,L14 04050*LIBEDT 04060*K,I21,P8 04070*P,F,2 04080*K,I8 04090*N,MHUPDT,,,B 04100*Z 04110*K,I13 04120*CLOSE 04130*CTO, PROGRAM MHUPDT HAS BEEN INSTALLED 04140*CTO, 04150*CTO, INSTALLING NEWS FROM B.NEWS, CCS149 FILE 04160*OPEN,FN=B.NEWS,OW=CCS149,LU=21,R 04170*REW,21 04180*K,L14 04190*LIBEDT 04200*K,I21,P8 04210*P,F,2 04220*K,I8 04230*N,NEWS,,,B 04240*Z 04250*K,I13 04260*CLOSE 04270*CTO, PROGRAM NEWS HAS BEEN INSTALLED 04280*CTO, 04290*CTO, INSTALLING NMCHNG FROM B.NMCHNG, CCS149 FILE 04300*OPEN,FN=B.NMCHNG,OW=CCS149,LU=21,R 04310*REW,21 04320*K,L14 04330*LIBEDT 04340*K,I21,P8 04350*P,F,2 04360*K,I8 04370*N,NMCHNG,,,B 04380*Z 04390*K,I13 04400*CLOSE 04410*CTO, PROGRAM NMCHNG HAS BEEN INSTALLED 04420*CTO, 04430*CTO, INSTALLING PGGEN FROM B.PGGEN, CCS149 FILE 04440*OPEN,FN=B.PGGEN,OW=CCS149,LU=21,R 04450*REW,21 04460*K,L14 04470*LIBEDT 04480*K,I21,P8 04490*P,F,2 04500*K,I8 04510*N,PGGEN,,,B 04520*Z 04530*K,I13 04540*CLOSE 04550*CTO, PROGRAM PGGEN HAS BEEN INSTALLED 04560*CTO, 04570*CTO, INSTALLING PHDEL1 FROM B.PHDEL1, CCS149 FILE 04580*OPEN,FN=B.PHDEL1,OW=CCS149,LU=21,R 04590*REW,21 04600*K,L14 04610*LIBEDT 04620*K,I21,P8 04630*P,F,2 04640*K,I8 04650*N,PHDEL1,,,B 04660*Z 04670*K,I13 04680*CLOSE 04690*CTO, PROGRAM PHDEL1 HAS BEEN INSTALLED 04700*CTO, 04710*CTO, INSTALLING PHDEL2 FROM B.PHDEL2, CCS149 FILE 04720*OPEN,FN=B.PHDEL2,OW=CCS149,LU=21,R 04730*REW,21 04740*K,L14 04750*LIBEDT 04760*K,I21,P8 04770*P,F,2 04780*K,I8 04790*N,PHDEL2,,,B 04800*Z 04810*K,I13 04820*CLOSE 04830*CTO, PROGRAM PHDEL2 HAS BEEN INSTALLED 04840*CTO, 04850*CTO, INSTALLING PRETSR FROM B.PRETSR, CCS149 FILE 04860*OPEN,FN=B.PRETSR,OW=CCS149,LU=21,R 04870*REW,21 04880*K,L14 04890*LIBEDT 04900*K,I21,P8 04910*P,F,2 04920*K,I8 04930*N,PRETSR,,,B 04940*Z 04950*K,I13 04960*CLOSE 04970*CTO, PROGRAM PRETSR HAS BEEN INSTALLED 04980*CTO, 04990*CTO, INSTALLING PRTSCN FROM B.PRTSCN, CCS149 FILE 05000*OPEN,FN=B.PRTSCN,OW=CCS149,LU=21,R 05010*REW,21 05020*K,L14 05030*LIBEDT 05040*K,I21,P8 05050*P,F,2 05060*K,I8 05070*N,PRTSCN,,,B 05080*Z 05090*K,I13 05100*CLOSE 05110*CTO, PROGRAM PRTSCN HAS BEEN INSTALLED 05120*CTO, 05130*CTO, INSTALLING QLOAD FROM B.QLOAD, CCS149 FILE 05140*OPEN,FN=B.QLOAD,OW=CCS149,LU=21,R 05150*REW,21 05160*K,L14 05170*LIBEDT 05180*K,I21,P8 05190*P,F,2 05200*K,I8 05210*N,QLOAD,,,B 05220*Z 05230*K,I13 05240*CLOSE 05250*CTO, PROGRAM QLOAD HAS BEEN INSTALLED 05260*CTO, 05270*CTO, INSTALLING RSWCHG FROM B.RSWCHG, CCS149 FILE 05280*OPEN,FN=B.RSWCHG,OW=CCS149,LU=21,R 05290*REW,21 05300*K,L14 05310*LIBEDT 05320*K,I21,P8 05330*P,F,2 05340*K,I8 05350*N,RSWCHG,,,B 05360*Z 05370*K,I13 05380*CLOSE 05390*CTO, PROGRAM RSWCHG HAS BEEN INSTALLED 05400*CTO, 05410*CTO, INSTALLING SRREQ FROM B.SRREQ, CCS149 FILE 05420*OPEN,FN=B.SRREQ,OW=CCS149,LU=21,R 05430*REW,21 05440*K,L14 05450*LIBEDT 05460*K,I21,P8 05470*P,F,2 05480*K,I8 05490*N,SRREQ,,,B 05500*Z 05510*K,I13 05520*CLOSE 05530*CTO, PROGRAM SRREQ HAS BEEN INSTALLED 05540*CTO, 05550*CTO, INSTALLING SUMACL FROM B.SUMACL, CCS149 FILE 05560*OPEN,FN=B.SUMACL,OW=CCS149,LU=21,R 05570*REW,21 05580*K,L14 05590*LIBEDT 05600*K,I21,P8 05610*P,F,2 05620*K,I8 05630*N,SUMACL,,,B 05640*Z 05650*K,I13 05660*CLOSE 05670*CTO, PROGRAM SUMACL HAS BEEN INSTALLED 05680*CTO, 05690*CTO, INSTALLING TRENDF FROM B.TRENDF, CCS149 FILE 05700*OPEN,FN=B.TRENDF,OW=CCS149,LU=21,R 05710*REW,21 05720*K,L14 05730*LIBEDT 05740*K,I21,P8 05750*P,F,2 05760*K,I8 05770*N,TRENDF,,,B 05780*Z 05790*K,I13 05800*CLOSE 05810*CTO, PROGRAM TRENDF HAS BEEN INSTALLED 05820*CTO, 05830*CTO, INSTALLING TRNPLY FROM B.TRNPLY, CCS149 FILE 05840*OPEN,FN=B.TRNPLY,OW=CCS149,LU=21,R 05850*REW,21 05860*K,L14 05870*LIBEDT 05880*K,I21,P8 05890*P,F,2 05900*K,I8 05910*N,TRNPLY,,,B 05920*Z 05930*K,I13 05940*CLOSE 05950*CTO, PROGRAM TRNPLY HAS BEEN INSTALLED 05960*CTO, 05970*CTO, INSTALLING UPD400 FROM B.UPD400, CCS149 FILE 05980*OPEN,FN=B.UPD400,OW=CCS149,LU=21,R 05990*REW,21 06000*K,L14 06010*LIBEDT 06020*K,I21,P8 06030*P,F,2 06040*K,I8 06050*N,UPD400,,,B 06060*Z 06070*K,I13 06080*CLOSE 06090*CTO, PROGRAM UPD400 HAS BEEN INSTALLED 06100*CTO, 06110*CTO, INSTALLING UPD500 FROM B.UPD500, CCS149 FILE 06120*OPEN,FN=B.UPD500,OW=CCS149,LU=21,R 06130*REW,21 06140*K,L14 06150*LIBEDT 06160*K,I21,P8 06170*P,F,2 06180*K,I8 06190*N,UPD500,,,B 06200*Z 06210*K,I13 06220*CLOSE 06230*CTO, PROGRAM UPD500 HAS BEEN INSTALLED 06240*CTO, 06250*CTO, INSTALLING UPDATE FROM B.UPDATE, CCS149 FILE 06260*OPEN,FN=B.UPDATE,OW=CCS149,LU=21,R 06270*REW,21 06280*K,L14 06290*LIBEDT 06300*K,I21,P8 06310*P,F,2 06320*K,I8 06330*N,UPDATE,,,B 06340*Z 06350*K,I13 06360*CLOSE 06370*CTO, PROGRAM UPDATE HAS BEEN INSTALLED 06380*CTO, 06390*CTO, INSTALLING USEMTN FROM B.USEMTN, CCS149 FILE 06400*OPEN,FN=B.USEMTN,OW=CCS149,LU=21,R 06410*REW,21 06420*K,L14 06430*LIBEDT 06440*K,I21,P8 06450*P,F,2 06460*K,I8 06470*N,USEMTN,,,B 06480*Z 06490*K,I13 06500*CLOSE 06510*CTO, PROGRAM USEMTN HAS BEEN INSTALLED 06520*CTO, 06530*CTO, INSTALLING UTFMTN FROM B.UTFMTN, CCS149 FILE 06540*OPEN,FN=B.UTFMTN,OW=CCS149,LU=21,R 06550*REW,21 06560*K,L14 06570*LIBEDT 06580*K,I21,P8 06590*P,F,2 06600*K,I8 06610*N,UTFMTN,,,B 06620*Z 06630*K,I13 06640*CLOSE 06650*CTO, PROGRAM UTFMTN HAS BEEN INSTALLED 06660*CTO, 06670*CTO, INSTALLING WRTOFE FROM B.WRTOFE, CCS149 FILE 06680*OPEN,FN=B.WRTOFE,OW=CCS149,LU=21,R 06690*REW,21 06700*K,L14 06710*LIBEDT 06720*K,I21,P8 06730*P,F,2 06740*K,I8 06750*N,WRTOFE,,,B 06760*Z 06770*K,I13 06780*CLOSE 06790*CTO, PROGRAM WRTOFE HAS BEEN INSTALLED 06800*CTO, 06810*CTO, INSTALLING REBILD FROM B.REBILD, LIBRARY FILE 06820*OPEN,FN=B.REBILD,OW=LIBRARY,LU=21,R 06830*REW,21 06840*K,L14 06850*LIBEDT 06860*K,I21,P8 06870*P,F,2 06880*K,I8 06890*N,REBILD,,,B 06900*Z 06910*K,I13 06920*CLOSE 06930*CTO, PROGRAM REBILD HAS BEEN INSTALLED 06940*CTO, 06950*CTO, INSTALLING PROVE FROM B.PROVE, LIBRARY FILE 06960*OPEN,FN=B.PROVE,OW=LIBRARY,LU=21,R 06970*REW,21 06980*K,L14 06990*LIBEDT 07000*K,I21,P8 07010*P,F,2 07020*K,I8 07030*N,PROVE,,,B 07040*Z 07050*K,I13 07060*CLOSE 07070*CTO, PROGRAM PROVE HAS BEEN INSTALLED 07080*CTO, 07090*CTO, 07100*CTO, INSTALL C O M P L E T E !!! 07110*Z 07120_  __ (>s <|J.CCSADDCCS149 P032883(*JOB,, CCSADD INSTALL 02/01/82 00010*K,L14 00020*CTO, CCSADD WEAVED AS OF 02/01/82 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BNCCSADD 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BNCCSADD,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CCSADD DCK/ I,H 00130 DEL/ 1 00140 NAM CCSADD A02 A CCS CCS 3.0 PSR'D SL-149 00150 DEL/ 85 00160 LDQ (POS1) STARTING POSITION IN FIRST ARRAY ???*A010 00170 DEL/ 89 00180 ADD ARR1 ADD ADDR TO ARRAY 1 TO GET ACTUAL ADDR???*A010 00190 DEL/ 93 00200 LDQ (POS1) LOAD Q WITH POSITION IN ARRAY OF FIRST???*A010 00210 DEL/ 99,109 00220 INA -$3A ???*A010 00230 SAM L03 SENSE DIGIT ASCII, BYPASS CONVERSION ???*A010 00240 INA -$4A+$3A ???*A010 00250 SAP L01 SENSE NOT POSITIVE DIGIT ???*A010 00260 INA -$10+$4A CONVERT POS. DIGIT($41-$49=POS. DIGITS???*A010 00270 JMP* L02 ???*A010 00280L01 INA -$7B+$4A ???*A010 00290 SAN L04 SENSE NOT POSITIVE ZERO ???*A010 00300 ENA $30 CONVERT POS. ZERO ???*A010 00310L02 SCA* (ARR1),Q STORE CONVERTED CHAR. ???*A010 00320L03 JMP* ISPOS1 ???*A010 00330L04 INA -$7D+$7B ???*A010 00340 SAZ ISZR1 SENSE NEG. ZERO ???*A010 00350 INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00360 DEL/ 157,167 00370 INA -$3A ???*A010 00380 SAM L13 SENSE DIGIT ASCII, BYPASS CONVERSION ???*A010 00390 INA -$4A+$3A ???*A010 00400 SAP L11 SENSE NOT POSITIVE DIGIT ???*A010 00410 INA -$10+$4A CONVERT POS. DIGIT ???*A010 00420 JMP* L12 ???*A010 00430L11 INA -$7B+$4A ???*A010 00440 SAN L14 SENSE NOT POSITIVE ZERO ???*A010 00450 ENA $30 CONVERT POS. ZERO ???*A010 00460L12 SCA* (ARR2),Q STORE CONVERTED CHAR. ???*A010 00470L13 JMP* ISPOS2 ???*A010 00480L14 INA -$7D+$7B ???*A010 00490 SAZ ISZR2 SENSE NEG. ZERO ???*A010 00500 INA -$19+$7D ???*A010 00510 END/ 00520*REW,7 00530*K,I7,P21,L02 00540*ASSEM 00550*EOF 00560*CLOSE 00570*K,I13,L14 00580*Z 00590*Z 00600__ INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00360 DEL/ 157,167 00370 INA -$3A ???*A010 00380 SAM L13 SENSE DIGIT ASCII, BYPASS CONVERSION ???*A010 00390 INA -$4A+$3A ???*A010 00400 SAP L11 SENSE NOT POSITIVE DIGIT ???*A010 00410 INA -$10+$4A CONVERT POS. DIGIT ???*A010 00420 JMP* L12 ???*A010 00430L11 INA -$7B+$4A ???*A010 00440 SAN L14 SENSE NOT POSITIVE ZERO ???*A010 00450 ENA $30 CONVERT POS. ZERO ???*A010 00460L12 SCA* (ARR2),Q STORE CONVERTED CHAR. ???*A010 00470L13 JMP* ISPOS2 ???*A010 00480L14 INA -$7D+$7B ???*A010 00490 SAZ ISZR2 SENSE NEG. ZERO ???*A010 00500("$ ~J.CCSEACCCS149 P032883(*JOB,, CCSEAC INSTALL 02/01/82 00010*K,L14 00020*CTO, CCSEAC WEAVED AS OF 02/01/82 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BNCCSEAC 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BNCCSEAC,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CCSEAC DCK/ I,H 00130 DEL/ 1 00140 NAM CCSEAC A05 A CCS CCS 3.0 PSR'D SL-149 00150 INS/ 45 00160* ****************************************************** ???*A010 00170* 30 0 C0 00180* ***************************************************** ???*A010 00190 DEL/ 235 00200 NUM $3041 C0 - C1 0 A ???*A010 00210 DEL/ 331 00220 NUM $00C0 7A - 7B POSITIVE 0 ???*A010 00230 END/ 00240*REW,7 00250*K,I7,P21,L02 00260*ASSEM 00270*EOF 00280*CLOSE 00290*K,I13,L14 00300*Z 00310*Z 00320__N,FN=BNCCSEAC,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CCSEAC DCK/ I,H 00130 DEL/ 1 00140 NAM CCSEAC A05 A CCS CCS 3.0 PSR'D SL-149 00150 INS/ 45 00160* ****************************************************** ???*A010 00170* 30 0 C0 00180* ***************************************************** ???*A010 00190 DEL/ 235 00200 NUM $3041 C0 - C1 0 A ???*A010 00210 DEL/ 331 00220 NUM $00C0 7A - 7B POSITIVE 0 ???*A010 00230 END/ 00240*REW,7 00250( , ZJ.*TB. CCS149 P(*JOB,, TRANSFER BINARYS TO B.INSTAL FOR CCS/LA LOOK ALIKES.. 00010*CTO, *T FOR LOOK ALIKE PROGRAMS TO B.INSTAL 00020*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,W 00030*REW,20 00040*CLOSE 00050*CTO, MOVING BNCCSADD, CCS149 TO B.INSTAL, CCS149 00060*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00070*BSR,20,1 00080*OPEN,FN=BNCCSADD,OW=CCS149,LU=21,R 00090*REW,21 00100*LIBEDT 00110*T,21,B,20,B,,1 00120*Z 00130*CLOSE 00140*CTO, MOVING BNCCSDVD, CCS149 TO B.INSTAL, CCS149 00150*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00160*BSR,20,1 00170*OPEN,FN=BNCCSDVD,OW=CCS149,LU=21,R 00180*REW,21 00190*LIBEDT 00200*T,21,B,20,B,,1 00210*Z 00220*CLOSE 00230*CTO, MOVING BNCCSEAC, CCS149 TO B.INSTAL, CCS149 00240*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00250*BSR,20,1 00260*OPEN,FN=BNCCSEAC,OW=CCS149,LU=21,R 00270*REW,21 00280*LIBEDT 00290*T,21,B,20,B,,1 00300*Z 00310*CLOSE 00320*CTO, MOVING BNCCSMTP, CCS149 TO B.INSTAL, CCS149 00330*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00340*BSR,20,1 00350*OPEN,FN=BNCCSMTP,OW=CCS149,LU=21,R 00360*REW,21 00370*LIBEDT 00380*T,21,B,20,B,,1 00390*Z 00400*CLOSE 00410*CTO, MOVING BNCCSSBT, CCS149 TO B.INSTAL, CCS149 00420*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00430*BSR,20,1 00440*OPEN,FN=BNCCSSBT,OW=CCS149,LU=21,R 00450*REW,21 00460*LIBEDT 00470*T,21,B,20,B,,1 00480*Z 00490*CLOSE 00500*CTO, MOVING BNEDIT, CCS149 TO B.INSTAL, CCS149 00510*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00520*BSR,20,1 00530*OPEN,FN=BNEDIT,OW=CCS149,LU=21,R 00540*REW,21 00550*LIBEDT 00560*T,21,B,20,B,,1 00570*Z 00580*CLOSE 00590*CTO, MOVING BNFILERR, CCS149 TO B.INSTAL, CCS149 00600*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00610*BSR,20,1 00620*OPEN,FN=BNFILERR,OW=CCS149,LU=21,R 00630*REW,21 00640*LIBEDT 00650*T,21,B,20,B,,1 00660*Z 00670*CLOSE 00680*CTO, MOVING BNFTNDT1, CCS149 TO B.INSTAL, CCS149 00690*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00700*BSR,20,1 00710*OPEN,FN=BNFTNDT1,OW=CCS149,LU=21,R 00720*REW,21 00730*LIBEDT 00740*T,21,B,20,B,,1 00750*Z 00760*CLOSE 00770*CTO, MOVING BNGETGRP, CCS149 TO B.INSTAL, CCS149 00780*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00790*BSR,20,1 00800*OPEN,FN=BNGETGRP,OW=CCS149,LU=21,R 00810*REW,21 00820*LIBEDT 00830*T,21,B,20,B,,1 00840*Z 00850*CLOSE 00860*CTO, MOVING BNGETSW, CCS149 TO B.INSTAL, CCS149 00870*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00880*BSR,20,1 00890*OPEN,FN=BNGETSW,OW=CCS149,LU=21,R 00900*REW,21 00910*LIBEDT 00920*T,21,B,20,B,,1 00930*Z 00940*CLOSE 00950*CTO, MOVING BNGETUTI, CCS149 TO B.INSTAL, CCS149 00960*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 00970*BSR,20,1 00980*OPEN,FN=BNGETUTI,OW=CCS149,LU=21,R 00990*REW,21 01000*LIBEDT 01010*T,21,B,20,B,,1 01020*Z 01030*CLOSE 01040*CTO, MOVING BNGTSYSP, CCS149 TO B.INSTAL, CCS149 01050*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01060*BSR,20,1 01070*OPEN,FN=BNGTSYSP,OW=CCS149,LU=21,R 01080*REW,21 01090*LIBEDT 01100*T,21,B,20,B,,1 01110*Z 01120*CLOSE 01130*CTO, MOVING BNICKGRP, CCS149 TO B.INSTAL, CCS149 01140*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01150*BSR,20,1 01160*OPEN,FN=BNICKGRP,OW=CCS149,LU=21,R 01170*REW,21 01180*LIBEDT 01190*T,21,B,20,B,,1 01200*Z 01210*CLOSE 01220*CTO, MOVING BNLTPRNT, CCS149 TO B.INSTAL, CCS149 01230*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01240*BSR,20,1 01250*OPEN,FN=BNLTPRNT,OW=CCS149,LU=21,R 01260*REW,21 01270*LIBEDT 01280*T,21,B,20,B,,1 01290*Z 01300*CLOSE 01310*CTO, MOVING BNPRTORF, CCS149 TO B.INSTAL, CCS149 01320*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01330*BSR,20,1 01340*OPEN,FN=BNPRTORF,OW=CCS149,LU=21,R 01350*REW,21 01360*LIBEDT 01370*T,21,B,20,B,,1 01380*Z 01390*CLOSE 01400*CTO, MOVING BNQCST, CCS149 TO B.INSTAL, CCS149 01410*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01420*BSR,20,1 01430*OPEN,FN=BNQCST,OW=CCS149,LU=21,R 01440*REW,21 01450*LIBEDT 01460*T,21,B,20,B,,1 01470*Z 01480*CLOSE 01490*CTO, MOVING BNSYSPRT, CCS149 TO B.INSTAL, CCS149 01500*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01510*BSR,20,1 01520*OPEN,FN=BNSYSPRT,OW=CCS149,LU=21,R 01530*REW,21 01540*LIBEDT 01550*T,21,B,20,B,,1 01560*Z 01570*CLOSE 01580*CTO, MOVING BNUTHEAD, CCS149 TO B.INSTAL, CCS149 01590*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01600*BSR,20,1 01610*OPEN,FN=BNUTHEAD,OW=CCS149,LU=21,R 01620*REW,21 01630*LIBEDT 01640*T,21,B,20,B,,1 01650*Z 01660*CLOSE 01670*CTO, MOVING BNVFYACF, CCS149 TO B.INSTAL, CCS149 01680*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01690*BSR,20,1 01700*OPEN,FN=BNVFYACF,OW=CCS149,LU=21,R 01710*REW,21 01720*LIBEDT 01730*T,21,B,20,B,,1 01740*Z 01750*CLOSE 01760*CTO, MOVING B.ACTADD, CCS149 TO B.INSTAL, CCS149 01770*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01780*BSR,20,1 01790*OPEN,FN=B.ACTADD,OW=CCS149,LU=21,R 01800*REW,21 01810*LIBEDT 01820*T,21,B,20,B,,1 01830*Z 01840*CLOSE 01850*CTO, MOVING B.ACTMTN, CCS149 TO B.INSTAL, CCS149 01860*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01870*BSR,20,1 01880*OPEN,FN=B.ACTMTN,OW=CCS149,LU=21,R 01890*REW,21 01900*LIBEDT 01910*T,21,B,20,B,,1 01920*Z 01930*CLOSE 01940*CTO, MOVING B.AVMCON, CCS149 TO B.INSTAL, CCS149 01950*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 01960*BSR,20,1 01970*OPEN,FN=B.AVMCON,OW=CCS149,LU=21,R 01980*REW,21 01990*LIBEDT 02000*T,21,B,20,B,,1 02010*Z 02020*CLOSE 02030*CTO, MOVING B.CCSDMP, CCS149 TO B.INSTAL, CCS149 02040*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02050*BSR,20,1 02060*OPEN,FN=B.CCSDMP,OW=CCS149,LU=21,R 02070*REW,21 02080*LIBEDT 02090*T,21,B,20,B,,1 02100*Z 02110*CLOSE 02120*CTO, MOVING B.CCSSPC, CCS149 TO B.INSTAL, CCS149 02130*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02140*BSR,20,1 02150*OPEN,FN=B.CCSSPC,OW=CCS149,LU=21,R 02160*REW,21 02170*LIBEDT 02180*T,21,B,20,B,,1 02190*Z 02200*CLOSE 02210*CTO, MOVING B.CHEKID, CCS149 TO B.INSTAL, CCS149 02220*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02230*BSR,20,1 02240*OPEN,FN=B.CHEKID,OW=CCS149,LU=21,R 02250*REW,21 02260*LIBEDT 02270*T,21,B,20,B,,1 02280*Z 02290*CLOSE 02300*CTO, MOVING B.CHUPD2, CCS149 TO B.INSTAL, CCS149 02310*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02320*BSR,20,1 02330*OPEN,FN=B.CHUPD2,OW=CCS149,LU=21,R 02340*REW,21 02350*LIBEDT 02360*T,21,B,20,B,,1 02370*Z 02380*CLOSE 02390*CTO, MOVING B.CMPACC, CCS149 TO B.INSTAL, CCS149 02400*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02410*BSR,20,1 02420*OPEN,FN=B.CMPACC,OW=CCS149,LU=21,R 02430*REW,21 02440*LIBEDT 02450*T,21,B,20,B,,1 02460*Z 02470*CLOSE 02480*CTO, MOVING B.COLCHG, CCS149 TO B.INSTAL, CCS149 02490*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02500*BSR,20,1 02510*OPEN,FN=B.COLCHG,OW=CCS149,LU=21,R 02520*REW,21 02530*LIBEDT 02540*T,21,B,20,B,,1 02550*Z 02560*CLOSE 02570*CTO, MOVING B.COLECT, CCS149 TO B.INSTAL, CCS149 02580*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02590*BSR,20,1 02600*OPEN,FN=B.COLECT,OW=CCS149,LU=21,R 02610*REW,21 02620*LIBEDT 02630*T,21,B,20,B,,1 02640*Z 02650*CLOSE 02660*CTO, MOVING B.COLSTS, CCS149 TO B.INSTAL, CCS149 02670*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02680*BSR,20,1 02690*OPEN,FN=B.COLSTS,OW=CCS149,LU=21,R 02700*REW,21 02710*LIBEDT 02720*T,21,B,20,B,,1 02730*Z 02740*CLOSE 02750*CTO, MOVING B.CPYIND, CCS149 TO B.INSTAL, CCS149 02760*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02770*BSR,20,1 02780*OPEN,FN=B.CPYIND,OW=CCS149,LU=21,R 02790*REW,21 02800*LIBEDT 02810*T,21,B,20,B,,1 02820*Z 02830*CLOSE 02840*CTO, MOVING B.DALIST, CCS149 TO B.INSTAL, CCS149 02850*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02860*BSR,20,1 02870*OPEN,FN=B.DALIST,OW=CCS149,LU=21,R 02880*REW,21 02890*LIBEDT 02900*T,21,B,20,B,,1 02910*Z 02920*CLOSE 02930*CTO, MOVING B.DECMTN, CCS149 TO B.INSTAL, CCS149 02940*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 02950*BSR,20,1 02960*OPEN,FN=B.DECMTN,OW=CCS149,LU=21,R 02970*REW,21 02980*LIBEDT 02990*T,21,B,20,B,,1 03000*Z 03010*CLOSE 03020*CTO, MOVING B.DHUPDT, CCS149 TO B.INSTAL, CCS149 03030*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03040*BSR,20,1 03050*OPEN,FN=B.DHUPDT,OW=CCS149,LU=21,R 03060*REW,21 03070*LIBEDT 03080*T,21,B,20,B,,1 03090*Z 03100*CLOSE 03110*CTO, MOVING B.DMPFIL, CCS149 TO B.INSTAL, CCS149 03120*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03130*BSR,20,1 03140*OPEN,FN=B.DMPFIL,OW=CCS149,LU=21,R 03150*REW,21 03160*LIBEDT 03170*T,21,B,20,B,,1 03180*Z 03190*CLOSE 03200*CTO, MOVING B.FIXINA, CCS149 TO B.INSTAL, CCS149 03210*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03220*BSR,20,1 03230*OPEN,FN=B.FIXINA,OW=CCS149,LU=21,R 03240*REW,21 03250*LIBEDT 03260*T,21,B,20,B,,1 03270*Z 03280*CLOSE 03290*CTO, MOVING B.LODFIL, CCS149 TO B.INSTAL, CCS149 03300*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03310*BSR,20,1 03320*OPEN,FN=B.LODFIL,OW=CCS149,LU=21,R 03330*REW,21 03340*LIBEDT 03350*T,21,B,20,B,,1 03360*Z 03370*CLOSE 03380*CTO, MOVING B.LTRBLD, CCS149 TO B.INSTAL, CCS149 03390*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03400*BSR,20,1 03410*OPEN,FN=B.LTRBLD,OW=CCS149,LU=21,R 03420*REW,21 03430*LIBEDT 03440*T,21,B,20,B,,1 03450*Z 03460*CLOSE 03470*CTO, MOVING B.LTRPRT, CCS149 TO B.INSTAL, CCS149 03480*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03490*BSR,20,1 03500*OPEN,FN=B.LTRPRT,OW=CCS149,LU=21,R 03510*REW,21 03520*LIBEDT 03530*T,21,B,20,B,,1 03540*Z 03550*CLOSE 03560*CTO, MOVING B.LTRSTA, CCS149 TO B.INSTAL, CCS149 03570*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03580*BSR,20,1 03590*OPEN,FN=B.LTRSTA,OW=CCS149,LU=21,R 03600*REW,21 03610*LIBEDT 03620*T,21,B,20,B,,1 03630*Z 03640*CLOSE 03650*CTO, MOVING B.MHUPDT, CCS149 TO B.INSTAL, CCS149 03660*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03670*BSR,20,1 03680*OPEN,FN=B.MHUPDT,OW=CCS149,LU=21,R 03690*REW,21 03700*LIBEDT 03710*T,21,B,20,B,,1 03720*Z 03730*CLOSE 03740*CTO, MOVING B.NEWS, CCS149 TO B.INSTAL, CCS149 03750*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03760*BSR,20,1 03770*OPEN,FN=B.NEWS,OW=CCS149,LU=21,R 03780*REW,21 03790*LIBEDT 03800*T,21,B,20,B,,1 03810*Z 03820*CLOSE 03830*CTO, MOVING B.NMCHNG, CCS149 TO B.INSTAL, CCS149 03840*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03850*BSR,20,1 03860*OPEN,FN=B.NMCHNG,OW=CCS149,LU=21,R 03870*REW,21 03880*LIBEDT 03890*T,21,B,20,B,,1 03900*Z 03910*CLOSE 03920*CTO, MOVING B.PGGEN, CCS149 TO B.INSTAL, CCS149 03930*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 03940*BSR,20,1 03950*OPEN,FN=B.PGGEN,OW=CCS149,LU=21,R 03960*REW,21 03970*LIBEDT 03980*T,21,B,20,B,,1 03990*Z 04000*CLOSE 04010*CTO, MOVING B.PHDEL1, CCS149 TO B.INSTAL, CCS149 04020*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04030*BSR,20,1 04040*OPEN,FN=B.PHDEL1,OW=CCS149,LU=21,R 04050*REW,21 04060*LIBEDT 04070*T,21,B,20,B,,1 04080*Z 04090*CLOSE 04100*CTO, MOVING B.PHDEL2, CCS149 TO B.INSTAL, CCS149 04110*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04120*BSR,20,1 04130*OPEN,FN=B.PHDEL2,OW=CCS149,LU=21,R 04140*REW,21 04150*LIBEDT 04160*T,21,B,20,B,,1 04170*Z 04180*CLOSE 04190*CTO, MOVING B.PRETSR, CCS149 TO B.INSTAL, CCS149 04200*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04210*BSR,20,1 04220*OPEN,FN=B.PRETSR,OW=CCS149,LU=21,R 04230*REW,21 04240*LIBEDT 04250*T,21,B,20,B,,1 04260*Z 04270*CLOSE 04280*CTO, MOVING B.PROVE, LIBRARY TO B.INSTAL, CCS149 04290*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04300*BSR,20,1 04310*OPEN,FN=B.PROVE,OW=LIBRARY,LU=21,R 04320*REW,21 04330*LIBEDT 04340*T,21,B,20,B,,1 04350*Z 04360*CLOSE 04370*CTO, MOVING B.PRTSCN, CCS149 TO B.INSTAL, CCS149 04380*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04390*BSR,20,1 04400*OPEN,FN=B.PRTSCN,OW=CCS149,LU=21,R 04410*REW,21 04420*LIBEDT 04430*T,21,B,20,B,,1 04440*Z 04450*CLOSE 04460*CTO, MOVING B.QLOAD, CCS149 TO B.INSTAL, CCS149 04470*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04480*BSR,20,1 04490*OPEN,FN=B.QLOAD,OW=CCS149,LU=21,R 04500*REW,21 04510*LIBEDT 04520*T,21,B,20,B,,1 04530*Z 04540*CLOSE 04550*CTO, MOVING B.REBILD, LIBRARY TO B.INSTAL, CCS149 04560*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04570*BSR,20,1 04580*OPEN,FN=B.REBILD,OW=LIBRARY,LU=21,R 04590*REW,21 04600*LIBEDT 04610*T,21,B,20,B,,1 04620*Z 04630*CLOSE 04640*CTO, MOVING B.RSWCHG, CCS149 TO B.INSTAL, CCS149 04650*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04660*BSR,20,1 04670*OPEN,FN=B.RSWCHG,OW=CCS149,LU=21,R 04680*REW,21 04690*LIBEDT 04700*T,21,B,20,B,,1 04710*Z 04720*CLOSE 04730*CTO, MOVING B.SRREQ, CCS149 TO B.INSTAL, CCS149 04740*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04750*BSR,20,1 04760*OPEN,FN=B.SRREQ,OW=CCS149,LU=21,R 04770*REW,21 04780*LIBEDT 04790*T,21,B,20,B,,1 04800*Z 04810*CLOSE 04820*CTO, MOVING B.SUMACL, CCS149 TO B.INSTAL, CCS149 04830*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04840*BSR,20,1 04850*OPEN,FN=B.SUMACL,OW=CCS149,LU=21,R 04860*REW,21 04870*LIBEDT 04880*T,21,B,20,B,,1 04890*Z 04900*CLOSE 04910*CTO, MOVING B.SWITCH, CCS149 TO B.INSTAL, CCS149 04920*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 04930*BSR,20,1 04940*OPEN,FN=B.SWITCH,OW=CCS149,LU=21,R 04950*REW,21 04960*LIBEDT 04970*T,21,B,20,B,,1 04980*Z 04990*CLOSE 05000*CTO, MOVING B.TIMUSE, CCS149 TO B.INSTAL, CCS149 05010*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05020*BSR,20,1 05030*OPEN,FN=B.TIMUSE,OW=CCS149,LU=21,R 05040*REW,21 05050*LIBEDT 05060*T,21,B,20,B,,1 05070*Z 05080*CLOSE 05090*CTO, MOVING B.TRENDF, CCS149 TO B.INSTAL, CCS149 05100*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05110*BSR,20,1 05120*OPEN,FN=B.TRENDF,OW=CCS149,LU=21,R 05130*REW,21 05140*LIBEDT 05150*T,21,B,20,B,,1 05160*Z 05170*CLOSE 05180*CTO, MOVING B.TRENDP, CCS149 TO B.INSTAL, CCS149 05190*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05200*BSR,20,1 05210*OPEN,FN=B.TRENDP,OW=CCS149,LU=21,R 05220*REW,21 05230*LIBEDT 05240*T,21,B,20,B,,1 05250*Z 05260*CLOSE 05270*CTO, MOVING B.TRNPLY, CCS149 TO B.INSTAL, CCS149 05280*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05290*BSR,20,1 05300*OPEN,FN=B.TRNPLY,OW=CCS149,LU=21,R 05310*REW,21 05320*LIBEDT 05330*T,21,B,20,B,,1 05340*Z 05350*CLOSE 05360*CTO, MOVING B.UPD400, CCS149 TO B.INSTAL, CCS149 05370*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05380*BSR,20,1 05390*OPEN,FN=B.UPD400,OW=CCS149,LU=21,R 05400*REW,21 05410*LIBEDT 05420*T,21,B,20,B,,1 05430*Z 05440*CLOSE 05450*CTO, MOVING B.UPD500, CCS149 TO B.INSTAL, CCS149 05460*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05470*BSR,20,1 05480*OPEN,FN=B.UPD500,OW=CCS149,LU=21,R 05490*REW,21 05500*LIBEDT 05510*T,21,B,20,B,,1 05520*Z 05530*CLOSE 05540*CTO, MOVING B.UPDATE, CCS149 TO B.INSTAL, CCS149 05550*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05560*BSR,20,1 05570*OPEN,FN=B.UPDATE,OW=CCS149,LU=21,R 05580*REW,21 05590*LIBEDT 05600*T,21,B,20,B,,1 05610*Z 05620*CLOSE 05630*CTO, MOVING B.USEMTN, CCS149 TO B.INSTAL, CCS149 05640*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05650*BSR,20,1 05660*OPEN,FN=B.USEMTN,OW=CCS149,LU=21,R 05670*REW,21 05680*LIBEDT 05690*T,21,B,20,B,,1 05700*Z 05710*CLOSE 05720*CTO, MOVING B.UTFMTN, CCS149 TO B.INSTAL, CCS149 05730*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05740*BSR,20,1 05750*OPEN,FN=B.UTFMTN,OW=CCS149,LU=21,R 05760*REW,21 05770*LIBEDT 05780*T,21,B,20,B,,1 05790*Z 05800*CLOSE 05810*CTO, MOVING B.WRTOFE, CCS149 TO B.INSTAL, CCS149 05820*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05830*BSR,20,1 05840*OPEN,FN=B.WRTOFE,OW=CCS149,LU=21,R 05850*REW,21 05860*LIBEDT 05870*T,21,B,20,B,,1 05880*Z 05890*CLOSE 05900*CTO, MOVING B.WRTOFP, CCS149 TO B.INSTAL, CCS149 05910*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05920*BSR,20,1 05930*OPEN,FN=B.WRTOFP,OW=CCS149,LU=21,R 05940*REW,21 05950*LIBEDT 05960*T,21,B,20,B,,1 05970*Z 05980*CLOSE 05990*CTO, *T COMPLETE........................ 06000*Z 06010*Z 06020__EDT 05780*T,21,B,20,B,,1 05790*Z 05800*CLOSE 05810*CTO, MOVING B.WRTOFE, CCS149 TO B.INSTAL, CCS149 05820*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05830*BSR,20,1 05840*OPEN,FN=B.WRTOFE,OW=CCS149,LU=21,R 05850*REW,21 05860*LIBEDT 05870*T,21,B,20,B,,1 05880*Z 05890*CLOSE 05900*CTO, MOVING B.WRTOFP, CCS149 TO B.INSTAL, CCS149 05910*OPEN,FN=B.INSTAL,OW=CCS149,LU=20,A 05920*BSR,20,1 05930*OPEN,FN=B.WRTOFP,OW=CCS149,LU=21,R 05940*REW,21 05950*LIBEDT 05960*T,21,B,20,B,,1 05970*Z 05980*CLOSE 05990*CTO, *T COMPLETE........................ 06000( C iJ.CHUPD2CCS149 P(*JOB,,TWB.JOB CHUPD2 INSTALL 08/23/84 00010*K,L14 00020*CTO, CHUPD2 WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.CHUPD2 , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.CHUPD2,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CHUPD2 DCK/ I,H 00130 DEL/ 2 00140 1 /B26 F CCS CCS 3.0 .LA - PSRD 08-83 SL-149 00150 INS/ 13 00160C 173*A078 00170C THE PURPOSE OF PSR A078 IS TO PREVENT DUPLICATE 00180C RECORDS WHEN ACCOUNTS ARE UPDATED BOTH FROM 00190C AND HISTORY TAPE. 00200C 00210C PSR A078 DOES THE FOLLOWING:- 00220C DEFINES A TEMPORARY FILE WHICH IS INDEXED BY ACCOUNT #. 00230C THE PRESENCE OF A RECORD IN THE TEMPORARY FILE MEANS 00240C THAT THIS PROGRAM WROTE THE RECORD HAVING 00250C SUFFIX 51 FOR THE SAME ACCOUNT. 00260C THE ABSENCE OF A RECORD IN THE TEMPORARY FILE MEANS 00270C THAT THIS PROGRAM DID NOT WRITE THE RECORD BUT, 00280C IF AN RECORD EXISTS, IT MUST HAVE BEEN WRITTEN 00290C BY . IF WROTE THE RECORD, 00300C THEN THIS PROGRAM WILL OVERLAY THAT RECORD WITH NEW DATA. 00310C 00320C THE DEFINED NUMBER OF RECORDS IN THE TEMPORARY FILE 00330C WILL BE ONE MORE THAN ARE ACTUALLY STORED IN . 00340C 00350C THE TEMPORARY FILE IS DELETED BY THIS PROGRAM AT ITS END. 00360C 00370 INTEGER UPRFCB(96), CHPBUF(24), CHPDAT(24), CHPREC(11) 00380 1 , VOLNAM(4), BUFCHP(24), DATCHP(15), ACTEMP(252) 00390 2 , CHPKEY(9), WRONKY 00400C 00410 DATA CHPBUF/24*0/ 00420 DATA CHPDAT/'CHUPTEMP',4*$2020,'SYSVOL ' 00430 1 , 18, 0, 0, $0001 00440 2 , 16, 1, 0, 0 00450 3 , 0, 0, 0, 0 / 00460 DATA VOLNAM/4*0/ 00470 DATA BUFCHP/24*0/, DATCHP/'CHUPTEMP',8*$2020,1,1,0/ 00480 DATA CHPREC/11*0/, WRONKY/$8200/ 00490C 00500 EQUIVALENCE (NEDATM,UPRFCB(7)), (NEDATL,UPRFCB(8)) 00510C 00520C 173*A078 00530 DEL/ 33 00540 INTEGER F2NAM(4,3) 00550 DATA F2NAM /'DELQMST ACTFIL UPREQ ' / 00560 DATA FNAME /'LADLQMSTLAACTFILLAUPDREQ' / 00570 DEL/ 38 00580C ****************************************************** ???*0016 00590 2 $D0A,'ENTER "NX" FOR NEXT TAPE ', 00600C ****************************************************** ???*0016 00610 INS/ 53 00620 CALL CCSCST(FNAME,1,2,USER,1,8,ICM) 00630 IF(ICM.NE.0) CALL CCSMVA(F2NAM,1,24,FNAME,1,24) 00640 INS/ 79 00650C 173*A078 00660C 00670C--- DEFINE THE TEMPORARY FILE AS FOLLOWS:- 00680C 1. GET THE FCB FOR . 00690C 2. CREATE FILE, INDEXED, # OF RECORDS WILL BE 00700C ONE MORE THAN STORED IN . 00710C THIS IS DONE BECAUSE MIGHT BE EMPTY 00720C 00730 RTYPE = 7 00740 CALL GETFCB(REQBUF(1),VOLNAM,INDEX,UPRFCB,ISTAT) 00750 IF(ISTAT.LT.0) GO TO 910 00760C 00770C--- FETCH NUMBER OF RECORDS. 00780 CHPDAT(14) = NEDATM 00790 CHPDAT(15) = NEDATL + 1 00800C 00810C **** FIRST DELETE FILE IF PRESENT ? 00820 CALL DELETE(CHPBUF,CHPDAT,ISTAT) 00830 DO 78 I=1,24 00840 78 CHPBUF(I) = 0 00850C 00860C--- DEFINE THE TEMPORARY FILE. 00870 CALL CREATE(CHPBUF,CHPDAT,ISTAT) 00880 RTYPE = 0 00890 IF(ISTAT.GE.0) GO TO 85 00900 80 CONTINUE 00910 CALL FILERR(CHPDAT,RTYPE,ISTAT,LU) 00920 GO TO 950 00930C 00940C--- OPEN THE TEMPORARY FILE. 00950 85 CONTINUE 00960 RTYPE = 3 00970 CALL OPENFL(BUFCHP,DATCHP,ISTAT) 00980 IF(ISTAT.LT.0) GO TO 80 00990C 173*A078 01000 DEL/ 83 01010C ****************************************************** 173*0016 01020 105 RTYPE = 14 01030C ****************************************************** 173*0016 01040 DEL/ 87 01050C ****************************************************** 173*0016 01060 IF ( ISTAT .LT. 0 ) GO TO 910 01070C ****************************************************** 173*0016 01080 DEL/ 110,111 01090C ****************************************************** 173*0016 01100 IF ( COMMD .NE. NX ) GO TO 150 01110C SKIP UPDATE REQUESTS UNTIL REQUEST FOR DIFFERENT TAPE 01120C OR END FOUND 01130 CALL CCSMVA ( RECBUF, 17, 6, OLDTP, 1, 6 ) 01140 160 CALL GETS ( REQBUF, RECBUF, KEY, ISTAT ) 01150 IF ( AND(ISTAT,$100) .NE. 0 ) GO TO 105 01160 IF ( ISTAT .LT. 0 ) GO TO 910 01170 CALL CCSCST ( RECBUF, 17, 6, OLDTP, 1, 6, ICOMP ) 01180 IF ( ICOMP .NE. 0 ) GO TO 105 01190 GO TO 160 01200C ****************************************************** 173*0016 01210 DEL/ 169,174 01220C***** PSR 07/83 01230 IF(AND(ISTAT,$100).EQ.$100.OR.AND(ISTAT,$200).EQ.$200) GO TO 500 01240C***** 01250 01260C ****************************************************** ???*0016 01270 IF ( ISTAT .LT. 0 ) GO TO 920 01280C ****************************************************** ???*0016 01290 INS/ 206 01300C**** DON'T RELOAD ACTFIL BLOCKS WITH SUFFIX > 50 PSR 07/83 01310 ISFX = TREC(250*I+9) 01320 IF(ISFX.GT.$3530) GO TO 480 01330 DEL/ 208 01340C ****************************************************** 173*0016 01350 440 K = ICCSAD(SUF(3)) 01360C ****************************************************** 173*0016 01370 DEL/ 220,221 01380C 173*A078 01390 RTYPE = 12 01400 IF(ISTAT.GE.0) GO TO 450 01410C 01420C--- SEE IF REJECT BECAUSE RECORD ALREADY EXISTS. 01430 IF(AND(ISTAT,$10).EQ.0) GO TO 930 01440C 01450C--- IF SUFFIX NOT 51, BUMP IT AND TRY AGAIN. 01460 IF(ACT(9).NE.$3531) GO TO 440 01470C 01480C--- SUFFIX IS 51; SEE IF I WROTE THE EXISTING RECORD. 01490C (PRESENCE OF RECORD SAYS I WROTE IT.) 01500 CALL CCSMVA(AREC,1,18,CHPKEY,1,18) 01510 RTYPE = 13 01520 CALL READR(BUFCHP,CHPREC,CHPKEY,ISTAT) 01530C 01540C--- IF I WROTE IT, BUMP SUFFIX AND TRY AGAIN. 01550 IF(AND(ISTAT,WRONKY).EQ.0) GO TO 440 01560C 01570C--- I DIDN'T WRITE IT. 01580C 01590C--- READ THE EXISTING RECORD AND UPDATE WITH NEW DATA. 01600 CALL CCSMVA(ACT,1,18,CHPKEY,1,18) 01610 RTYPE = 13 01620 CALL READR(REQBUF(49),ACTEMP,CHPKEY,ISTAT) 01630 IF(AND(ISTAT,WRONKY).NE.0) GO TO 930 01640 RTYPE = 15 01650 CALL UPDREC(REQBUF(49),AREC,ISTAT) 01660 IF(ISTAT.LT.0) GO TO 930 01670C 01680C--- DECLARE THAT I WROTE THIS RECORD BY 01690C WRITING A RECORD. 01700 445 CONTINUE 01710 RTYPE = 12 01720 CALL WRITER(BUFCHP,AREC,AREC,ISTAT) 01730 IF(ISTAT.LT.0) GO TO 80 01740 GO TO 477 01750C 01760C--- RECORD SUCCESSFULLY WRITTEN; SEE IF SUFFIX IS 51. 01770 450 CONTINUE 01780 IF(ACT(9).EQ.$3531) GO TO 445 01790C 01800C 01810 477 CONTINUE 01820C 173*A078 01830 INS/ 240 01840C ****************************************************** 173*0016 01850 GO TO 950 01860 910 CALL FILERR ( FNAME(1,3), RTYPE, ISTAT, LU ) 01870 GO TO 950 01880 920 CALL FILERR ( FNAME, RTYPE, ISTAT, LU ) 01890 GO TO 950 01900 930 CALL FILERR ( FNAME(1,2), RTYPE, ISTAT, LU ) 01910C ****************************************************** 173*0016 01920 INS/ 246 01930C 173*A078 01940C 01950C--- CLOSE AND DELETE TEMPORARY FILE. 01960 CALL CLOSFL(BUFCHP,ISTAT) 01970 DO 955 J = 1,24 01980 955 BUFCHP(J) = 0 01990 CALL DELETE(BUFCHP,CHPDAT,ISTAT) 02000C 173*A078 02010 END/ 02020*REW,7 02030*K,I7,P21,L14 02040*FTN 02050*EOF 02060*CLOSE 02070*K,I13,L14 02080*Z 02090*Z 02100__ GO TO 950 01860 910 CALL FILERR ( FNAME(1,3), RTYPE, ISTAT, LU ) 01870 GO TO 950 01880 920 CALL FILERR ( FNAME, RTYPE, ISTAT, LU ) 01890 GO TO 950 01900 930 CALL FILERR ( FNAME(1,2), RTYPE, ISTAT, LU ) 01910C ****************************************************** 173*0016 01920 INS/ 246 01930C 173*A078 01940C 01950C--- CLOSE AND DELETE TEMPORARY FILE. 01960 CALL CLOSFL(BUFCHP,ISTAT) 01970 DO 955 J = 1,24 01980 955 BUFCHP(J) = 0 01990 CALL DELETE(BUFCHP,CHPDAT,ISTAT) 02000( F g?J.COLECTCCS149 P(*JOB,,TWB.JOB COLECT INSTALL 08/23/84 00010*K,L14 00020*CTO, COLECT WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.COLECT , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.COLECT,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120COLECT DCK/ I,H 00130 END/ 00140*REW,7 00150*K,I7,P21,L14 00160*ASSEM 00170*REW,7,20 00180*K,I13,L2 00190*CSY,I20,P7 00200*COSY 00210COLMAC DCK/ I,H 00220BLKDAT DCK/ I,H 00230ACTEDT DCK/ I,H 00240CHSCRN DCK/ I,H 00250 DEL/ 2 00260 1 /B25 F CCS CCS 3.0 PSR'D SL-149 00270 INS/ 77 00280C ****************************************************** ???*A026 00290 INTEGER NINES(5) 00300 DATA NINES/5*$3939/ 00310C ****************************************************** ???*A026 00320 INS/ 212 00330C ****************************************************** ???*A026 00340 CALL CCSCST (KEY, 1, 9, NINES, 1, 9, COMPIN) 00350 IF (COMPIN .NE. 0) GO TO 162 00360 GO TO 60 00370 162 CONTINUE 00380C ****************************************************** ???*A026 00390CLANEX DCK/ I,H 00400DAAASC DCK/ I,H 00410 DEL/ 2 00420 1 /B31 F CCS CCS3.0 PSR'D 00430 DEL/ 60 00440C ****************************************************** PSR ??? 00450 KEY(9) = BLANKS 00460C ****************************************************** PSR ??? 00470DISPLY DCK/ I,H 00480 DEL/ 2 00490 1 /B43 F CCS CCS 3.0 PSRD .VERFY INP. SL-149 00500 DEL/ 60 00510C ****************************************************** ???*A009 00520 DATA EDTLEN / 0, 8, 0, 11, 12, 0, 11, 4, 0, 0 / 00530C ****************************************************** ???*A009 00540 DEL/ 361 00550 IF(K.LT.$20 .OR. K.GT.$7D) CALL CCSPUT(BLANKS,I,IOBUF) 00560EACTSQ DCK/ I,H 00570 DEL/ 2 00580 1 /B48 F CCS CCS 3.0 PSRD 02/28/1 SL-149 00590 INS/ 281 00600C************************************************************** ???*A028 00610 CALL CCSMVA (IOBUF, SIX, FOUR, IOBUF, ONE, FOUR) 00620C************************************************************** ???*A028 00630EATRNG DCK/ I,H 00640 DEL/ 2 00650 1 /B49 F CCS CCS 3.0 PSR'D SL-149 00660 DEL/ 329 00670C ****************************************************** ???*0023 00680 CALL CCSPUT (ACTCNT, 136, TRNSBF) 00690C ****************************************************** ???*0023 00700FCOLEC DCK/ I,H 00710 INS/ 78 007201 00730C*** TRAINEE DOES NOT NEED TO LOCK RECORDS BECAUSE WERE NOT UPDATING 00740 IDATDM(15)=0 007501 00760GETCHF DCK/ I,H 00770ICHEKQ DCK/ I,H 00780ICHENT DCK/ I,H 00790NMSRCH DCK/ I,H 00800 END/ 00810*REW,7 00820*K,I7,P21,L14 00830*FTN 00840*REW,7,20 00850*K,I13,L2 00860*CSY,I20,P7 00870*COSY 00880COLMAC DCK/ I,H 00890PCPROC DCK/ I,H 00900PIKAMT DCK/ I,H 00910SAVTRN DCK/ I,H 00920R9BASE DCK/ I,H 00930R9FLDL DCK/ I,H 00940 END/ 00950*REW,7 00960*K,I7,P21,L14 00970*FTN 00980*EOF 00990*CLOSE 01000*K,I13,L14 01010*Z 01020*Z 01030__NT DCK/ I,H 00790NMSRCH DCK/ I,H 00800 END/ 00810*REW,7 00820*K,I7,P21,L14 00830*FTN 00840*REW,7,20 00850*K,I13,L2 00860*CSY,I20,P7 00870*COSY 00880COLMAC DCK/ I,H 00890PCPROC DCK/ I,H 00900PIKAMT DCK/ I,H 00910SAVTRN DCK/ I,H 00920R9BASE DCK/ I,H 00930R9FLDL DCK/ I,H 00940 END/ 00950*REW,7 00960*K,I7,P21,L14 00970*FTN 00980*EOF 00990*CLOSE 01000(H_J HWSCCSFIXCCS149 P999999(*JOB,, INSTALL CCS CORRECTIONS ##/##/## # *CTO, CCS149 PSR INSTALL... AS OF ##/##/## #### # *K,L14 $$TWRELOIN,CCS149,,CCSADD,CCS149 $$TWRELOIN,CCS149,,CCSDVD,CCS149 $$TWRELOIN,CCS149,,CCSEAC,CCS149 $$TWRELOIN,CCS149,,CCSMTP,CCS149 $$TWRELOIN,CCS149,,CCSSBT,CCS149 $$TWRELOIN,CCS149,,EDIT,CCS149 $$TWRELOIN,CCS149,,FILERR,CCS149 $$TWRELOIN,CCS149,,FTNDT1,CCS149 $$TWRELOIN,CCS149,,GETGRP,CCS149 $$TWRELOIN,CCS149,,GETSW,CCS149 $$TWRELOIN,CCS149,,GETUTI,CCS149 $$TWRELOIN,CCS149,,GTSYSP,CCS149 $$TWRELOIN,CCS149,,ICKGRP,CCS149 $$TWRELOIN,CCS149,,LTPRNT,CCS149 $$TWRELOIN,CCS149,,PRTORF,CCS149 $$TWRELOIN,CCS149,,QCST,CCS149 $$TWRELOIN,CCS149,,SYSPRT,CCS149 $$TWRELOIN,CCS149,,UTHEAD,CCS149 $$TWRELOIN,CCS149,,VFYACF,CCS149 $$TWABSOIN,CCS149,,ACTADD,CCS149 $$TWABSOIN,CCS149,,ACTMTN,CCS149 $$TWABSOIN,CCS149,,AVMCON,CCS149 $$TWABSOIN,CCS149,,CCSDMP,CCS149 $$TWABSOIN,CCS149,,CCSSPC,CCS149 $$TWABSOIN,CCS149,,CHEKID,CCS149 $$TWABSOIN,CCS149,,CHUPD2,CCS149 $$TWABSOIN,CCS149,,CMPACC,CCS149 $$TWABSOIN,CCS149,,COLCHG,CCS149 $$TWABSOIN,CCS149,,COLECT,CCS149 $$TWABSOIN,CCS149,,COLSTS,CCS149 $$TWABSOIN,CCS149,,CPYIND,CCS149 $$TWABSOIN,CCS149,,DALIST,CCS149 $$TWABSOIN,CCS149,,DECMTN,CCS149 $$TWABSOIN,CCS149,,DHUPDT,CCS149 $$TWABSOIN,CCS149,,DMPFIL,CCS149 $$TWABSOIN,CCS149,,FIXINA,CCS149 $$TWABSOIN,CCS149,,LODFIL,CCS149 $$TWABSOIN,CCS149,,LTRBLD,CCS149 $$TWABSOIN,CCS149,,LTRPRT,CCS149 $$TWABSOIN,CCS149,,LTRSTA,CCS149 $$TWABSOIN,CCS149,,MHUPDT,CCS149 $$TWABSOIN,CCS149,,NEWS,CCS149 $$TWABSOIN,CCS149,,NMCHNG,CCS149 $$TWABSOIN,CCS149,,PGGEN,CCS149 $$TWABSOIN,CCS149,,PHDEL1,CCS149 $$TWABSOIN,CCS149,,PHDEL2,CCS149 $$TWABSOIN,CCS149,,PRETSR,CCS149 $$TWABSOIN,CCS149,,PROVE,LIBRARY $$TWABSOIN,CCS149,,PRTSCN,CCS149 $$TWABSOIN,CCS149,,QLOAD,CCS149 $$TWABSOIN,CCS149,,REBILD,LIBRARY $$TWABSOIN,CCS149,,RSWCHG,CCS149 $$TWABSOIN,CCS149,,SRREQ,CCS149 $$TWABSOIN,CCS149,,SUMACL,CCS149 $$TWABSOIN,CCS149,,SWITCH,CCS149 $$TWABSOIN,CCS149,,TIMUSE,CCS149 $$TWABSOIN,CCS149,,TRENDF,CCS149 $$TWABSOIN,CCS149,,TRENDP,CCS149 $$TWABSOIN,CCS149,,TRNPLY,CCS149 $$TWABSOIN,CCS149,,UPD400,CCS149 $$TWABSOIN,CCS149,,UPD500,CCS149 $$TWABSOIN,CCS149,,UPDATE,CCS149 $$TWABSOIN,CCS149,,USEMTN,CCS149 $$TWABSOIN,CCS149,,UTFMTN,CCS149 $$TWABSOIN,CCS149,,WRTOFE,CCS149 $$TWABSOIN,CCS149,,WRTOFP,CCS149 *CTO, *CTO, INSTALL C O M P L E T E !!! *Z __ABSOIN,CCS149,,PHDEL1,CCS149 $$TWABSOIN,CCS149,,PHDEL2,CCS149 $$TWABSOIN,CCS149,,PRETSR,CCS149 (O (O !J.CPYINDCCS149 P(*JOB,,TWB.JOB CPYIND INSTALL 08/23/84 00010*K,L14 00020*CTO, CPYIND WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.CPYIND , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.CPYIND,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CPYIND DCK/ I,H 00130 DEL/ 2 00140 1 /B34 F CCS CCS 3.0 PSR'D SL-149 00150 INS/ 131 00160C ****************************************************** ???*A019 00170C IGNORE DELETED RECORDS. 00180 IF (INREC(JW) .EQ. FDEL ) GO TO 300 00190C ****************************************************** ???*A019 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250*CLOSE 00260*K,I13,L14 00270*Z 00280*Z 00290__, IS NOW BEING COMPILED TO B.CPYIND , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.CPYIND,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CPYIND DCK/ I,H 00130 DEL/ 2 00140 1 /B34 F CCS CCS 3.0 PSR'D SL-149 00150 INS/ 131 00160C ****************************************************** ???*A019 00170C IGNORE DELETED RECORDS. 00180 IF (INREC(JW) .EQ. FDEL ) GO TO 300 00190C ****************************************************** ???*A019 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250(i Lw 7,J.DMPFILCCS149 P(*JOB,,TWB.JOB DMPFIL INSTALL 08/23/84 00010*K,L14 00020*CTO, DMPFIL WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.DMPFIL , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.DMPFIL,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120DMPFIL DCK/ I,H 00130 DEL/ 2 00140 1 /B45 F CCS CCS 3.0 . - PSRD 03/83 SL-149 00150 DEL/ 21 00160 INTEGER IREC(6000),ICNT(6),FCBHDR(6),BUFLEN 00170 EQUIVALENCE (FCBHDR(6),FCB(1)) 00180 INS/ 30 00190 DATA BUFLEN /6000/ 00200 DEL/ 38 00210 DATA MSG6/$0A0D,$0D0A,'RECORD EXCEEDS 2000 CHARACTERS '/ 00220 INS/ 44 002301 00240 ASSEM $C000,+FCBHDR,$6400,+IREQ(10) 00250 IREQ(13) = 96 00260 DEL/ 52,59 00270 110 CALL CCSBLK(IBUF,20) 00280 CALL WTREAD(LUNIT,-1,MSG2,22,-1,IBUF,18,ITC) 00290 IF(IBUF(10).EQ.0) GO TO 110 00300 IF(ITC.EQ.4) GO TO 110 00310 CALL CCSMVA(IBUF,1,16,IDATA,1,16) 003201 00330C GET VOLUME NAME 00340 120 CALL CCSBLK(IBUF,20) 00350 CALL WTREAD(LUNIT,-1,MSG3,18,-1,IBUF,18,ITC) 00360 IF(ITC.EQ.4) GO TO 120 00370 DEL/ 75,78 00380 DEL/ 89 00390 IF(RECLEN.GT.1000) GO TO 920 00400 NREC = BUFLEN/RECLEN 00410 IREQ(13)= NREC 00420 DEL/ 98 00430 170 CONTINUE 00440 INS/ 106 00450 IF (NREC.LE.0) GO TO 250 00460 END/ 00470*REW,7 00480*K,I7,P21,L14 00490*FTN 00500*EOF 00510*CLOSE 00520*K,I13,L14 00530*Z 00540*Z 00550__ IF(ITC.EQ.4) GO TO 110 00310 CALL CCSMVA(IBUF,1,16,IDATA,1,16) 003201 00330C GET VOLUME NAME 00340 120 CALL CCSBLK(IBUF,20) 00350 CALL WTREAD(LUNIT,-1,MSG3,18,-1,IBUF,18,ITC) 00360 IF(ITC.EQ.4) GO TO 120 00370 DEL/ 75,78 00380 DEL/ 89 00390 IF(RECLEN.GT.1000) GO TO 920 00400 NREC = BUFLEN/RECLEN 00410 IREQ(13)= NREC 00420 DEL/ 98 00430 170 CONTINUE 00440 INS/ 106 00450 IF (NREC.LE.0) GO TO 250 00460 END/ 00470*REW,7 00480*K,I7,P21,L14 00490*FTN 00500(At^ A|J.EDIT CCS149 P032883(*JOB,, EDIT INSTALL 02/01/82 00010*K,L14 00020*CTO, EDIT WEAVED AS OF 02/01/82 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BNEDIT 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BNEDIT,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120EDIT DCK/ I,H 00130 DEL/ 2 00140 1 /B50 F CCS CCS 3.0 PSR'D SL-149 00150 DEL/ 26 00160C ****************************************************** ???*A009 00170C 3 = DOLLAR AMOUNT. NINE DIGIT FIELD EDITED TO 9999999.99S 00180C S=SIGN: POS.=BLANK, NEG.='-' 00190C ****************************************************** ???*A009 00200 DEL/ 77,90 00210C ****************************************************** ???*A010 00220C ..CHECK LAST DIGIT FOR OVERPUNCH & CONVERT AS REQUIRED 00230 400 J = OSTART + LEN 00240 CALL CCSGET (OBUF, J, M) 00250C ..IF NO OVERPUNCH(ASCII), SET SIGN=BLANK(POS.) & EXIT 00260 IF (M .LE. NINE) GO TO 420 00270C ..IF OVERPUNCH = POSITIVE DIGIT($41-$49), CONVERT & SET SIGN 00280C .. = BLANK 00290 IF (M .GT. $49) GO TO 410 00300 M = M - $10 00310 CALL CCSPUT (M, J, OBUF) 00320 GO TO 420 00330C ..IF OVERPUNCH=POSITIVE ZERO, CONVERT TO ASCII ZERO & SET 00340C .. SIGN=BLANK 00350 410 IF (M .NE. $7B) GO TO 430 00360 CALL CCSPUT (ZERO, J, OBUF) 00370C ..SET SIGN = BLANK 00380 420 J = J + 1 00390 CALL CCSPUT (BLANK, J, OBUF) 00400 GO TO 500 00410C ..IF OVERPUNCH=NEG. ZERO, CONVERT & SET SIGN MINUS 00420 430 IF (M .NE. $7D) GO TO 440 00430 CALL CCSPUT (ZERO, J, OBUF) 00440 GO TO 450 00450C ..ASSUME OVERPUNCH = NEG. DIGIT($4A-$52), CONVERT & SET 00460C .. SIGN MINUS 00470 440 M = M - $19 00480 CALL CCSPUT (M, J, OBUF) 00490C ****************************************************** ???*A010 00500C ****************************************************** ???*A009 00510 450 J = J + 1 00520 CALL CCSPUT (MINUS, J, OBUF) 00530C ****************************************************** ???*A009 00540 END/ 00550*REW,7 00560*K,I7,P21,L14 00570*FTN 00580*EOF 00590*CLOSE 00600*K,I13,L14 00610*Z 00620*Z 00630_ __ GO TO 500 00410C ..IF OVERPUNCH=NEG. ZERO, CONVERT & SET SIGN MINUS 00420 430 IF (M .NE. $7D) GO TO 440 00430 CALL CCSPUT (ZERO, J, OBUF) 00440 GO TO 450 00450C ..ASSUME OVERPUNCH = NEG. DIGIT($4A-$52), CONVERT & SET 00460C .. SIGN MINUS 00470 440 M = M - $19 00480 CALL CCSPUT (M, J, OBUF) 00490C ****************************************************** ???*A010 00500([ M1 )&J.LODFILCCS149 P(*JOB,,TWB.JOB LODFIL INSTALL 08/23/84 00010*K,L14 00020*CTO, LODFIL WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.LODFIL , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.LODFIL,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120LODFIL DCK/ I,H 00130 DEL/ 2 00140 1 /B73 F CCS CCS 3.0 REPORT DUP RECORD SL-149 00150 INS/ 39 00160 INTEGER MSGA(15) 00170 DATA MSGA/$0D0C,'DUPLICATE RECORD CONTENTS ',$0D0A/ 00180 INS/ 106 00190 IF(AND(ISTAT,$8010).EQ.$8010) GO TO 202 00200 INS/ 107 00210 202 CONTINUE 00220 IWLEN=(BYTLEN+1)/2 00230 IF(IWLEN.GT.65 ) IWLEN=65 00240 IBLEN = IWLEN*2 00250 ISAV = OREC(IWLEN) 00260 OREC(IWLEN) = MSG2(1) 00270 CALL WTREAD(09,-1,MSGA,30,0,0,0,ITC) 00280 MSGA(1) = MSG2(1) 00290 CALL WTREAD(09,-1,OREC,IBLEN,0,0,0,ITC) 00300 OREC(IWLEN) = ISAV 00310 GO TO 170 00320 END/ 00330*REW,7 00340*K,I7,P21,L14 00350*FTN 00360*EOF 00370*CLOSE 00380*K,I13,L14 00390*Z 00400*Z 00410__ INTEGER MSGA(15) 00170 DATA MSGA/$0D0C,'DUPLICATE RECORD CONTENTS ',$0D0A/ 00180 INS/ 106 00190 IF(AND(ISTAT,$8010).EQ.$8010) GO TO 202 00200 INS/ 107 00210 202 CONTINUE 00220 IWLEN=(BYTLEN+1)/2 00230 IF(IWLEN.GT.65 ) IWLEN=65 00240 IBLEN = IWLEN*2 00250(^{ ,{m(J.LTPRNTCCS149 P032883(*JOB,, LTPRNT INSTALL 10/12/82 00010*K,L14 00020*CTO, LTPRNT WEAVED AS OF 10/12/82 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BNLTPRNT, CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BNLTPRNT,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120LTPRNT DCK/ I,H 00010 DEL/ 2 00020 1 /B74 F CCS CCS 3.0 PSR'D SL-149 00030 DEL/ 46 00040 DATA MAXLEN/57/, PRTLEN/86/, NO/'N'/, MARGIN/$0005/ 00050 INS/ 93 00060 CALL PGMIN(FARRAY,LU,MODE,NPORT) 00070 IF(NPORT.NE.0) PRT=5 00080 DEL/ 411 00090C ****************************************************** ???*0007 00100 CALL CCSMVA (CONAME, 1, 12, OBUF, 37, 12) 00110C ****************************************************** ???*0007 00120 DEL/ 418 00130C ****************************************************** ???*0007 00140 CALL CCSMVA (PHONE, 1, 13, OBUF, 37, 13) 00150C ****************************************************** ???*0007 00160 DEL/ 424 00170C ****************************************************** ???*0007 00180 CALL CCSMVA (EXT, 1, 8, OBUF, 37, 8) 00190C ****************************************************** ???*0007 00200 DEL/ 431 00210C ****************************************************** ???*0007 00220 CALL CCSMVA (COLDP, 1, 15, OBUF, 37, 15) 00230 END/ 00010*REW,7 00020*K,I7,P21,L02 00030*FTN 00040*EOF 00050*CLOSE 00060*K,I13,L14 00070*Z 00080*Z 00090__ IF(NPORT.NE.0) PRT=5 00080 DEL/ 411 00090C ****************************************************** ???*0007 00100 CALL CCSMVA (CONAME, 1, 12, OBUF, 37, 12) 00110C ****************************************************** ???*0007 00120 DEL/ 418 00130( Mb `J.LTRBLDCCS149 P(*JOB,,TWB.JOB LTRBLD INSTALL 08/23/84 00010*K,L14 00020*CTO, LTRBLD WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.LTRBLD , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.LTRBLD,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120LTRBLD DCK/ I,H 00130 DEL/ 2 00140 1 /B75 F CCS CCS 3.0 .LA PSR 07/83 SL-149 00150 DEL/ 47,51 00160 INTEGER INBUF(66), LTREC1(40), LTRS(100) , LFBUF, OBUF(66) 00170 DATA LFBUF/0/, LTREC1/40*$2A2A/, LTRS/100*$2020 /, OBUF/66*$2020/ 001801 00190 INTEGER LRPTBL(42), REQBRP(24), INAMKY(3),LRCBF1(42),TEMP 00200 DATA REQBRP/24*0/,INAMKY/3*0/,LRCBF1/42*$2020/ 00210 DEL/ 60,76 00220C******** FILE DESCRIPTION BUFFERS... 00230 INTEGER IDATLD(15),IDATRP(15),IDATLF(15),IDATUT(15) 00240 INTEGER DATLD(4) 002501 00260 DATA DATLD/'LTRDESC '/ 00270 DATA IDATLD/'LALTRDSC',8*$2020, 0, 1, 0/ 00280 DATA IDATRP/'LARPTTBL',8*$2020, 1, 1, 0/ 00290 DATA IDATLF/'LALTRFIL',8*$2020, 1, 1, 0/ 00300 DATA IDATUT/'LAUTIFIL',8*$2020, 1, 1, 1/ 00310 DEL/ 111,112 00320 INTEGER SNGLSP, DBLSPA,A1,A2,A3,A4,RE,TWO 00330 DATA SNGLSP/$000A/, DBLSPA/$0D0A/,TWO/$32/ 00340 DEL/ 132 00350 DATA WKKEY/0/,PRTLEN/86/ 00360 DEL/ 189 00370 DATA TEXT2/'NUMBER OF LETTERS EXCEED 50 '/ 003801 00390 INTEGER MXNUML,NLRC 00400 DATA MXNUML / 50/,NLRC / 1 / 00410 DEL/ 231 00420 20 IF (NOPORT .NE. 0) PRT = 5 004301 00440 CALL CCSCST(IDATUT,1,2,ID,1,8,ICM) 00450 IF(ICM.EQ.0) GO TO 25 00460 CALL CCSMVA(IDATUT,3,6,IDATUT,1,8) 00470 CALL CCSMVA(IDATRP,3,6,IDATRP,1,8) 00480 CALL CCSMVA(IDATLF,3,6,IDATLF,1,8) 00490 CALL CCSMVA(DATLD ,1,8,IDATLD,1,8) 00500 25 CONTINUE 00510 DEL/ 257 00520C******* CLEAR LTRFIL THEN OPEN IT. 005301 00540 CALL CLEAR(REQBLF,IDATLF,ISTAT) 00550 DO 56 IZ = 1,24 00560 56 REQBLF(IZ) = 0 00570 DEL/ 267 00580 65 IF (ISTAT .GE. 0) GO TO 90 00590 DEL/ 271,276 00600 DEL/ 285 00610 IF(AND(ISTAT,$100).EQ.$100) GO TO 196 00620 DEL/ 320 00630 CALL CCSMVA(HD2B, 1, 4, PRTBUF, 75, 4) 00640 DEL/ 344 00650 167 CALL CCSMVA(PAGOUT,1,4,PRTBUF,80,4) 00660 DEL/ 363 00670 196 NSWICH = NSWICH +1 00680 DEL/ 1189 00690 1500 IF(LTRCNT.GT.MXNUML)GO TO 1570 00700 DEL/ 1221 00710 CALL CCSMVA(HD2B,1,4,PRTBUF,75,4) 00720 DEL/ 1245 00730 1557 CALL CCSMVA(PAGOUT,1,4,PRTBUF,80,4) 00740 DEL/ 1261,1274 00750C PLACE LETTER NUMBER IN LETTER # ARRAY FOR SORT 007601 00770 LTRS(LTRCNT) = SAVKEY 00780 DEL/ 1297,1379 00790C COMPLETE UTILITY RECORDS LTR1 THRU LTR4. 008001 00810 1600 CONTINUE 008201 00830C SORT LETTER NUMBERS INTO ASCENDING ORDER. 00840C SORT IS A BUBBLE SORT. 008501 00860 K = 1 00870 MELM=LTRCNT-1 00880 IF (MELM.LE.1) GO TO 1610 00890 DO 1610 I=1,MELM 009001 00910 IF(LTRS(I).LT.LTRS(I+1))GO TO 1615 00920 TEMP = LTRS(I) 00930 LTRS(I) = LTRS(I+1) 00940 LTRS(I+1) = TEMP 00950 DO 1605 J=I,2,-K 00960 IF(LTRS(J).GT.LTRS(J-1))GO TO 1605 00970 TEMP = LTRS(J) 00980 LTRS(J) = LTRS(J-1) 00990 LTRS(J-1) = TEMP 01000 1605 CONTINUE 01010 1610 CONTINUE 01020C *** SORT COMPLETE *** 010302 01040 1615 K = LTRCNT 01050 1620 DO 1800 I = 0,NLRC 01060 J = 50 01070 IF( K.LT.26 ) J = K*2 01080 K2 = I*25+1 010901 01100 CALL CCSMVA( LTREC1,1,70,LRCBF1,1,80 ) 01110 CALL CCSMVA( LTRS(K2),1,J,LRCBF1,5,J ) 01120 CALL CCSMVA( LKEY1, 1, 4, LKEY2, 1,4 ) 01130 LKEY2(2) = LKEY2(2)+I 01140 CALL CCSMVA( LKEY2, 1, 4, LRCBF1,1,4 ) 01150 CALL CCSMVA( LRCBF1,1,80, OBUF ,1,80 ) 01160 K = K-25 01170 IF (K.LT.0) K=0 01180 1650 CONTINUE 01190 CALL WRITER ( REQBUT,LRCBF1,LKEY2,ISTAT ) 01200 IF (AND(ISTAT,$10).EQ.$10) GO TO 1675 01210 IF (ISTAT.GE.0) GO TO 1750 01220 CALL FILERR ( IDATUT,12,ISTAT,LU ) 01230 GO TO 2010 012401 01250C GET LTRX RECORD FROM UTILITY FILE. 012601 01270 1675 CALL READR(REQBUT, LRCBF1, LKEY2, ISTAT) 01280 IF(AND(ISTAT,$200).EQ.$200) GO TO 1860 01290 IF(AND(ISTAT,$100).EQ.$100) GO TO 1860 01300 1677 IF(ISTAT .GE. 0) GO TO 1680 01310 CALL FILERR(LRCBF1, 13, ISTAT, LU) 01320 GO TO 2010 013301 01340C MOVE UPDATE INFO TO LTRX RECORD BUFFER. 013501 01360 1680 CALL CCSMVA( OBUF, 1,80, LRCBF1, 1,80 ) 013701 013801 01390C REWRITE LTRX TO UTILITY FILE 014001 01410 1700 CALL UPDREC(REQBUT, LRCBF1, ISTAT) 01420 IF(ISTAT .GE. 0) GO TO 1750 01430 CALL FILERR(LRCBF1, 15, ISTAT, LU) 01440 GO TO 2010 014501 01460C MOVE LTR1 TO ECHO PRINT AND PRINT AFTER ADVANCING 01470C TO TOP OF PAGE.++++++++++++++++++++++++++++++++++++++++++++++++ 014801 01490 1750 CALL CCSBLK(PRTBUF,PRTLEN) 01500 PRTBUF(1)=DBLSPA 01510 IF(I.EQ.0) PRTBUF(1)=TOPPAG 01520 CALL CCSMVA(LRCBF1,1,60,PRTBUF,5,60) 01530 ASSIGN 1800 TO ICOMP 01540 CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP) 01550 CALL DISP 015601 01570 1800 CONTINUE 01580 GO TO 2010 015901 01600C LTRX RECORD WAS NOT FOUND PRINT MESSAGE 01610C WE SHOULD NEVER GET HERE BECAUSE OF WRITER. 016201 01630 1860 CALL CCSBLK(OBUF,PRTLEN) 01640 OBUF(1) = DBLSPA 01650 IF(I.EQ.0) OBUF(1) = TOPPAG 01660 CALL CCSMVA(LKEY2,4,1,UTFERR,21,1) 01670 1870 CALL CCSMVA(UTFERR,1,38,OBUF,10,38) 01680 IF(I.LT.NLRC) ASSIGN 1800 TO ICOMP 01690 IF(I.EQ.NLRC) ASSIGN 2010 TO ICOMP 01700 END/ 01710*REW,7 01720*K,I7,P21,L14 01730*FTN 01740*EOF 01750*CLOSE 01760*K,I13,L14 01770*Z 01780*Z 01790__ CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP) 01550 CALL DISP 015601 01570 1800 CONTINUE 01580 GO TO 2010 015901 01600C LTRX RECORD WAS NOT FOUND PRINT MESSAGE 01610C WE SHOULD NEVER GET HERE BECAUSE OF WRITER. 016201 01630 1860 CALL CCSBLK(OBUF,PRTLEN) 01640 OBUF(1) = DBLSPA 01650 IF(I.EQ.0) OBUF(1) = TOPPAG 01660 CALL CCSMVA(LKEY2,4,1,UTFERR,21,1) 01670 1870 CALL CCSMVA(UTFERR,1,38,OBUF,10,38) 01680 IF(I.LT.NLRC) ASSIGN 1800 TO ICOMP 01690 IF(I.EQ.NLRC) ASSIGN 2010 TO ICOMP 01700 END/ 01710*REW,7 01720*K,I7,P21,L14 01730*FTN 01740*EOF 01750( M n-J.LTRPRTCCS149 P(*JOB,,TWB.JOB LTRPRT INSTALL 08/23/84 00010*K,L14 00020*CTO, LTRPRT WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.LTRPRT , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.LTRPRT,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120LTRPRT DCK/ I=13,H 00130LTRPRT HOL/ 00140 PROGRAM LTRPRT 00150 1 /B77 F CCS CCS 3.0 PSR'D SL-149 001601 00170C CYBERCREDIT SYSTEM VERSION 3 00180C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00190C COPYRIGHT CONTROL DATA CORPORATION, 1979 00200C 002101 00220C THIS PROGRAM IS DESIGNED TO PRINT REQUESTED LETTERS 00230C THAT WERE REQUESTED BY COLLECTORS DURING THE COLLECTION 00240C ACTIVITIES. 00250C 00260C FILES, IO BUFFERS, AND FILE MANAGER******************** 002701 00280 INTEGER BUF(6),DATBUF(13),DMBUF(1000) 00290 DATA BUF/6*$2020/,DATBUF/13*$2020/ 003001 00310 INTEGER FARRAY(27),FULNAM(25),PBUF(67) 00320 DATA FARRAY/27*0/,FULNAM/25*$2020/ 00330 DATA PBUF/'1 ',66*' '/ 003401 00350 INTEGER LASNAM(15),LTFILB(756),LTRFBF(40),OBUF(66) 00360 DATA LASNAM/15*$2020/,LTFILB/756*$2020/,LTRFBF/40*$2020/ 003701 00380 INTEGER IOBUF(41),LTRARR(760) 00390 DATA IOBUF/41*0/,LTRARR/760*$2020/ 004001 00410 INTEGER REQ1(24),REQ2(24),REQ3(24),REQ4(24) 004201 00430 DATA REQ1/24*0/,REQ2/24*0/,REQ3/24*0/,REQ4/24*0/ 004401 00450 INTEGER SALARA(33),TFBUF(69) 00460 DATA SALARA/33*$2020/,TFBUF/69*$2020/ 004701 00480C FILE DATA........ 004901 00500 INTEGER DAT1(15),DAT2(15),DAT3(15),DAT4(15) 00510 +, LD1(4),LD2(4),LD3(4),LD4(4) 005201 00530 DATA DAT1/'LACOSIGN ',01,01,00/ 00540 +, DAT2/'LADLQMST ',01,01,00/ 00550 +, DAT3/'LALTRFIL ',01,01,00/ 00560 +, DAT4/'LATRNSFL ',00,01,00/ 005701 00580 DATA LD1 /'COSIGNER'/,LD2 /'DELQMST '/ 00590 +, LD3 /'LTRFIL '/,LD4 /'TRNSFL '/ 006001 00610C CONSTANTS***************** 006201 00630 INTEGER A,ADAYTO,AMONTO,ASTRSK,AT,AYERTO,B 00640 DATA A/$0041/,ASTRSK/$002A/,AT/$0040/,B/$0042/ 006501 00660 INTEGER BLANK(10),COMMA,LENGTH,COID,CC 00670 DATA BLANK/10*$2020/,COMMA/$2C2C/,LENGTH/0/,COID/0/,CC/2/ 006801 00690 INTEGER DATLIN,FIRLEN,FULLEN,EJT,DBLSPC 00700 DATA DATLIN/3/,EJT/'1 '/,DBLSPC/'0 '/ 007101 00720 INTEGER D,DOL,DT(3),EOF,EXT(2),FEQ 00730 DATA D/$0044/,DOL/$0024/,DT/3*0/,EOF/$100/ 00740 DATA FEQ/$463D/,EXT/'EXT'/ 007501 00760 INTEGER IEND(2),MARGIN,MAXLEN,NO,PUN 00770 DATA IEND/'END'/,MARGIN/13/,MAXLEN/57/ 00780 DATA NO/$4E20/ 007901 00800 INTEGER RECTYP,TWO,START 00810 DATA RECTYP/$3031/,TWO/$0032/ 008201 00830 INTEGER WRONKY,XYN,ZERO 00840 DATA WRONKY/$200/,XYN/-1/,ZERO/0/ 008501 00860 INTEGER YES,ZEROE 00870 DATA YES/$5920/,ZEROE/$3030/ 008801 00890C KEYS, VAIRABLES, MISC************** 009001 00910 INTEGER COL,COLCPO 00920 DATA COL/0/,COLCPO/0/ 009301 00940 INTEGER FCOUNT,FSWICH,IARAPT,IADR,ICTLD 00950 DATA FSWICH/0/,FCOUNT/0/,IARAPT/0/,IADR/0/,ICTLD/0/ 009601 00970 INTEGER ICOL,IPOINT,IPOS 00980 DATA ICOL/0/,IPOINT/0/,IPOS/0/ 009901 01000 INTEGER LCOUNT,LTLPT 01010 DATA LCOUNT/0/,LTLPT/0/ 010201 01030 INTEGER MNAM(15),MADR1(15),MADR2(15),MCS(10),MZP(3),MBNM(15) 01040 INTEGER MSLCD,LTBUPT,LTRF(2) 01050 DATA MSLCD/0/,LTBUPT/0/,LTRF/'LTRF'/ 010601 01070 INTEGER NOF,NUMCLC 01080 DATA NOF/0/,NUMCLC/0/ 010901 01100 INTEGER POS,SALC(2),SALLEN 01110 DATA POS/0/,SALC/'SALC'/,SALLEN/0/ 011201 01130 INTEGER TCIDWK(2),TCIDCK(2),TCIDKY(2) 011401 01150 INTEGER TACTKY(8),TACTWK(9) 011601 01170 INTEGER TCIDSC,TFKEY(8),TLACKY 01180 DATA TCIDSC/0/,TLACKY/0/ 011901 01200 INTEGER TLRKY,TLRPNT,TLRWKY,TYPE 01210 DATA TLRKY/0/,TLRPNT/0/,TLRWKY/0/,TYPE/0/ 012201 01230C MESSAGE BUFFERS************MESSAGE BUFFERS 012401 01250 INTEGER ACCTNO(10) 01260 DATA ACCTNO/$D0A,'1234567890123456',$D0A/ 012701 01280 INTEGER MSG2(40) 01290 DATA MSG2/$1820,'DO YOU WISH TO PRINT ALL OF THE LETTERS ' 01300 +, 'REQUESTED BY THE COLLECTORS?',$0D0A,' (Y/N): '/ 013101 01320 INTEGER MSG4(30) 01330 DATA MSG4/'LINE THE * TO THE TOP OF PAGE AND SEVENTH CHARACTER ' 01340 +, 'POSITION'/ 013501 01360 INTEGER MSG4A(31) 01370 DATA MSG4A/ 01380 1$1820,'DO YOU WISH TO HAVE ANOTHER ALIGNMENT ', 01390 2 'LINE PRINTED? (Y/N) :' / 014001 01410 INTEGER MSG6(40) 01420 DATA MSG6/ 01430 1$A0D,'ENTER ACCOUNT NUMBER OF THE NEXT LETTE', 01440 2 'R TO BE PRINTED - (16 DIGITS MAX). ',$0A0D/ 014501 01460 INTEGER MSG7(33) 01470 DATA MSG7/ ' UNABLE TO LOCATE ACCOUNT ', 01480 1 'IN THE DELQMST FILE '/ 014901 01500 INTEGER MSG5(33) 01510 DATA MSG5/$A0D,'UNABLE TO LOCATE ACCOUNT ', 01520 1 ' IN THE TRNSFL FILE '/ 015301 01540 INTEGER MSG9(23) 01550 DATA MSG9/ 01560 1 ' UNABLE TO LOCATE COLLECTOR TTTT IN UTIFIL. '/ 015701 01580 INTEGER MSG9A(40) 01590 DATA MSG9A/ 01600 1 ' LETTER TO BE SENT TO ACCOUNT NUMBER XX', 01610 2 'XXXXXXXXXXXXXX HAS NOT BEEN PRINTED '/ 016201 01630 INTEGER MSG10(40) 01640 DATA MSG10/ 01650 1 ' UNABLE TO LOCATE LETTER NUMBER ', 01660 2 'TO BE SENT TO ACCT# . '/ 016701 016801 01690 INTEGER MSG12(40) 01700 DATA MSG12/ 01710 1 ' UNABLE TO LOCATE ACCOUNT XXXXXXXXXXXXX', 01720 2 'XXX IN THE COSIGNER FILE '/ 017301 01740 INTEGER MSG13(23) 01750 DATA MSG13/ '1 UNABLE TO LOCATE LTRF RECORD IN THE UTIFIL '/ 017601 01770 INTEGER REFLIN(2),COF(2) 01780 DATA REFLIN/'RE: '/,COF/'C/O '/ 017901 018001 01810C EXTERNALS************************** 018201 01830 EXTERNAL AMONTO,AYERTO,ADAYTO 018401 01850C**** SYSPRT PARAMETERS........ 018601 01870 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 018801 01890 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 01900 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 01910 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 019201 01930 DATA PLN/080/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 019401 01950 INTEGER USER(4),GRPBUF(10) 01960 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 019701 01980 DATA PLU/12/,IWAY/3/,IMODE/3/ 019901 02000C**** 02010C**** BEGIN PROGRAM ....... 020201 02030C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 020401 02050 CALL PGMINT( IADR,ICTLD ) 020601 02070 CALL PGMIN ( USER,LU,MODE,NPORT ) 020801 02090C*** CCS/LA LOOK-ALIKE..... 021001 02110 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 02120 IF ( ICM.EQ.0 ) GO TO 5 02130 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 02140 CALL CCSMVA( LD2,1,8,DAT2,1,16 ) 02150 CALL CCSMVA( LD3,1,8,DAT3,1,16 ) 02160 CALL CCSMVA( LD4,1,8,DAT4,1,16 ) 02170 5 CONTINUE 021801 02190 CALL GTSYSP( IWAY, 25 ) 02200 CALL GTSYSP( IMODE, 26 ) 02210 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 02220 CALL GETGRP( GRPBUF,IALL,IMODE ) 022301 02240C**** OPEN FILES AND GET UTIFIL RECORDS 022501 02260 IF( NPORT.EQ.0 .OR. IPF.EQ.1 ) GO TO 25 02270 EJT = $0C20 02280 DBLSPC = $0A20 022901 02300 25 CONTINUE 023101 02320 CALL SYSPRT( ICM,0,SYSPRM,0 ) 02330 IF( ISERR.LT.0 ) GO TO 9840 023401 02350C BRING IN SYSTEM DATE 023601 02370 40 DT(1)=AND($FFFF,AMONTO) 02380 DT(2)=AND($FFFF,ADAYTO) 02390 DT(3)=AND($FFFF,AYERTO) 024001 02410C OPEN LETTER FILE (LTRFIL) 024201 02430 50 CALL OPENFL(REQ3,DAT3,ISTAT) 02440 IF( ISTAT.LT.0 ) GO TO 9820 024501 02460C OPEN TRANSACTION FILE (TRNSFL) 024701 02480 70 CALL OPENFL(REQ4,DAT4,ISTAT) 02490 IF( ISTAT.LT.0 ) GO TO 9830 025001 02510C OPEN DELINQUENT MASTER FILE (DELQMST) - OVERRIDE LOCKED RECORDS 025201 02530 80 CALL OPENFL(REQ2,DAT2,ISTAT) 02540 REQ2(23)=1 02550 IF( ISTAT.LT.0 ) GO TO 9810 025601 02570C OPEN COSIGNER FILE - OVERRIDE LOCKED RECORDS 025801 02590 90 CALL OPENFL(REQ1, DAT1, ISTAT) 02600 REQ1(23)=1 02610 IF( ISTAT.LT.0 ) GO TO 9800 026201 02630C INITIALIZE COUNTERS AND POINTERS 026401 02650 120 COLCPO=0 02660 NUMCLC=0 02670 LTLPT=0 02680 TLRPNT=0 02690 LTBUPT=0 027001 02710C PROMPT OPERATOR TO ALIGN PAPER IN PRINTER 027201 02730 200 CONTINUE 02740 CALL CCSBLK(OBUF,PLN) 02750 CALL CCSMVA( PBUF , 1, 2, OBUF, 1, PLN ) 02760C PUT * IN 7TH POSITION, REQUIRES DISPLACEMENT OF 8 02770 CALL CCSMVA (ASTRSK, 2, 1, OBUF, 8, 1) 02780 CALL CCSMVA(MSG4, 1, 60, OBUF, 12, 60) 027901 02800 230 CONTINUE 02810 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 028201 02830 240 CALL CCSBLK( IOBUF,80 ) 02840 CALL WTREAD(LU,XYN,MSG4A,62,XYN,IOBUF,80,ITC) 02850 IF(IOBUF(1) .EQ. YES) GO TO 230 02860 IF(IOBUF(1) .EQ. NO) GO TO 300 02870 GO TO 240 028801 02890 02900. 02910C*********************************************************************** 02920C 02930C READ UTILITY FILE TO 02940C GET SALUTATION CODES FROM UTILITY FILE 02950C 02960C*********************************************************************** 029701 02980 300 CONTINUE 02990 CALL GETUTI( SALC,IOBUF,IFOUND,IFER,0 ) 03000 IF( IFER.LT.0 ) GO TO 9840 03010 IF( IFOUND.NE.1 ) GO TO 330 030201 03030 320 CONTINUE 03040 CALL CCSMVA( SALC,1,4,MSG13,20,4 ) 03050 GO TO 350 030601 03070C LOAD SALUTATION CODES ARRAY 030801 03090 330 CALL CCSMVA(IOBUF, 5, 65, SALARA, 1, 65) 031001 03110C READ THE LTRF RECORD FROM THE UTIFIL 03120 340 CONTINUE 03130 CALL GETUTI( LTRF,LTRFBF,IFOUND,IFER,0 ) 03140 IF( IFER.LT.0 ) GO TO 9840 03150 IF( IFOUND.NE.1 ) GO TO 400 031601 03170C DID NOT FIND LTRF PRINT MESSAGE 03180 350 CONTINUE 03190 CALL CCSMVA(MSG13,1,46,OBUF,1,PLN) 03200 360 CONTINUE 03210 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 03220 GO TO 9900 032301 03240C*********************************************************************** 03250C 03260C CHECK WITH OPERATOR TO DETERMINE IF ALL LETTERS ARE TO BE 03270C PRINTED. 03280C 03290C*********************************************************************** 033001 03310 400 CONTINUE 03320 CALL CCSBLK( IOBUF,80 ) 03330 410 CALL WTREAD(LU,XYN,MSG2,80,XYN,IOBUF,80,ITC) 03340 IF(IOBUF(1) .EQ. YES) GO TO 430 03350 IF(IOBUF(1) .EQ. NO) GO TO 420 03360 GO TO 400 033701 03380C GET ACCOUNT NUMBER FROM OPERATOR 033901 03400 420 CALL CCSBLK( IOBUF,80 ) 03410 MSG2 = MSG6 03420 CALL WTREAD(LU,XYN,MSG6,80,0, 0, 0, ITC) 03430 CALL WTREAD(LU,XYN,ACCTNO,20,XYN,IOBUF,80 ,ITC) 03440 IF( ITC.NE.2 ) GO TO 420 034501 03460 CALL CCSMVA( IOBUF,1,IOBUF(41),TACTWK,1,16 ) 034701 034801 03490C LOCATE ACCOUNT IN TRANSACTION FILE LETTER PRINT IS TO 03500C START WITH 035101 03520 430 CONTINUE 03530 TFKEY(1) = ZERO 03540 TFKEY(2) = 1 035501 03560 CALL READR( REQ4,TFBUF,TFKEY,ISTAT ) 03570 IF( IOBUF.EQ.YES ) GO TO 507 03580 GO TO 445 035901 03600 440 CONTINUE 03610 CALL GETS( REQ4,TFBUF,TFKEY,ISTAT ) 03620 445 CONTINUE 03630 IF( AND(ISTAT,EOF).EQ.EOF ) GO TO 470 03640 IF( ISTAT.LT.0 ) GO TO 9830 036501 03660 450 CALL CCSCST(TFBUF, 1, 16, TACTWK, 1, 16, ICOMP) 03670C ****************************************************** ???*A031 03680 IF (ICOMP .NE. 0) GO TO 440 03690C CHECK TO BE SURE THIS RECORD IS A VALID LETTER REQUEST. 03700 CALL CCSCST (TFBUF, 29, 2, RECTYP, 1, 2, ICOMP) 03710 IF (ICOMP .NE. 0) GO TO 440 03720 CALL CCSCST (TFBUF, 41, 2, BLANK, 1, 2, ICOMP) 03730 IF (ICOMP .EQ. 0) GO TO 440 03740 GO TO 520 03750C ****************************************************** ???*A031 037601 03770C*** NOTIFY OPERATOR OF INABILITY TO LOCATE ACCOUNT NUMBER 037801 03790 470 CALL CCSMVA(TACTWK,1,16,MSG5,28,16) 03800 CALL WTREAD(LU,XYN,MSG5,66,0,0,0,ITC) 03810 GO TO 400 038201 03830. 03840C*********************************************************************** 03850C 03860C READ TRANSACTION FILE 03870C 03880C*********************************************************************** 038901 03900 500 CONTINUE 03910 IF( ICTLD.NE.0 ) GO TO 9900 03920 CALL CCSBLK(TACTKY, 16) 03930 CALL CCSBLK(TLRKY, 2) 03940 TLACKY=0 039501 03960 505 CALL GETS (REQ4, TFBUF, TFBUF, ISTAT) 03970 507 IF(AND(ISTAT, EOF) .EQ. EOF) GO TO 3000 03980 IF( ISTAT.LT.0 ) GO TO 9830 039901 04000C CHECK FOR RECORD TYPE 040101 04020 520 CALL CCSCST(TFBUF, 29, 2, RECTYP, 1, 2, ICOMP) 04030 IF(ICOMP .NE. 0) GO TO 500 04040 CALL CCSCST(TFBUF,41,2,BLANK,1,2,ICOMP) 04050 IF(ICOMP.EQ.0) GO TO 500 040601 04070C*** CHECK FOR VALID ACCOUNT GROUP 04080 IF( ICKGRP( GRPBUF,IALL,TFBUF,1 ).EQ.1 ) GO TO 500 040901 04100C MOVE ACCOUNT NUMBER (TACCT) TO KEY (TACTKY) 041101 04120 04130 530 CALL CCSMVA(TFBUF, 1, 16, TACTKY, 1, 16) 041401 04150C READ UTIFIL TO GET COLLECTOR INFO 04160C IF COLLECTOR ID NOT FOUND DONT PROCESS 04170C ANY OF THE LETTERS WITH THIS ID. 041801 04190 540 CALL CCSMVA(TFBUF,17,4,TCIDKY,1,4) 042001 04210 550 COID=0 042201 04230C*** IF SAME COLLECTOR ID AS LAST, THEN SKIP 042401 04250 CALL CCSCST( TCIDKY,1,4,MSG9,30,4,ICM ) 04260 IF( ICM.EQ.0 ) GO TO 566 04270 CALL CCSCST( TCIDKY,1,4,IOBUF,1,4,ICM ) 04280 IF( ICM.EQ.0 ) GO TO 570 042901 04300 CALL GETUTI( TCIDKY,IOBUF,IFOUND,IFER,0 ) 04310 IF( IFOUND.NE.1 ) GO TO 570 04320 IF( IFER.LT.0 ) GO TO 9840 043301 04340C COLLECTOR ID WAS NOT FOUND PRINT MESSAGE 04350 560 CONTINUE 04360 CALL CCSMVA(TFBUF,17,4,MSG9,30,4) 04370 CALL CCSMVA(MSG9,1,46,OBUF,1,PLN) 043801 04390C PRINT MESSAGE COID NOT FOUND 044001 04410 564 CONTINUE 04420 PBUF = EJT 04430 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 04440 PBUF = DBLSPC 04450 CALL SYSPRT( PBUF,2,SYSPRM,0 ) 04460 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 04470 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 044801 04490 566 CONTINUE 04500 CALL CCSMVA(TFBUF,1,16,MSG9A,39,16) 04510 CALL CCSMVA(MSG9A,1,80,OBUF,1,PLN) 045201 04530C PRINT ACCOUNT NUMBER OF LETTER NOT PRINTED 045401 04550 568 CONTINUE 04560 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 04570 GO TO 500 045801 04590C MOVE LETTER CODE(TLR) TO KEY (TLRKY) 046001 04610 570 CALL CCSMVA(TFBUF, 41, 2, TLRKY, 1, 2) 046201 046301 04640C MOVE LETTER ADDRESS CODE (TLAC) TO KEY (TLACKY) 046501 04660 580 CALL CCSGET(TFBUF, 105, TLACKY) 046701 04680. 04690C*********************************************************************** 04700C 04710C READ LETTER FILE(LTFIL) KEY = TLRKY FROM 04720C TRANSACTION FILE 04730C 04740C*********************************************************************** 047501 04760 700 CALL CCSCST(TLRKY, 1, 2, TLRWKY, 1, 2, ICOMP) 04770 IF(ICOMP .EQ. 0) GO TO 1000 047801 04790C NOT EQUAL MOVE KEY TO WORK KEY 048001 04810 730 CALL CCSMVA(TLRKY, 1, 2, TLRWKY, 1, 2) 048201 04830C TLRKY AND TLRWKY NOT EQUAL - READ LETTER FILE 048401 04850 750 CALL READR(REQ3,LTFILB, TLRKY, ISTAT) 04860 IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 780 04870 IF( ISTAT.LT.0 ) GO TO 9820 04880 GO TO 900 048901 04900C NOTIFY OPEATOR UNABLE TO LOCATE REQUESTED LETTER 049101 04920 780 CALL CCSMVA(TLRWKY,1, 2, MSG10, 34, 2) 04930 CALL CCSMVA(TACTKY, 1, 16, MSG10, 61, 16) 04940 CALL CCSMVA(MSG10,1,80,OBUF,1,PLN) 04950 GO TO 2200 049601 04970C INITIALIZE COUNTERS AND ARRAYS 049801 04990 900 FCOUNT=0 05000 FSWICH=0 05010 IPOINT=0 05020C DMBUPT=0 05030 LCOUNT=0 05040 ICOL=0 05050 NOF=0 050601 05070C MOVE MAXIMUM OF 9 VALID FIELD DESCRIPTIONS TO TABLE FARRAY 050801 05090 920 IPOINT=IPOINT+3 05100 IARAPT=1 05110 CALL CCSBLK(FARRAY,54) 051201 05130 930 DO 990 I=1,9 05140 CALL CCSCST(LTFILB,IPOINT,2,FEQ,1,2,ICOMP) 05150 935 IF(ICOMP .NE. 0) GO TO 995 051601 05170C LTFILB = 'F=' - SET SWITCH AND MOVE POINTER 051801 05190 940 FSWICH=1 05200 IPOINT=IPOINT+2 052101 05220C CHECK FOR 'F=NO' - WHICH DESIGNATES A LETTER WITH NO F FIELDS. 052301 05240 950 CALL CCSCST(LTFILB,IPOINT, 1, NO, 1, 1, ICOMP) 05250 IF(ICOMP.NE.0) GO TO 960 05260 NOF=1 05270 IPOINT=IPOINT+1 05280 START=IPOINT 05290 GO TO 1000 053001 05310C STORE IN ARRAY USING LINE NUMBER AS POINTER 053201 05330 960 CALL CCSMVA(LTFILB, IPOINT, 6, FARRAY, IARAPT, 6) 053401 05350C INCREMENT COUNTERS AND POINTERS 053601 05370 970 IARAPT=IARAPT+6 05380 IPOINT=IPOINT+6 05390 FCOUNT=FCOUNT+1 054001 05410 990 CONTINUE 05420 995 START=IPOINT 05430. 05440C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 05450C 05460C READ INFORMATION FOR LETTER 05470C 05480C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 054901 05500C*** CHECK IF TO SEND TO COSIGNER OR BORROWER ? 055101 05520 1000 CONTINUE 05530 IF( TLACKY.LT.$31 .OR. TLACKY.GT.$33 ) GO TO 1030 055401 05550C SEND TO COSIGNER READ COSIGNER FILE 05560 CALL READR(REQ1,DMBUF,TACTKY,ISTAT) 05570 IF(AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 1010 05580 IF(AND(ISTAT,EOF).EQ.EOF) GO TO 1010 05590 IF(ISTAT.LT.0) GO TO 9800 05600 GO TO 1020 056101 05620C COSIGNER WAS NOT FOUND PRINT MESSAGE 05630 1010 CONTINUE 05640 CALL CCSMVA( TFBUF,1,16,MSG12,28,16 ) 05650 CALL CCSMVA(MSG12,1,80,OBUF,1,PLN ) 05660 GO TO 2200 056701 05680C SEND TO CORRECT COSIGNER 05690 1020 J=((TLACKY-$30)-1)*115 05700 CALL CCSMVA(DMBUF,J+20,30,MNAM,1,30) 05710 CALL CCSMVA(DMBUF,J+50,30,MADR1,1,30) 05720 CALL CCSBLK(MADR2,30) 05730 CALL CCSMVA(DMBUF,J+80,20,MCS,1,20) 05740 CALL CCSMVA(DMBUF,J+100,5,MZP,1,5) 05750 CALL CCSBLK(MBNM,30) 05760 CALL CCSGET(DMBUF,J+18,MSLCD) 057701 05780C READ DELQMST FOR LETTER FIELDS 05790 1030 CONTINUE 05800 CALL READR(REQ2,DMBUF,TACTKY,ISTAT) 05810 IF(AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 1040 05820 IF(AND(ISTAT,EOF).EQ.EOF) GO TO 1040 05830 IF(ISTAT.LT.0) GO TO 9810 05840 GO TO 1050 058501 05860C DID NOT FIND BORROWER PRINT MESSAGE 05870 1040 CONTINUE 05880 CALL CCSMVA( TFBUF,1,16,MSG7,28,16 ) 05890 CALL CCSMVA(MSG7,1,66,OBUF,1,PLN) 05900 GO TO 2200 059101 05920C CHECK FOR HOME OR BUSINESS 05930C MOVE IN DATA FOR HEADINGS 05940C************************************************************ ???*A03 05950C FIRST MOVE THE LETTER DATE 05960C AND AMOUNT FROM TRANSFL 05970 1050 CALL CCSMVA(TFBUF,106,6,DMBUF,842,6) 05980 CALL CCSMVA(TFBUF,112,9,DMBUF,848,9) 05990 IF(TLACKY.EQ.B) GO TO 1070 06000C*********************************************************** ???*A037 06010C CHECK IF COSIGNER 06020 IF(TLACKY .GE. $31 .AND. TLACKY .LE. $33) GO TO 1100 060301 06040C SEND TO BORROWERS HOME 06050 1060 CALL CCSGET( DMBUF,17,MSLCD ) 06060 CALL CCSMVA(DMBUF,18,30,MNAM,1,30) 06070 CALL CCSMVA(DMBUF,48,30,MADR1,1,30) 06080 CALL CCSMVA(DMBUF,78,30,MADR2,1,30) 06090 CALL CCSMVA(DMBUF,108,30,MCS,1,20) 06100 CALL CCSMVA(DMBUF,128,5,MZP,1,5) 06110 CALL CCSBLK(MBNM,30) 06120 GO TO 1100 061301 06140C SEND TO BORROWERS BUSINESS ADDRESS 06150 1070 CALL CCSMVA(DMBUF,18,30,MNAM,1,30) 06160 CALL CCSGET( DMBUF,17,MSLCD ) 06170 CALL CCSMVA(DMBUF,177,30,MADR1,1,30) 06180 CALL CCSMVA(DMBUF,207,20,MCS,1,20) 06190 CALL CCSMVA(DMBUF,227,5,MZP,1,5) 06200 CALL CCSMVA(DMBUF,147,30,MBNM,1,30) 06210 CALL CCSBLK(MADR2,30) 06220 GO TO 1100 06230. 06240C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 06250C 06260C PRINT THE LETTER 06270C 06280C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 062901 06300C PRINT THE TOP 8 LINES 06310 1100 CONTINUE 06320 PBUF = EJT 06330 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 06340 PBUF = DBLSPC 06350 CALL SYSPRT( PBUF,DATLIN,SYSPRM,0 ) 063601 06370C PRINT DATE 06380C BLANK OUT BUFFER RECEIVING CONVERTED DATE 06390 1140 CALL CCSBLK( OBUF,PLN ) 06400 CALL CCSBLK(DATBUF,26) 06410 CALL LTRDTE(DT,DATBUF,1,1) 06420 1150 CALL CCSMVA(DATBUF,1,26,OBUF,46,26) 06430 OBUF = DBLSPC 06440 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 064501 06460C PRINT REFERENCE 06470 1160 CALL CCSBLK( OBUF(2),PLN-2 ) 06480 CALL CCSMVA(REFLIN,1,4,OBUF,46,4) 064901 06500C CHECK ACCOUNT SWITCH IN LTRF 06510 1170 CALL CCSCST(LTRFBF,5,1,TWO,2,1,ICOMP) 06520 CALL CCSMVA(TFBUF,2,15,OBUF,51,15) 06530 IF(ICOMP.EQ.0) GO TO 1180 06540 CALL CCSMVA(TFBUF,1,1,OBUF,50,1) 06550 1180 CONTINUE 06560 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 065701 06580C GET SALUTATION 06590C ****************************************************** ???*A034 06600 1190 SALLEN = 1 06610 CALL CCSBLK (FULNAM, 40) 06620 CALL CCSBLK (LASNAM, 30) 06630C CHECK FOR NON-LEGAL SALUTATION CODE 06640 IF (MSLCD .LT. $31 .OR. MSLCD .GT. $38) GO TO 1220 06650 MSLCD = MSLCD - $30 06660C ****************************************************** ???*A034 06670 N=(MSLCD-1)*8+1 06680 CALL CCSMVA(SALARA,N,8,FULNAM,1,8) 066901 06700C FIND END OF SALUTATION 06710 1200 DO 1210 I=1,8 06720 CALL CCSCST(FULNAM,I,1,BLANK,1,1,ICOMP) 06730 IF(ICOMP.EQ.0) GO TO 1215 06740 1210 CONTINUE 06750 1215 IF(I.GT.1) GO TO 1216 06760 SALLEN=1 06770 GO TO 1220 06780 1216 SALLEN=I+1 067901 06800C FIND END OF LAST NAME 06810 1220 DO 1230 I=1,30 06820 CALL CCSCST(MNAM,I,1,COMMA,1,1,ICOMP) 06830 IF(ICOMP.EQ.0) GO TO 1250 06840 1230 CONTINUE 068501 06860C COMMA NOT FOUND PRINT AS IS 06870 CALL CCSMVA(MNAM,1,30,FULNAM,SALLEN,30) 068801 06890C FIND END OF NAME 06900 DO 1245 FULLEN=30,1,-1 06910 CALL CCSCST(FULNAM,FULLEN,1,BLANK,1,1,ICOMP) 06920 IF(ICOMP.NE.0) GO TO 1246 06930 1245 CONTINUE 06940 FULLEN=30 06950 1246 GO TO 1290 069601 06970C MOVE LAST NAME INTO BUFFER 06980 1250 LASLEN=I-1 06990 CALL CCSMVA(MNAM,1,LASLEN,LASNAM,1,LASLEN) 070001 070101 07020C FIND FIRST NAME 07030 1260 N1=I+1 07040 DO 1262 I=N1,30 07050 CALL CCSCST(MNAM,I,1,BLANK,1,1,ICOMP) 07060 IF(ICOMP.NE.0) GO TO 1264 07070 1262 CONTINUE 070801 07090C NO FIRST NAME 07100 CALL CCSMVA(MNAM,1,LASLEN,FULNAM,SALLEN,LASLEN) 07110 FULLEN=LASLEN+SALLEN 07120 GO TO 1290 071301 07140C FOUND FIRST NAME, FIND END OF FIRST NAME 07150 1264 N1=I 07160 DO 1266 I=N1,30 07170 CALL CCSCST(MNAM,I,1,BLANK,1,1,ICOMP) 07180 IF(ICOMP.EQ.0) GO TO 1275 07190 1266 CONTINUE 072001 07210C DID NOT FIND END OF FIRST NAME 07220 FIRLEN=30-N1+1 07230 GO TO 1280 072401 07250C SEE IF THERE IS MIDDLE INITIAL 07260 1275 CALL CCSCST(MNAM,I+1,1,BLANK,1,1,ICOMP) 07270 IF(ICOMP.NE.0) GO TO 1276 072801 07290C NO MIDDLE INITIAL 07300 FIRLEN=I-N1 07310 GO TO 1280 073201 07330C INCLUDE MIDDLE INITIAL IN FIRST NAME 07340 1276 FIRLEN=I-N1+2 073501 07360C MOVE FIRST NAME, MI AND LAST INTO FULNAM 07370 1280 FULLEN=SALLEN 07380 CALL CCSMVA( MNAM,N1,FIRLEN,FULNAM,FULLEN,FIRLEN) 07390 FULLEN=FULLEN+FIRLEN+1 07400 CALL CCSMVA(LASNAM,1,LASLEN,FULNAM,FULLEN,LASLEN) 07410 FULLEN=FULLEN+LASLEN-1 074201 07430C PRINT 2 BLANK LINES 07440 1290 CONTINUE 07450 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 074601 07470C PRINT NAME 07480 1300 CALL CCSBLK(OBUF,PLN) 07490 CALL CCSMVA(FULNAM,1,30,OBUF,MARGIN,30) 075001 07510 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 075201 07530C IF SENT TO BUSINESS PRINT C/O LINE 07540 1320 CALL CCSBLK( OBUF,PLN ) 07550 IF(TLACKY.NE.B) GO TO 1330 07560 CALL CCSMVA(COF,1,4,OBUF,MARGIN,4) 07570 CALL CCSMVA(MBNM,1,30,OBUF,MARGIN+5,30) 075801 07590 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 076001 07610C PRINT ADDRESS 1 07620 1330 CALL CCSBLK( OBUF,PLN ) 07630 CALL CCSMVA(MADR1,1,30,OBUF,MARGIN,30) 076401 07650 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 076601 07670C IF THERE IS A ADDRESS 2 PRINT IT 07680 1340 CALL CCSCST(MADR2,1,10,BLANK,1,10,ICOMP) 07690 IF(ICOMP.EQ.0) GO TO 1350 07700 CALL CCSBLK( OBUF,PLN ) 07710 CALL CCSMVA(MADR2,1,30,OBUF,MARGIN,30) 077201 07730 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 077401 07750C PRINT MCS AND ZIP 07760 1350 CALL CCSBLK( OBUF,PLN ) 07770 CALL CCSMVA(MCS,1,20,OBUF,MARGIN,20) 07780 CALL CCSMVA(MZP,1,5,OBUF,MARGIN+22,5) 07790 1355 CONTINUE 07800 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 078101 07820C PRINT 2 BLANK LINES 07830 1360 CALL CCSBLK(OBUF,PLN) 078401 07850 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 078601 07870 1370 CONTINUE 07880. 07890C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 07900C 07910C BUILD BODY OF THE LETTER 07920C 07930C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 079401 07950 1400 CALL CCSBLK(LTRARR,1520) 07960 IPOINT=START 07970 IAT=0 07980 CC=2 07990 1405 DO 1650 I=1,24 08000 IPOS=IPOINT 08010 LB=(I-1)*60+1 08020 LW=(I-1)*30+1 08030 LINCT=I 080401 08050C CHECK FOR END 08060 1430 CALL CCSCST(LTFILB,IPOINT,3,IEND,1,3,ICOMP) 08070 IF(ICOMP.EQ.0) GO TO 1660 080801 08090C IF FIRST LINE, GO CHECK FOR @ 08100 1440 IF(LINCT.EQ.1) GO TO 1500 081101 08120C LOOK FOR CARRIAGE CONTROL AND LENGTH 08130 1450 DO 1470 J=1,MAXLEN 081401 08150C MOVE IN CARRIAGE CONTROL FOR LAST LINE 08160 LTRARR(LW)=CC 081701 08180C GET BYTE AND CHECK FOR * 08190 1460 CALL CCSGET(LTFILB,IPOINT,N) 08200 1465 IF(N.EQ.ASTRSK) GO TO 1480 08210 IPOINT=IPOINT+1 082201 08230C END OF ASTERSK SEARCH LOOP 08240 1470 CONTINUE 082501 08260C BYTE WAS * GET CARRIAGE CONTROL 08270 1480 LENGTH=IPOINT-IPOS 08280 IPOINT=IPOINT+2 08290 CALL CCSGET(LTFILB,IPOINT,N) 08300 CC=N-$30 083101 08320C MOVE IN THE TEXT AND GET NEXT LINE 08330 1490 CALL CCSMVA(LTFILB,IPOS,LENGTH,LTRARR,LB+2,LENGTH) 08340 GO TO 1640 08350. 083601 08370C FIRST LINE ONLY 08380C CHECK FOR @ 08390 1500 DO 1630 J=1,MAXLEN 084001 08410C MOVE IN CARRIAGE CONTROL FROM LAST LINE 08420 LTRARR(LW)=CC 084301 08440C GET BYTE AND CHECK FOR @ 08450 1510 CALL CCSGET(LTFILB,IPOINT,N) 08460 1520 IF(N.NE.AT) GO TO 1600 084701 08480C BYTE WAS @ MOVE IN TEXT BEFORE @ 08490 1530 LENGTH=IPOINT-IPOS 08500 IAT=1 08510 CALL CCSMVA(LTFILB,IPOS,LENGTH,LTRARR,LB+2,LENGTH) 08520 LB=LB+LENGTH 08530 IPOINT=IPOINT+1 085401 08550C GET NAME TYPE 08560 1540 CALL CCSGET(LTFILB,IPOINT,N) 08570 NAMSW=N-$30 08580 IPOINT=IPOINT+1 085901 08600C GET PUNCUATION 08610 1550 CALL CCSGET(LTFILB,IPOINT,N) 08620 PUN=N 08630 IPOINT=IPOINT+3 086401 08650C GET CARRIAGE CONTROL 08660 1560 CALL CCSGET(LTFILB,IPOINT,N) 08670 CC=N-$30 086801 08690C MOVE IN THE NAME 08700 1570 IF(NAMSW.EQ.2.AND.SALLEN.GT.1) GO TO 1580 08710 CALL CCSMVA(FULNAM,1,FULLEN,LTRARR,LB+2,FULLEN) 08720 LB=LB+2+FULLEN 08730 GO TO 1590 08740C SET UP CORRECT SPACING FOR SALUTATION 08750 1580 SALLEN = SALLEN - 1 08760 CALL CCSMVA(FULNAM,1,SALLEN,LTRARR,LB+2,SALLEN) 08770 LB=LB+SALLEN 08780 CALL CCSMVA(LASNAM,1,LASLEN,LTRARR,LB+2,LASLEN) 08790 LB=LB+LASLEN+2 088001 08810C MOVE IN PUNCUATION AND GET NEXT LINE 08820 1590 CALL CCSMVA(PUN,2,1,LTRARR,LB,1) 08830 GO TO 1640 088401 08850C WAS NOT @ CHECK FOR * 08860 1600 IF(N.NE.ASTRSK) GO TO 1620 088701 08880C WAS * GET CARRIAGE CONTROL 08890 IPOINT=IPOINT+2 08900 CALL CCSGET(LTFILB,IPOINT,N) 08910 CC=N-$30 089201 08930C CHECK IF @ WAS FOUND 08940 1610 IF(IAT.EQ.1) GO TO 1640 089501 08960C NO @ WAS FOUND TREAT AS REGULAR LINE 08970 1615 LENGTH=IPOINT-IPOS-2 08980 GO TO 1490 089901 09000 1620 IPOINT=IPOINT+1 090101 09020C END OF FIRST ONLY LOOP 09030 1630 CONTINUE 090401 09050C END OF BUILD LETTER BODY LOOP 09060 1640 IPOINT=IPOINT+1 09070 1650 CONTINUE 09080. 09090C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 09100C 09110C BODY FOR LETTER HAS BEEN BUILT 09120C PUT IN PLUGS 09130C 09140C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 091501 09160 1660 DO 1710 I=1,9 09170 IW=(I-1)*3+1 09180 1665 IF(FARRAY(IW).EQ.BLANK) GO TO 1730 09190 LINE=FARRAY(IW)/$100 09200 COL=AND(FARRAY(IW),$FF) 09210 LB=(LINE-1)*60+COL+2 09220 LENGTH=FARRAY(IW+1)/$100 09230 TYPE=AND(FARRAY(IW+1),$FF) 09240 POS=AND(FARRAY(IW+2),$FFFF) 092501 09260C CHECK FOR WHICH TYPE OF PLUG 09270 1670 IF(TYPE.EQ.D) GO TO 1680 09280 IF(TYPE.EQ.DOL) GO TO 1690 09290 IF(TYPE.EQ.A) GO TO 1700 09300 GO TO 1700 093101 09320C TYPE WAS DATE MOVE IN DATE 09330C IF MASTER FILE POS IS ZERO, USE CURRENT DATE 09340 1680 IF (POS .NE. $0000) GO TO 1682 09350 CALL EDIT (DT, 1, LTRARR, LB, 1) 09360 GO TO 1710 09370C CHECK TYPE OF DATE TO PRINT 09380 1682 IF(LENGTH.EQ.2.OR.LENGTH.EQ.1) GO TO 1685 09390 IF(IDATVR(DMBUF,POS).LT.0) GO TO 1710 09400 CALL EDIT(DMBUF,POS,LTRARR,LB,1) 09410 GO TO 1710 09420 1685 CALL CCSMVA(DMBUF,POS,6,BUF,1,6) 09430 IF(IDATVR(BUF,1).LT.0) GO TO 1710 09440C DATE TYPE EQUAL 1 OR 2 09450 CALL CCSBLK(DATBUF,18) 09460 CALL LTRDTE(BUF,DATBUF,1,LENGTH) 09470 IF(LENGTH.EQ.1) CALL CCSMVA(DATBUF,1,18,LTRARR,LB,18) 09480 IF(LENGTH.EQ.2) CALL CCSMVA(DATBUF,1,12,LTRARR,LB,12) 09490 GO TO 1710 095001 09510C TYPE WAS DOLLAR,CENTER AND MOVE IN $ 09520 1690 CALL CCSBLK(BUF,12) 09530 CALL CCSMVA(BLANK,1,11,LTRARR,LB,11) 09540 CALL EDIT(DMBUF,POS,BUF,1,3) 095501 09560 DO 1692 J=1,10 09570 CALL CCSCST(BUF,J,1,BLANK,1,1,ICOMP) 09580 IF(ICOMP.NE.0) GO TO 1694 09590 1692 CONTINUE 09600 1694 LB=LB+((10-(10-J))/2) 09610 CALL CCSMVA(DOL,2,1,LTRARR,LB,1) 09620 N1=10-J+1 09630 CALL CCSMVA(BUF,J,N1,LTRARR,LB+1,N1) 09640 GO TO 1710 096501 09660C TYPE WAS ALPHA MOVE IN STRING 09670 1700 CALL CCSMVA(DMBUF,POS,LENGTH,LTRARR,LB,LENGTH) 096801 09690C END OF PLUG LOOP 09700 1710 CONTINUE 09710C PRINT THE BODY OF THE LETTER 09720 1730 DO 1830 I=1,24 09730 LB=(I-1)*60+1 09740 LW=(I-1)*30+1 09750 1740 IF(LTRARR(LW).EQ.$2020) GO TO 2000 09760 CC=LTRARR(LW) 097701 09780C CC IS NUMBER OF BLANK LINES TO PRINT 09790 1750 CONTINUE 09800 CALL CCSBLK( OBUF,PLN ) 09810 IF ( CC.LE.1 ) GO TO 1810 098201 09830 OBUF = DBLSPC 09840 IF ( CC.EQ.2 ) GO TO 1810 098501 09860 ICC = CC/2 09870 CC = CC - ICC*2 09880 IF( CC.EQ.0 ) ICC = ICC-1 09890 IF( CC.EQ.0 ) CC = 2 099001 09910 CALL SYSPRT( OBUF,ICC,SYSPRM,0 ) 09920 GO TO 1750 099301 09940C MOVE IN A LINE OF TEXT AND PRINT 09950 1810 CONTINUE 09960 CALL CCSMVA( LTRARR,LB+2,58,OBUF,MARGIN,58 ) 099701 09980 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 099901 10000C END OF PRINT LOOP 10010 1830 CONTINUE 100202 10030C PRINT 2 LINES 10040 2000 CONTINUE 10050 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 10060 CALL CCSBLK( OBUF,PLN ) 100701 10080C GET COID SALUTATION 10090C************************************************************** ???*A041 10100 2010 TCIDSC = 0 10110 CALL CCSMVA(IOBUF,21,1,TCIDSC,2,1) 10120C************************************************************** ???*A041 10130 TCIDSC=TCIDSC-$30 10140 N=MARGIN+27 10150C************************************************************** ???*A042 10160 2020 IF(TCIDSC.LE.0) GO TO 2051 10170C************************************************************** ???*A042 10180 J=(TCIDSC-1)*8+1 10190 CALL CCSMVA(SALARA,J,8,OBUF,N,8) 102001 10210C FIND END OF SALUTATION 10220 2030 DO 2040 I=1,8 10230 J=N+I 10240 CALL CCSCST(OBUF,J,1,BLANK,1,1,ICOMP) 10250 IF(ICOMP.EQ.0) GO TO 2050 10260 2040 CONTINUE 102701 10280C MOVE IN FIRST INITIAL 10290 2050 N=N+I+1 10300C************************************************************** ???*A042 10310 2051 CALL CCSMVA(IOBUF,20,1,OBUF,N,1) 10320C************************************************************** ???*A042 103301 10340C MOVE IN LAST NAME 10350 2060 N=N+2 10360 CALL CCSMVA(IOBUF,5,15,OBUF,N,15) 103701 10380C PRINT COID 10390 2070 CONTINUE 10400 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 104101 10420C PRINT PHONE NUMBER 10430 2080 N=MARGIN+27 10440C IF THERE IS A PHONE NUMBER, PRINT IT 10450 CALL CCSCST (IOBUF, 22, 10, BLANK, 1, 10, ICOMP) 10460 IF (ICOMP .EQ. 0) GO TO 2090 10470 CALL CCSBLK(OBUF(2),130) 10480 CALL EDIT(IOBUF,22,OBUF,N,4) 104901 10500 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 105101 10520C IF THERE IS AN EXTENSION PRINT IT 10530 2090 CALL CCSCST(IOBUF,32,4,BLANK,1,4,ICOMP) 10540 IF(ICOMP.EQ.0) GO TO 2100 10550 CALL CCSBLK(OBUF(2),130) 10560 CALL CCSMVA(EXT,1,3,OBUF,N,3) 10570 CALL CCSMVA(IOBUF,32,4,OBUF,N+4,4) 105801 10590 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 106001 10610C PRINT LTRF STRING 10620 2100 CONTINUE 10630 CALL CCSBLK( OBUF,PLN ) 10640 CALL CCSMVA(LTRFBF,6,30,OBUF,N,30) 106501 10660 OBUF = DBLSPC 10670 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 106801 10690 2110 CONTINUE 107001 10710C GO GET NEXT TRANSACTION 10720 2120 GO TO 500 107302 10740C PRINT ERROR MESSAGE 10750 2200 CONTINUE 10760 PBUF = EJT 10770 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 10780 PBUF = DBLSPC 10790 CALL SYSPRT( PBUF,2,SYSPRM,0 ) 10800 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 108101 10820 GO TO 500 108301 10840C**** DONE PRINT TWO PAGE EJECTS...... 108501 10860 3000 CONTINUE 10870 PBUF = EJT 10880 CALL SYSPRT( PBUF,2,SYSPRM,0 ) 10890 GO TO 9900 10900. 109101 10920C**** ERROR SECTION FILE 1 10930 9800 CONTINUE 10940 IREQ = AND(REQ1(4),$FF) 10950 IF (IREQ.LT.11) IREQ = IREQ-1 10960 IF (IREQ.EQ.18) IREQ = 10 10970 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 10980 IERR = 1 10990 GO TO 9900 110001 11010C**** ERROR SECTION FILE 2 11020 9810 CONTINUE 11030 IREQ = AND(REQ2(4),$FF) 11040 IF (IREQ.LT.11) IREQ = IREQ-1 11050 IF (IREQ.EQ.18) IREQ = 10 11060 CALL FILERR( DAT2,IREQ,ISTAT,LU ) 11070 IERR = 1 11080 GO TO 9900 110901 11100C**** ERROR SECTION FILE 3 11110 9820 CONTINUE 11120 IREQ = AND(REQ3(4),$FF) 11130 IF (IREQ.LT.11) IREQ = IREQ-1 11140 IF (IREQ.EQ.18) IREQ = 10 11150 CALL FILERR( DAT3,IREQ,ISTAT,LU ) 11160 IERR = 1 11170 GO TO 9900 111801 11190C**** ERROR SECTION FILE 4 11200 9830 CONTINUE 11210 IREQ = AND(REQ4(4),$FF) 11220 IF (IREQ.LT.11) IREQ = IREQ-1 11230 IF (IREQ.EQ.18) IREQ = 10 11240 CALL FILERR( DAT4,IREQ,ISTAT,LU ) 11250 IERR = 1 11260 GO TO 9900 112701 11280C**** ERROR SECTION FILE 5 11290 9840 CONTINUE 11300 IERR = 1 11310 GO TO 9900 113201 11330C CLOSE FILES AND EXIT 11340 9900 CONTINUE 11350 CALL CLOSFL(REQ3,ISTAT) 11360 CALL CLOSFL(REQ4,ISTAT) 11370 CALL CLOSFL(REQ2,ISTAT) 11380 CALL CLOSFL(REQ1,ISTAT) 11390 CALL GETUTI( ISTAT,ISTAT,IFOUND,IFER,2 ) 11400 CALL SYSPRT( ISTAT,0,SYSPRM,1 ) 114101 11420C EXIT 11430 CALL PGMOUT 11440 END 11450 END/ 11460GTSYSP DCK/ I=13,H 11470GTSYSP HOL/ 11480 SUBROUTINE GTSYSP( IPARM,IPOS ) 11490 1 /CCS3.0 SUBROUTINE GTSYSP SL-XXX 115001 11510C** CYBERCREDIT FINANCIAL SERVICES. 11520C** CYBERCREDIT FIELD SUPPORT GROUPS 11530C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 11540C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 11550C** 11560C** ************ 04/06/84 ************ PROGRAMMER : RWE 115701 11580C**** PROGRAM DESCRIPTION : GET SYSTEM PARAMETER FROM THE 11590C EXTERNAL FLAG RECORD IN THE UTIFIL. 116001 11610C*** CALLING SEQUENCE : CALL GTSYSP( IPARM,IPOS ) 116201 11630C PARAMETERS 116401 11650C IPARM : RETURNED VALUE ($0 TO $F WHICH IS 0 TO 15 DECIMAL) 11660C WHICH IS RETRIEVED FROM THE 'EXTERNAL FLAG RECORD' 11670C IN THE UTIFIL. 11680C IPOS : THE STARTING BYTE OF THE FLAG IN THE FLAG RECORD. 11690C ( SEE LAYOUT OF 'EXTERNAL FLAG RECORD' ) 117001 11710C EXAMPLE : CALL GTSYSP( IMODE,30 ) 11720C THIS WOULD RETRIEVE THE FLAG 2 FOR THE 11730C LTRSTA PROGRAM AND SET THE IMODE FLAG FOR 11740C SUBROUTINE GETGRP 11750C LTRSTA FLAGS START IN POS. 29, THERE ARE 4 FLAGS 11760C FLAG 1 = IWAY FOR SUBROUTINE PRTORF 11770C FLAG 2 = IMODE FOR SUBROUTINE GETGRP 11780C FLAG 3 = 11790C FLAG 4 = 118001 11810 INTEGER IPARM,IPOS 11820 +, SYSREC(42),SYSP(2),IGOT 118301 11840 DATA SYSP /'SYSP'/, IGOT / 0/ 118501 11860C**** 11870C**** BEGIN PROGRAM ....... 118801 11890 IF ( IGOT.NE.0 ) GO TO 100 11900 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 11910 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 11920 IGOT = 1 119301 11940 100 CONTINUE 11950 CALL CCSGET( SYSREC,IPOS,IFLG ) 119601 11970 IPARM = AND( IFLG,$F ) 11980 RETURN 11990 END 12000 END/ 12010GETUTI DCK/ I=13,H 12020GETUTI HOL/ 12030 SUBROUTINE GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 12040 1 /CCS3.0 SUBROUTINE GETUTI SL-XXX 120501 12060C** CYBERCREDIT FINANCIAL SERVICES. 12070C** CYBERCREDIT FIELD SUPPORT GROUPS 12080C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 12090C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 12100C** 12110C** ************ 04/06/84 ************ PROGRAMMER : RWE 121201 12130C**** PROGRAM DESCRIPTION : RETRIEVE RECORD BY KEY FROM UTIFIL. 121401 12150C*** CALLING SEQUENCE : CALL GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 121601 12170C PARAMETERS 121801 12190C KEYB : KEY OF UTIFIL RECORD TO BE RETRIEVED ( 2 WORDS ) 12200C REC : BUFFER TO RECIEVE THE RETRIEVED RECORD(40 WORDS ) 12210C BUFFER WILL BE BLANKS IF RECORD IS NOT FOUND. 12220C IFOUND : RETURNED VALUE DESIGNATING IF RECORD WAS FOUND. 12230C 0 = RECORD FOUND , 1 = RECORD NOT FOUND 12240C IFER : ISTAT OF FILE MANAGER CALL. (FROM UTIFIL) 12250C NOPT : PASSED. OPTION OF WHAT TO DO. 12260C 0 = RETRIEVE RECORD (LEAVE FILE OPEN) 12270C 1 = RETRIEVE RECORD (CLOSE FILE WHEN DONE) 12280C 2 = CLOSE FILE. 122901 12300 INTEGER KEYB(1),REC(1),IFOUND,IFER,NOPT 12310 +, DAT1(15),REQ1(24),R1KY(15),REC1(0042) 12320 +, USER(4),LU,NPORT,MODE 123301 12340 DATA DAT1 /'LAUTIFIL ',01,01,00/,REQ1/24*0/ 12350 DATA IOPN/0/ , IDUN/0/ 123601 12370C**** 12380C**** BEGIN PROGRAM ....... 123901 12400 IF ( NOPT.EQ.2 ) GO TO 500 12410 IF ( IOPN.EQ.1 ) GO TO 100 124201 12430C*** CHECK FOR LA LOOK-ALIKE 124401 12450 IF( IDUN.EQ.1 ) GO TO 5 12460 IDUN = 1 12470 CALL PGMIN( USER,LU,MODE,NPORT ) 12480 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 12490 IF ( ICM.EQ.0 ) GO TO 5 12500 CALL CCSMVA( DAT1,3,6,DAT1,1,16 ) 125101 12520 5 CONTINUE 12530 DO 20 I = 1,24 12540 REQ1(I) = 0 12550 20 CONTINUE 125601 12570 CALL OPENFL( REQ1,DAT1,ISTAT ) 12580 IF( ISTAT.LT.0 ) GO TO 800 12590 REQ1(23) = 1 12600 IOPN = 1 126101 12620 100 CONTINUE 12630 CALL CCSMVA( KEYB,1,4,R1KY,1,30 ) 12640 CALL READR ( REQ1,REC1,R1KY,ISTAT ) 12650 IF ( AND(ISTAT,$300).NE.0 ) GO TO 200 12660 IF ( ISTAT.LT.0 ) GO TO 800 126701 12680C*** RECORD FOUND PASS INFO BACK TO CALLER 126901 12700 120 CONTINUE 12710 IFER = ISTAT 12720 IFOUND = 0 12730 CALL CCSMVA( REC1,1,80,REC,1,80 ) 12740 IF( NOPT.EQ.1 ) GO TO 500 12750 GO TO 900 127601 12770C**** RECORD NOT FOUND RETURN BLANKS 127801 12790 200 CONTINUE 12800 IFER = AND( ISTAT,$7FFF ) 12810 IFOUND = 1 12820 CALL CCSMVA( REC1,1,0,REC,1,40 ) 12830 IF( NOPT.EQ.1 ) GO TO 500 12840 GO TO 900 128501 12860C**** CLOSE FILE AND RETURN 128701 12880 500 CONTINUE 12890 CALL CLOSFL( REQ1,ISTAT ) 12900 IOPN = 0 12910 GO TO 900 129201 12930C**** ERROR SECTION FOR FILE 129401 12950 800 CONTINUE 12960 IFOUND = 1 12970 IFER = ISTAT 12980 IF( AND(ISTAT,$8002).EQ.$8002 ) GO TO 900 12990 IREQ = AND(REQ1(4),$FF) 13000 IF(IREQ.LT.11) IREQ = IREQ-1 13010 IF(IREQ.EQ.18) IREQ = 10 13020 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 13030 GO TO 900 130401 13050 900 CONTINUE 13060 RETURN 13070 END 13080 END/ 13090PRTORF DCK/ I=13,H 13100PRTORF HOL/ 13110 SUBROUTINE PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 13120 1 /CCS3.0 SUBROUTINE PRTORF SL-XXX 131301 13140C** CYBERCREDIT FINANCIAL SERVICES. 13150C** CYBERCREDIT FIELD SUPPORT GROUPS 13160C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 13170C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 13180C** 13190C** ************ 04/06/84 ************ PROGRAMMER : RWE 132001 13210C**** PROGRAM DESCRIPTION : VALIDATE OUTPUT LOGICAL UNIT AND 13220C SET DIRECTION OF OUTPUT. 132301 13240C*** CALLING SEQUENCE : CALL PRTORF( IPF,LU,NLU,NPORT,IWAY ) 132501 13260C PARAMETERS 132701 13280C IPF : RETURNED VALUE DESIGNATING OUTPUT DIRECTION. 13290C 0 = OUTPUT TO LOCIGAL UNIT 'NLU' 13300C 1 = OUTPUT TO SYSPRT FILE 13310C LU : LOGICAL UNIT NUMBER OF REQUESTED OUTPUT DEVICE. 13320C NLU : RETURNED VALUE DESIGNATING VALIDATED LOGICAL 13330C UNIT TO OUTPUT TO. 13340C NPORT : CURRENT TERMINAL # ( FROM PGMIN ) 13350C IWAY : FLAG TO DETERMINE WHICH ACTION TO TAKE : 13360C 0 = FORCE OUTPUT TO DESIGNATED LOGICAL UNIT 13370C 1 = FORCE OUTPUT TO SYSPRT FILE 13380C 2 = NOT USED AT PRESENT TIME 13390C 3 = PROMPT OPERATOR FROM SCREEN, FOR OUTPUT DIRECTION 13400C 4 = GET 'IWAY' FLAG FROM UTIFIL 134101 13420 INTEGER IPF,PLU,NLU,NPORT,IWAY 13430 +, INP(41),CRT(4),PRINT(4),TAPE(5),MSGY(18) 13440 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 134501 13460 DATA MSG1/$180A,$0A07,'** SELECT DIRECTION OF OUTPUT ',$160A/ 13470 +, MSG2/$0D0A,' 0 = OUTPUT TO LOGICAL UNIT ',$1616/ 13480 +, MSG3/$0D0A,' 1 = OUTPUT TO SYSPRT FILE ',$1616/ 13490 +, MSG4/$0D0A,' ',$160A/ 13500 +, MSG5/$0D0A,' PLEASE ENTER SELECTION (0,1) : ',$1616/ 135101 13520 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 135301 13540 DATA CRT /'TERMINAL'/, PRINT /'PRINTER '/ 13550 +, TAPE /'TAPE DRIVE'/ 135601 13570C**** BEGIN PROGRAM ....... 135801 13590 MWAY = IWAY 13600 10 CONTINUE 13610 PLU = AND( PLU,$FF ) 13620 IF ( MWAY.EQ.1 ) GO TO 200 136301 13640 NLU = PLU 13650 IF ( NPORT.NE.00 ) NLU = 05 13660 IF ( NPORT.EQ.00 .AND. NLU.EQ.05 ) NLU = 04 13670 IF ( MWAY.EQ.3 ) GO TO 300 13680 IF ( MWAY.EQ.4 ) GO TO 400 136901 13700 100 CONTINUE 13710 IPF = 0 13720 IF ( MWAY.EQ.2 ) IPF = 0 13730 GO TO 800 137401 13750C*** OUTPUT FORCED TO SYSPRT FILE...... 137601 13770 200 CONTINUE 13780 IPF = 1 13790 GO TO 800 138001 13810C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 138201 13830 300 CONTINUE 13840 IF(NLU.EQ.05.OR.NLU.EQ.04) CALL CCSMVA( CRT,1,8,MSG2,18,12 ) 13850 IF(NLU.EQ.09.OR.NLU.EQ.12) CALL CCSMVA( PRINT,1,8,MSG2,18,12 ) 13860 IF(NLU.EQ.06.OR.NLU.EQ.16) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 13870 IF(NLU.EQ.17.OR.NLU.EQ.18) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 138801 13890 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 13900 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 13910 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 13920 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 139301 13940 310 CONTINUE 13950 CALL CCSMVA(INP,1,0,INP,1,82) 13960 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 13970 IF (ITC.EQ.4) GO TO 310 139801 13990C*** VALIDATE SELECTION.... 140001 14010 CALL CCSGET( INP,1,ICH ) 140201 14030 IF( INP(41).EQ.0 ) GO TO 320 14040 IF ( ICH.LT.$30 .OR. ICH.GT.$31 ) GO TO 310 140501 14060 320 IPF = AND( ICH,$F ) 14070 IF( IPF.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 14080 IF( IPF.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 140901 14100 CALL CCSMVA(INP,1,0,INP,1,82) 14110 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 14120 CALL CCSGET(INP,1,ICH) 14130 IF ( INP(41).EQ.0 ) GO TO 330 14140 IF ( ICH.NE.$59 ) GO TO 300 14150 330 CONTINUE 14160 GO TO 800 141701 14180C**** GET 'IWAY' WHAT TO DO FLAG FROM UTIFIL... 141901 14200 400 CONTINUE 14210 CALL GTSYSP( MWAY,73 ) 14220 IF ( MWAY.LT.0 .OR. MWAY.GT.3 ) MWAY = 0 14230 GO TO 10 142401 14250 800 RETURN 14260 END 14270 END/ 14280GETGRP DCK/ I=13,H 14290GETGRP HOL/ 14300 SUBROUTINE GETGRP( GRPBUF,IALL,IMODE ) 14310 1 /CCS3.0 SUBROUTINE GETGRP SL-XXX 143201 14330C** CYBERCREDIT FINANCIAL SERVICES. 14340C** CYBERCREDIT FIELD SUPPORT GROUPS 14350C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 14360C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 14370C** 14380C** ************ 04/06/84 ************ PROGRAMMER : RWE 143901 14400C**** PROGRAM DESCRIPTION : SELECT WHICH ACCOUNT GROUPS TO USE 144101 14420C*** CALLING SEQUENCE : CALL GETGRP( GRPBUF,IALL,IMODE ) 144301 14440C PARAMETERS 144501 14460C GRPBUF : 10 WORD ARRAY RETURNED TO PROGRAM WITH FROM 1 14470C TO 10 VALID ACCOUNT GROUPS 14480C ( FOR USE WITH FUNCTION 'ICKGRP' ) 14490C IALL : FLAG RETURNED DESIGNATING USE OF ACCOUNT GROUPS 14500C 0 = USE ALL ACCOUNT GROUPS 14510C 1 = USE ONLY ACCOUNT GROUPS IN GRPBUF ARRAY 14520C IMODE : FLAG TO DETERMINE WHICH ACTION TO TAKE : 14530C 0 = USE ALL ACCOUNT GROUPS 14540C 1 = USE ACCOUNT GROUPS 0-4 ONLY 14550C 2 = USE ACCOUNT GROUPS 5-9 ONLY 14560C 3 = PROMPT FROM SCREEN, WHICH OF (0-9) GROUPS TO USE 14570C 4 = PROMPT FROM SCREEN, EITHER ALL, OR 0-4, OR 5-9. 14580C 5 = GET 'IMODE' FLAG FROM UTIFIL 145901 14600 INTEGER GRPBUF(1),IALL,IMODE 14610 +, INP(41),MSGY(18),AGRPS(10),MINUS(10),ALL 14620 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 14630 +, MSGA(18),MSGB(18),MSGC(18),MSGD(18),MSGE(18),MSGF(20) 146401 14650 DATA MSG1/$180A,$0A0D,'** SELECT ACCOUNT GROUP OPTION',$160A/ 14660 +, MSG2/$0D0A,' 0 = ALL ACCOUNT GROUPS ',$1616/ 14670 +, MSG3/$0D0A,' 1 = ACCOUNT GROUPS 0-4 ONLY ',$1616/ 14680 +, MSG4/$0D0A,' 2 = ACCOUNT GROUPS 5-9 ONLY ',$160A/ 14690 +, MSG5/$0D0A,' PLEASE ENTER SELECTION(0,1,2) :',$1616/ 147001 14710 DATA MSGA/$180A,$0A0D,'* SELECT ACCOUNT GROUPS TO USE',$160A/ 14720 +, MSGB/$0D0A,' SEPARATE GROUPS BY COMMAS, ',$1616/ 14730 +, MSGC/$0D0A,' (I.E. 0,1,2,3, ETC...) OR ',$1616/ 14740 +, MSGD/$0D0A,' ENTER A FOR ALL GROUPS ',$160A/ 14750 +, MSGE/$0D0A,' PLEASE ENTER SELECTION -- :',$1616/ 147601 14770 DATA MSGF/$180A,'INVALID ENTRY : ',$160A/ 147801 14790 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 14800 +, AGRPS/'0,1,2,3,4,5,6,7,8,9,'/,MINUS/10*$FFFF/,ALL/'A,'/ 148101 14820C**** BEGIN PROGRAM ....... 148301 14840 MODE = IMODE 14850 IALL = 0 14860 CALL CCSMVA( MINUS,1,20,GRPBUF,1,20 ) 148701 14880 10 CONTINUE 14890 IF ( MODE.EQ.0 ) GO TO 50 14900 IF ( MODE.EQ.1 ) GO TO 100 14910 IF ( MODE.EQ.2 ) GO TO 200 14920 IF ( MODE.EQ.3 ) GO TO 300 14930 IF ( MODE.EQ.4 ) GO TO 400 14940 IF ( MODE.EQ.5 ) GO TO 500 149501 14960C**** SET AND USE ALL ACCOUNT GROUPS 149701 14980 50 CONTINUE 14990 IALL = 0 15000 CALL CCSMVA( AGRPS,1,20,GRPBUF,1,20 ) 15010 GO TO 800 150201 15030C**** SET AND USE GROUPS 0-4 ONLY 150401 15050 100 CONTINUE 15060 IALL = 1 15070 CALL CCSMVA( AGRPS,1,10,GRPBUF,1,10 ) 15080 GO TO 800 150901 15100C**** SET AND USE GROUPS 5-9 ONLY 151101 15120 200 CONTINUE 15130 IALL = 1 15140 CALL CCSMVA( AGRPS,11,10,GRPBUF,1,10 ) 15150 GO TO 800 151601 15170C**** ASK OPERATOR FROM SCREEN WHICH ACCOUNT GROUPS..... 151801 15190 300 CONTINUE 15200 CALL CCSMVA( MSG2,8,18,MSG2,4,30 ) 15210 CALL CCSMVA( MSG3,16,6,MSG3,4,30 ) 152201 15230 305 CONTINUE 15240 ASSIGN 305 TO IRTN 15250 ASSIGN 10 TO IRTN2 15260 CALL WTREAD(05,-1,MSGA ,36,0,0,0,ITC) 15270 CALL WTREAD(05,-1,MSGB ,36,0,0,0,ITC) 15280 CALL WTREAD(05,-1,MSGC ,36,0,0,0,ITC) 15290 CALL WTREAD(05,-1,MSGD ,36,0,0,0,ITC) 15300 MSGA = MSG1 153101 15320 310 CONTINUE 15330 CALL CCSMVA(INP,1,0,INP,1,82) 15340 CALL WTREAD(05,-1,MSGE ,36,-1,INP,80,ITC) 15350 IF (ITC.EQ.4) GO TO 310 15360 NCH = INP(41) 15370 NCH = (NCH+1)/2 15380 N2H = NCH*2 15390 CALL CCSPUT( $2C,N2H,INP ) 15400 IF ( INP.EQ.ALL ) GO TO 320 15410 GO TO 330 154201 15430C**** VERIFY ALL GROUPS TO BE USED... 154401 15450 320 CONTINUE 15460 MODE = 0 15470 CALL WTREAD( 05,-1,MSG2,36,0,0,0,ITC ) 15480 GO TO 425 154901 15500C**** VALIDATE INPUT FOR VALID GROUPS..... 155101 15520 330 CONTINUE 155301 15540 K = 1 15550 MELM= NCH-1 15560 IF (MELM.LE.1) GO TO 370 15570 DO 360 I=1,MELM 155801 15590 IF(INP(I).LT.INP(I+1))GO TO 360 15600 340 TEMP = INP(I) 15610 INP(I) = INP(I+1) 15620 INP(I+1) = TEMP 15630 DO 350 J=I,2,-K 15640 IF(INP(J).GT.INP(J-1))GO TO 360 15650 TEMP = INP(J) 15660 INP(J) = INP(J-1) 15670 INP(J-1) = TEMP 15680 350 CONTINUE 15690 360 CONTINUE 157001 15710C*** CHECK FOR DUPLICATE NUMBERS 157201 15730 JJ = NCH-1 15740 DO 365 I = 1,JJ 15750 IF ( INP(I).EQ.INP(I+1) ) GO TO 390 15760 365 CONTINUE 157701 15780C*** DISPLAY CHOICES AND VERIFY... 157901 15800 370 CONTINUE 15810 IF( INP(1).EQ.INP(2) ) GO TO 390 15820 DO 375 I = 1,NCH 15830 L = ( AND(INP(I),$FF00) )/256 15840 IF ( L.LT.$30 .OR. L.GT.$39 ) GO TO 390 15850 375 CONTINUE 15860 CALL CCSMVA( INP,1,N2H,MSG4,1,N2H ) 15870 CALL CCSMVA( INP,1,N2H-1,MSG3,11,20 ) 15880 CALL WTREAD( 05,-1,MSG3,36,0,0,0,ITC ) 15890 ASSIGN 380 TO IRTN2 15900 GO TO 425 159101 15920C*** SET GROUPS..... 159301 15940 380 CONTINUE 15950 IALL = 1 15960 CALL CCSMVA( MSG4,1,N2H,GRPBUF,1,N2H ) 15970 GO TO 800 159801 15990C*** ERROR IN NUMBER ENTRY ..... REPEAT PROMPT 160001 16010 390 CONTINUE 16020 MSGA = MSGB 16030 CALL CCSMVA( INP,1,N2H-1,MSGF,19,20 ) 16040 CALL WTREAD( 05,-1,MSGF,40,0,0,0,ITC ) 16050 GO TO IRTN 160601 16070C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 160801 16090 400 CONTINUE 16100 ASSIGN 400 TO IRTN 16110 ASSIGN 10 TO IRTN2 16120 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 16130 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 16140 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 16150 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 161601 16170 410 CONTINUE 16180 CALL CCSMVA(INP,1,0,INP,1,82) 16190 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 16200 IF (ITC.EQ.4) GO TO 410 162101 16220C*** VALIDATE SELECTION.... 162301 16240 CALL CCSGET( INP,1,ICH ) 162501 16260 IF( INP(41).EQ.0 ) GO TO 420 16270 IF ( ICH.LT.$30 .OR. ICH.GT.$32 ) GO TO IRTN 162801 16290 420 MODE = AND( ICH,$F ) 16300 IF( MODE.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,35,0,0,0,ITC) 16310 IF( MODE.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,35,0,0,0,ITC) 16320 IF( MODE.EQ.2 ) CALL WTREAD(05,-1,MSG4 ,35,0,0,0,ITC) 163301 16340 425 CONTINUE 16350 CALL CCSMVA(INP,1,0,INP,1,82) 16360 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 16370 CALL CCSGET(INP,1,ICH) 16380 IF ( INP(41).EQ.0 ) GO TO 430 16390 IF ( ICH.NE.$59 ) GO TO IRTN 16400 430 CONTINUE 16410 GO TO IRTN2 164201 16430C**** GET 'IMODE' WHAT TO DO FLAG FROM UTIFIL... 164401 16450 500 CONTINUE 16460 CALL GTSYSP( MODE,77 ) 16470 IF ( MODE.LT.0 .OR. MODE.GT.4 ) MODE = 0 16480 GO TO 10 164901 16500 800 RETURN 16510 END 16520 END/ 16530SYSPRT DCK/ I=13,H 16540SYSPRT HOL/ 16550 SUBROUTINE SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 16560 1 /CCS3.0 SUBROUTINE SYSPRT SL-XXX 165701 16580C** CYBERCREDIT FINANCIAL SERVICES. 16590C** CYBERCREDIT FIELD SUPPORT GROUPS 16600C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 16610C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 16620C** 16630C** ************ 04/06/84 ************ PROGRAMMER : RWE 166401 16650C**** PROGRAM DESCRIPTION : OUTPUT BUFFER TO LOGICAL UNIT OR 16660C TO A FILE 'SYSPRT'. 166701 16680C*** CALLING SEQUENCE : CALL SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 166901 16700C PARAMETERS 167101 16720C BUFFER : BUFFER CONTAINING CHARACTERS TO OUTPUT FROM. 16730C NTIMES : # OF TIMES TO OUTPUT THE BUFFER 16740C SYSPRM : 6 WORD ARRAY HOLDING PARAMETERS FOR SYSPRT 16750C SYSPRM(1) : PLN - NUMBER OF BYTES TO OUTPUT FROM BUFFER 16760C SYSPRM(2) : NLU - LOGICAL UNIT TO OUTPUT TO ( IGNORED IF 16770C OUTPUT IS TO FILE ) 16780C SYSPRM(3) : IPF - SWITCH DESIGNATING OUTPUT TO FILE OR LU 16790C 0 = LOGICAL UNIT. 1 = FILE. 2 = BOTH. 16800C SYSPRM(4) : NLINE - CURRENT LINE OR RECORD JUST OUTPUT. 16810C (INITIALIZED TO 0 BY CALLING PROGRAM) 16820C SYSPRM(5) : ISERR - ISTAT OF FILE MANAGER CALL TO FILE 16830C SYSPRM(6) : NU - NOT USED AT PRESENT TIME 16840C IOPT : WHAT TO DO FLAG. 0 = OUTPUT BUFFER TO FILE OR LU 16850C 1 = CLOSE FILE 168601 16870C**** SYSPRT PARAMETERS........ 168801 16890 INTEGER BUFFER(1),NTIMES,IOPT 16900 +, SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 169101 16920 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 16930 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 16940 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 169501 16960C**** FWRITE PARAMETERS..... 16970 INTEGER IFLAG,ITEMP(8) 169801 16990 DATA IFLAG /0/, ITEMP /8*0/ 170001 17010 INTEGER DAT1(15),REQ1(24),R1KY(15),REC1(0068) 17020 +, HEDR(18) 170301 17040 DATA HEDR/$0D0A,$0717,'ABORTED--PRINT FILE IS FULL FN='/ 17050 DATA DAT1 /'SYSPRT ',00,01,-1/,REQ1/24*0/ 17060 +, IOPN/0/ 170701 17080C**** 17090C**** BEGIN PROGRAM ....... 171001 17110 IF ( ISERR.LT.0 ) GO TO 800 17120 ISERR = 0 17130 LINE = NLINE 17140 LU = AND( NLU,$FF ) 17150 LENW = (PLN+1)/2 171601 17170 IF ( IOPT.NE.0 ) GO TO 950 17180 IF ( IPF.EQ.1 ) GO TO 400 17190 IF ( NTIMES.LE.0 ) GO TO 800 172001 17210 IF ( LU.EQ.05 .OR. LU.EQ.04 ) GO TO 20 17220 IF ( LU.EQ.09 .OR. LU.EQ.12 ) GO TO 20 17230 I = LENW 17240 GO TO 40 172501 17260 20 CONTINUE 17270 DO 30 I = LENW, 2, -1 17280 IF ( BUFFER(I).NE.$2020 ) GO TO 40 17290 30 CONTINUE 173001 17310 40 CONTINUE 17320 LENB = I * 2 173301 17340C*** WRITE BUFFER TO LOGICAL UNIT..... 173501 17360 IF ( LU.EQ.05 ) GO TO 140 17370 50 CONTINUE 173801 17390 DO 80 I = 1,NTIMES 174001 17410 ASSIGN 60 TO ICOMP 17420 CALL FWRITE( LU,BUFFER,LENB,ICOMP,IFLAG,ITEMP ) 17430 CALL DISP 17440 60 CONTINUE 174501 17460 80 CONTINUE 17470 GO TO 200 174801 17490C**** WRITE OUTPUT TO TERMINAL (MAX OF 132 BYTES)......... 175001 17510 140 CONTINUE 17520 DO 150 I = 1,NTIMES 175301 17540 ILN = LENB 17550 JLN = LENB 17560 IF ( ILN.GE.80 ) JLN = 80 175701 17580 CALL WTREAD( LU,-1,HEDR,2,0,0,0,ITC ) 17590 CALL WTREAD( LU,-1,BUFFER,JLN,0,0,0,ITC ) 176001 17610 JLN = ILN-80 17620 IF( JLN.LE.0 ) GO TO 150 176301 17640 CALL WTREAD( LU,-1,BUFFER(41),JLN,0,0,0,ITC ) 176501 17660 150 CONTINUE 176701 17680C**** INCREMENT LINE COUNT....... 176901 17700 200 CONTINUE 17710 NLINE = NLINE + NTIMES 17720 GO TO 800 177301 17740C**** WRITE BUFFER TO SYSPRT FILE.......... 177501 17760 400 CONTINUE 17770 IF ( IOPN.EQ.1 ) GO TO 420 177801 17790 DO 410 I = 1,24 17800 REQ1(I) = 0 17810 410 CONTINUE 178201 17830 CALL OPENFL( REQ1,DAT1,ISTAT ) 17840 IF( ISTAT.LT.0 ) GO TO 900 17850 IOPN = 1 178601 17870C**** OUTPUT BUFFER TO SYSPRT FILE.... 178801 17890 420 CONTINUE 17900 IF( NTIMES.LE.0 ) GO TO 800 17910 ILN = PLN 17920 IF( ILN.GT.132 ) ILN = 132 17930 CALL CCSMVA( BUFFER,1,ILN,REC1,1,132 ) 179401 17950 DO 440 I = 1,NTIMES 17960 CALL PUTS( REQ1,REC1,1,ISTAT ) 17970 IF( AND(ISTAT,$9000).EQ.$9000 ) GO TO 500 17980 IF( ISTAT.LT.0 ) GO TO 900 17990 440 CONTINUE 180001 18010 NLINE = NLINE+NTIMES 18020 GO TO 800 180301 18040C**** INFORM OPERATOR FILE IS FULL..... 180501 18060 500 CONTINUE 18070 ISERR = -1 18080 CALL CCSMVA( HEDR,1,36,REC1,1,132 ) 18090 CALL CCSMVA( DAT1,1,24,REC1,37,24 ) 18100 CALL WTREAD( 05,-1,REC1,64,0,0,0,ITC ) 18110 GO TO 950 181201 18130 800 CONTINUE 18140 RETURN 181501 18160C*** ERROR SECTION.... 181701 18180 900 CONTINUE 18190 ISERR = -1 18200 IREQ = AND(REQ1(4),$FF) 18210 IF(IREQ.LT.11) IREQ = IREQ-1 18220 IF(IREQ.EQ.18) IREQ = 10 18230 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 182401 18250C**** CLOSE FILE AND RETURN 182601 18270 950 CONTINUE 18280 CALL CLOSFL( REQ1,ISTAT ) 18290 IOPN = 0 18300 RETURN 18310 END 18320 END/ 18330ICKGRP DCK/ I=13,H 18340ICKGRP HOL/ 18350 INTEGER FUNCTION ICKGRP( GRPBUF,IALL,REC,IPOS ) 18360 1 /CCS3.0 SUBROUTINE ICKGRP SL-XXX 183701 18380C** CYBERCREDIT FINANCIAL SERVICES. 18390C** CYBERCREDIT FIELD SUPPORT GROUPS 18400C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 18410C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 18420C** 18430C** ************ 04/06/84 ************ PROGRAMMER : RWE 184401 18450C**** PROGRAM DESCRIPTION : VALIDATE RECORD FOR MATCH OF ACCT GROUP 184601 18470C*** CALLING SEQUENCE : 18480C ITF = ICKGRP( GRPBUF,IALL,REC,IPOS ) 18490C OR... IF ( ICKGRP( GRPBUF,IALL,REC,IPOS ).EQ. 1 ) GO TO 185001 18510C PARAMETERS 185201 18530C ICKGRP : RETURNED VALUE OF 0 = TRUE, OK TO USE RECORD 18540C 1 = FALSE, DON'T USE RECORD 18550C GRPBUF : 10 WORD ARRAY PASSED, CONTAINING VALID GROUPS 18560C ( BUILT BY SUBROUTINE 'GETGRP' ) 18570C IALL : PASSED FLAG DESIGNATING 18580C 0 = USE ALL ACCOUNT GROUPS ( FORCE ICKGRP TO TRUE ) 18590C 1 = LOOK FOR MATCH OF GROUP FROM RECORD, IN THE 18600C GRPBUF ARRAY 18610C REC : PASSED BUFFER OF RECORD CONTAING ACCT GROUP. 18620C IPOS : STARTING BYTE POS. IN REC OF ACCOUNT GROUP 186301 18640 INTEGER GRPBUF(1),IALL,REC(1),IPOS,TRUE,FALSE 186501 18660 DATA TRUE / 0/, FALSE / 1/ 186701 18680C**** 18690C**** BEGIN PROGRAM ....... 187001 18710 ICKGRP = TRUE 18720 IF ( IALL.EQ.0 ) GO TO 900 187301 18740 CALL CCSGET( REC,IPOS,IGRP ) 187501 18760 DO 200 I = 1,10 18770 J = I*2-1 18780 CALL CCSGET( GRPBUF,J,ICH ) 187901 18800 IF( ICH.EQ.$FF ) GO TO 800 18810 IF( ICH.EQ.IGRP ) GO TO 900 18820 200 CONTINUE 188301 18840C*** NO MATCH SET ICKGRP TO FALSE 188501 18860 800 CONTINUE 18870 ICKGRP = FALSE 18880 GO TO 900 188901 18900 900 RETURN 18910 END 18920 END/ 18930 END/ 18940*REW,7 18950*K,I7,P21,L14 18960*FTN 18970*EOF 18980*CLOSE 18990*K,I13,L14 19000*Z 19010*Z 19020__ J = I*2-1 18780 CALL CCSGET( GRPBUF,J,ICH ) 187901 18800 IF( ICH.EQ.$FF ) GO TO 800 18810 IF( ICH.EQ.IGRP ) GO TO 900 18820 200 CONTINUE 188301 18840C*** NO MATCH SET ICKGRP TO FALSE 188501 18860 800 CONTINUE 18870 ICKGRP = FALSE 18880 GO TO 900 188901 18900 900 RETURN 18910 END 18920 END/ 18930 END/ 18940*REW,7 18950*K,I7,P21,L14 18960*FTN 18970*EOF 18980*CLOSE 18990*K,I13,L14 19000( Q xJ.LTRSTACCS149 P(*JOB,,TWB.JOB LTRSTA INSTALL 08/23/84 00010*K,L14 00020*CTO, LTRSTA WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.LTRSTA , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.LTRSTA,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120LTRSTA DCK/ I,H 00130 DEL/ 2 00140 1 /B78 F CCS 3.0 .LA/LETTER STATS 05/84 SL-149 00150 DEL/ 11,14 00160 INTEGER IDUSER(4),DT(3),TRNREC(0690),TRNREQ(24) 00170 INTEGER TDATA(15),TYPE,TLR(3),COIDCT,MAT(100,50 ),COID(100) 00180 INTEGER COIDWK(2),COIDPS,PRT(66,8),PAGE,IBUF(3),ZERO(3) 00190 INTEGER BLANK,PRTLIN(66),POS,PASS,LTR1(40) 00200 DEL/ 16,17 00210 INTEGER HDL6(66),HDL7(66),C,TC(51),TL(100),LTR(100) 00220 INS/ 18 00230 INTEGER HDLA(66),HDLB(66),TTC 00240 DEL/ 21,22 00250 DATA TDATA/'LATRNSFL',8*$2020,0,10,0/,TRNREQ/24*0/ 00260 DATA TYPE/'01'/,COIDCT/0/,COIDWK/2*$FFFF/,TTC/0/,L/0/ 00270 DEL/ 24,26 00280 DATA TC/51*0/,TL/100*0/,LTR/100*0/,IBUF/3*$3030/ 00290 DATA BLANK/$2020/,MAT/ 5000*0/,COID/100*$2020/ 00300 DATA PASS/0/,IEOF/0/,IREC/0/ 00310 DEL/ 27,28 00320 DATA AST/'**'/,TOTAL/'TOTALS'/ 00330 DEL/ 31,62 00340C POS. 01 +------------------ THRU ------------------+ 44 00350 DATA HDL1/'1---------- HDR1 GOES HERE -------------- ' 00360 +, ' COLLECTOR LETTER STATISTICS ' 00370 +, ' PAGE '/ 003801 00390C POS. 01 +------------------ THRU ------------------+ 44 00400 DATA HDL2/' ---------- HDR2 GOES HERE -------------- ' 00410 +, ' AS OF: ' 00420 +, ' '/ 004301 00440C POS. 01 +------------------ THRU ------------------+ 44 00450 DATA HDL3/' ---------- HDR3 GOES HERE -------------- ' 00460 +, ' ' 00470 +, ' '/ 004801 00490C POS. 01 +------------------ THRU ------------------+ 44 00500 DATA HDL4/' ' 00510 +, ' LETTERS REQUESTED ' 00520 +, ' '/ 005301 00540C POS. 01 +------------------ THRU ------------------+ 44 00550 DATA HDL5/' COLLECTOR ' 00560 +, ' ' 00570 +, ' '/ 005801 00590C POS. 01 +------------------ THRU ------------------+ 44 00600 DATA HDL6/' COLLECTOR ' 00610 +, ' ' 00620 +, ' '/ 006301 00640C POS. 01 +------------------ THRU ------------------+ 44 00650 DATA HDLA/' COLLECTOR ' 00660 +, ' ' 00670 +, ' '/ 006801 00690C POS. 01 +------------------ THRU ------------------+ 44 00700 DATA HDLB/' COLLECTOR ' 00710 +, ' ' 00720 +, ' '/ 007301 00740C POS. 01 +------------------ THRU ------------------+ 44 00750 DATA HDL7/' TOTALS ' 00760 +, ' ' 00770 +, ' '/ 007801 00790C POS. 01 +------------------ THRU ------------------+ 44 00800 DATA HDL8/' LTR1 RECORD NOT FOUND ' 00810 +, ' ' 00820 +, ' '/ 008301 00840 INS/ 69 00850 EQUIVALENCE (PRT(1,7),HDLA(1)) 00860 EQUIVALENCE (PRT(1,8),HDLB(1)) 008701 00880 INTEGER UTFILE(4),SYPFIL(4) 00890 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 009001 00910 EQUIVALENCE ( TRNREQ(15), NUMRD ) 00920 INTEGER HEAD(18) 009301 00940 DATA HEAD/$0D0A,$0A17,'EXECUTING LTRSTA ',$0F16/ 009501 00960 INTEGER U(8),GRPBUF(10),HDR(20,3) 00970 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 009801 00990 DATA PLU/12/,IFOUND/0/ 010001 01010 INTEGER L14(66) 010201 01030 DATA L14/' **LTRSTA** ERROR IN FILE : XXXXXXXX ' 01040 +, ' RUN ABORTED ********** ' 01050 +, ' '/ 010601 01070C**** SYSPRT PARAMETERS........ 010801 01090 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 011001 01110 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 01120 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 01130 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 011401 01150 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 01160 DEL/ 71,93 011701 01180C**** 01190C**** BEGIN PROGRAM ....... 012001 01210C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 012201 01230 CALL PGMIN ( IDUSER,LUNIT,MODE,NPORT ) 012401 01250C*** CCS/LA LOOK-ALIKE..... 012601 01270 CALL CCSCST( TDATA,1,2,USER,1,8,ICM ) 01280 IF ( ICM.EQ.0 ) GO TO 5 01290 CALL CCSMVA( TDATA,3,6,TDATA,1,16 ) 01300 5 CONTINUE 013101 01320 CALL CCSMVA( IDUSER,1,8,HEAD,23,8 ) 01330 CALL WTREAD( LUNIT,-1,HEAD,36,0,0,0,ITC ) 01340 CALL UTHEAD( HDR,DT ) 013501 01360 CALL GTSYSP( IWAY, 29 ) 01370 CALL GTSYSP( IMODE, 30 ) 01380 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01390 CALL GETGRP( GRPBUF,IALL,IMODE ) 014001 01410C**** OPEN FILES AND GET UTIFIL RECORDS 014201 01430 CALL SYSPRT( HDL1,0,SYSPRM,0 ) 01440 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01450 IF( ISERR.LT.0 ) GO TO 9820 014601 01470 CALL OPENFL( TRNREQ,TDATA,ISTAT ) 01480 IF ( ISTAT.LT.0 ) GO TO 9800 01490 TRNREQ(23) = 1 015001 01510 CALL EDIT( DT,1,HDL2,70,1 ) 01520C--- CALL CCSTIM( HDL2(40) ) 01530 CALL CCSMVA( HDR(01,01),1,40,HDL1,2,40 ) 01540 CALL CCSMVA( HDR(01,02),1,40,HDL2,2,40 ) 01550 CALL CCSMVA( HDR(01,03),1,40,HDL3,2,40 ) 01560 IF(NPORT.NE.0) CALL CCSPUT( $0C,1,HDL1 ) 015701 01580 DEL/ 95,137 01590C READ LTR1 THRU LTR4 01600 150 DO 170 I=1,4 01610 155 CONTINUE 01620 CALL GETUTI( UTKEY,LTR1,IFOUND,IFER,0 ) 01630 IF( IFER.LT.0 ) GO TO 9810 01640 IF( IFOUND.EQ.0 ) GO TO 160 016501 01660 157 IF ( I.EQ.1 ) GO TO 900 01670 GO TO 180 016801 01690 160 UTKEY(2)=UTKEY(2)+1 017001 01710 162 DO 164 J=1,25 01720 J1=I*25-25+J 01730 J2=(J-1)*2+5 01740 J3= I+4 01750 J4=(J-1)*4+16 01760 CALL CCSCST(LTR1,J2,2,AST,1,2,ICOMP) 01770 IF(ICOMP.EQ.0) GO TO 170 01780 CALL CCSCST(LTR1,J2,2,BLANK,1,2,ICOMP) 01790 IF(ICOMP.EQ.0) GO TO 170 01800 CALL CCSMVA(LTR1,J2,2,PRT(1,J3),J4,2) 01810 CALL CCSMVA(LTR1,J2,2,IBUF,5,2) 01820 L = L+1 01830 LTR(L) = IBUF(3) 01840 164 CONTINUE 018501 01860 170 CONTINUE 018701 01880 180 CONTINUE 01890 CALL CCSMVA( HDL8,1,0,HDL8,1,132 ) 01900 DEL/ 139 01910 200 CONTINUE 01920 DEL/ 141,146 01930 IF( AND(ISTAT,$8100).EQ.$8100 ) GO TO 282 01940 IF( ISTAT.LT.0 ) GO TO 9800 019501 01960 DEL/ 148,150 01970 IF ( NREC.LE.0 ) GO TO 282 01980 230 DO 280 N=1,NREC 01990 JW=(N-1)*69 02000 JB=(N-1)*138 02010 INS/ 154 020201 02030C***** CHECK IF OK TO USE THIS ACCOUNT GROUP. 02040 IF( ICKGRP( GRPBUF,IALL,TRNREC,JB+1 ).EQ.1 ) GO TO 280 02050 DEL/ 158,159 02060 LTRNO = TLR(3) 02070 INS/ 167 02080 IF ( COIDCT.LE.50 ) GO TO 265 02090 KFLG = 1 02100 COIDCT = COIDCT-1 02110 GO TO 282 02120 262 CONTINUE 02130 KFLG = 0 02140 COIDCT = 1 02150 CALL CCSBLK( COID,200 ) 02160 DO 264 I0=1,100 02170 TL(I0) = 0 02180 IF( I0.LE.50 ) TC(I0) = 0 02190 DO 264 I1=1,50 02200 264 MAT(I0,I1) = 0 02210 265 CONTINUE 02220 TTC = TTC+1 02230 INS/ 175 02240 GO TO 280 02250 DEL/ 200 02260 TC(51)= TC(51) + TC(I) 02270 DEL/ 202,214 02280 DEL/ 216,387 022901 02300 LT = L 02310 IF ( LT.GT.0 ) LT = LT-1 02320 LTC = LT/25+1 023301 02340 DO 450 LTP=1,LTC 023501 02360 LZ = (L-LTP*25)+25 02370C PRINT PASS 1 THRU 3 02380 360 PASS = 1 02390 N1=(PASS-1)*50+1 02400 N2=PASS*50 02410 IF(C.LT.N2)N2=C 024201 02430C PRINT 1-25 02440 370 DO 440 I=N1,N2 02450 COIDPS=(I-1)*4+1 02460 IF(I.NE.N1) GO TO 410 024701 02480C PRINT HEADINGS 02490 380 PAGE=PAGE+1 02500 CALL BHXDEC(PAGE,IBUF) 02510 390 CALL CCSMVA(IBUF,5,2,HDL1,126,2) 025201 02530C CHECK IF LESS THAN 26 LETTERS 02540 IF(LZ.GE.26) GO TO 398 02550 J=LZ*4+16 02560 JJ=LTP+4 02570 CALL CCSMVA(TOTAL,1,6,PRT(1,JJ),J,6) 02580 398 DO 400 J=1,5 02590 JJ = J 02600 IF(J.GE.5)JJ=LTP+4 026101 02620 CALL SYSPRT( PRT(1,JJ),1,SYSPRM,0 ) 02630 IF( J.EQ.3 .OR. J.EQ.5 ) CALL SYSPRT( HDL8,1,SYSPRM,0 ) 026401 02650 400 CONTINUE 026601 02670C BUILD PRINT LINE 02680 410 CALL CCSBLK(PRTLIN,132) 02690 CALL CCSMVA(COID,COIDPS,4,UTKEY,1,4) 02700 CALL GETUTI( UTKEY,LTR1,IFOUND,IFER,0 ) 02710 IF ( IFER.LT.0 ) GO TO 9800 02720 IF ( IFOUND.EQ.1 ) CALL CCSMVA( UTKEY,1,4,LTR1,5,74 ) 027301 02740 415 CALL CCSMVA (LTR1,5,12,PRTLIN,2,12) 02750 IF(LZ.LT.26) L1=LZ 02760 IF(LZ.GE.26) L1=25 02770 DO 420 II=1,L1 02780 J=(II-1)*4+15 02790 J2=LTP*25-25+II 02800 CALL BHXDEC(MAT(J2,I),IBUF) 02810 418 CALL CCSMVA(IBUF,4,3,PRTLIN, J ,3) 02820 420 CONTINUE 028301 02840C IF LESS THAN 26 LETTERS MOVE TOTALS 02850C INTO FIRST PAGE 02860 IF(LZ.GE.26) GO TO 430 02870 CALL BHXDEC(TC(I),IBUF2) 02880 424 J=LZ*4+16 02890 CALL CCSMVA(IBUF2,3,4,PRTLIN,J,4) 02900C PRINT DETAIL LINE 02910 430 CONTINUE 02920 CALL SYSPRT( PRTLIN,1,SYSPRM,0 ) 029301 02940 440 CONTINUE 029501 02960C IF END-PRINT TOTAL LINE 02970 441 IF((I-1).LT.C) GO TO 450 02980 IF(KFLG.EQ.1) GO TO 450 02990 CALL CCSBLK(HDL7(7),118) 03000 DO 444 K=1,L1 03010 J=(K-1)*4+14 03020 J2= LTP*25-25+K 03030 CALL BHXDEC(TL(J2),IBUF2) 03040 443 CALL CCSMVA(IBUF2,3,4,HDL7,J,4) 03050 444 CONTINUE 030601 03070C IF LESS THAN 26 LETTERS CALCULATE AND 03080C PRINT TOTAL OF TOTALS 03090 446 IF (LZ .GE. 26) GO TO 4491 03100 CALL BHXDEC(TC(51),IBUF2) 03110 449 J=LZ*4+16 03120 CALL CCSMVA(IBUF2,3,4,HDL7,J,4) 03130 4491 CONTINUE 03140 CALL SYSPRT( HDL8,1,SYSPRM,0 ) 03150 CALL SYSPRT( HDL7,1,SYSPRM,0 ) 031601 03170 450 CONTINUE 03180 IF ( KFLG.EQ.1 ) GO TO 262 03190 GO TO 9900 032002 03210 DEL/ 388,393 032201 032301 03240C**** ERROR SECTION FILE 1 03250 9800 CONTINUE 03260 IREQ = AND(TRNREQ(4),$FF) 03270 IF (IREQ.LT.11) IREQ = IREQ-1 03280 IF (IREQ.EQ.18) IREQ = 10 03290 CALL FILERR( TDATA,IREQ,ISTAT,LUNIT ) 03300 CALL CCSMVA( TDATA,1,8,L14,32,8 ) 03310 IERR = 1 03320 GO TO 9900 033301 03340C**** ERROR SECTION FILE 2 03350 9810 CONTINUE 03360 CALL SYSPRT( HDL8,1,SYSPRM,0 ) 033701 03380C**** ERROR SECTION FILE 3 03390 9820 CONTINUE 03400 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 03410 IERR = 1 03420 GO TO 9900 034301 03440C**** CLOSE THE FILES AND EXIT........ 03450 9900 CONTINUE 03460 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 034701 03480 CALL CLOSFL( TRNREQ,ISTAT ) 03490 CALL GETUTI( UTKEY,LTR1,IFOUND,IFER,2 ) 03500 CALL SYSPRT( HDL4,0,SYSPRM,1 ) 035101 03520 CALL PGMOUT 03530GTSYSP DCK/ I=13,H 03540GTSYSP HOL/ 03550 SUBROUTINE GTSYSP( IPARM,IPOS ) 03560 1 /CCS3.0 SUBROUTINE GTSYSP SL-XXX 035701 03580C** CYBERCREDIT FINANCIAL SERVICES. 03590C** CYBERCREDIT FIELD SUPPORT GROUPS 03600C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 03610C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 03620C** 03630C** ************ 04/06/84 ************ PROGRAMMER : RWE 036401 03650C**** PROGRAM DESCRIPTION : GET SYSTEM PARAMETER FROM THE 03660C EXTERNAL FLAG RECORD IN THE UTIFIL. 036701 03680C*** CALLING SEQUENCE : CALL GTSYSP( IPARM,IPOS ) 036901 03700C PARAMETERS 037101 03720C IPARM : RETURNED VALUE ($0 TO $F WHICH IS 0 TO 15 DECIMAL) 03730C WHICH IS RETRIEVED FROM THE 'EXTERNAL FLAG RECORD' 03740C IN THE UTIFIL. 03750C IPOS : THE STARTING BYTE OF THE FLAG IN THE FLAG RECORD. 03760C ( SEE LAYOUT OF 'EXTERNAL FLAG RECORD' ) 037701 03780C EXAMPLE : CALL GTSYSP( IMODE,30 ) 03790C THIS WOULD RETRIEVE THE FLAG 2 FOR THE 03800C LTRSTA PROGRAM AND SET THE IMODE FLAG FOR 03810C SUBROUTINE GETGRP 03820C LTRSTA FLAGS START IN POS. 29, THERE ARE 4 FLAGS 03830C FLAG 1 = IWAY FOR SUBROUTINE PRTORF 03840C FLAG 2 = IMODE FOR SUBROUTINE GETGRP 03850C FLAG 3 = 03860C FLAG 4 = 038701 03880 INTEGER IPARM,IPOS 03890 +, SYSREC(42),SYSP(2),IGOT 039001 03910 DATA SYSP /'SYSP'/, IGOT / 0/ 039201 03930C**** 03940C**** BEGIN PROGRAM ....... 039501 03960 IF ( IGOT.NE.0 ) GO TO 100 03970 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 03980 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 03990 IGOT = 1 040001 04010 100 CONTINUE 04020 CALL CCSGET( SYSREC,IPOS,IFLG ) 040301 04040 IPARM = AND( IFLG,$F ) 04050 RETURN 04060 END 04070 END/ 04080GETUTI DCK/ I=13,H 04090GETUTI HOL/ 04100 SUBROUTINE GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 04110 1 /CCS3.0 SUBROUTINE GETUTI SL-XXX 041201 04130C** CYBERCREDIT FINANCIAL SERVICES. 04140C** CYBERCREDIT FIELD SUPPORT GROUPS 04150C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 04160C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 04170C** 04180C** ************ 04/06/84 ************ PROGRAMMER : RWE 041901 04200C**** PROGRAM DESCRIPTION : RETRIEVE RECORD BY KEY FROM UTIFIL. 042101 04220C*** CALLING SEQUENCE : CALL GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 042301 04240C PARAMETERS 042501 04260C KEYB : KEY OF UTIFIL RECORD TO BE RETRIEVED ( 2 WORDS ) 04270C REC : BUFFER TO RECIEVE THE RETRIEVED RECORD(40 WORDS ) 04280C BUFFER WILL BE BLANKS IF RECORD IS NOT FOUND. 04290C IFOUND : RETURNED VALUE DESIGNATING IF RECORD WAS FOUND. 04300C 0 = RECORD FOUND , 1 = RECORD NOT FOUND 04310C IFER : ISTAT OF FILE MANAGER CALL. (FROM UTIFIL) 04320C NOPT : PASSED. OPTION OF WHAT TO DO. 04330C 0 = RETRIEVE RECORD (LEAVE FILE OPEN) 04340C 1 = RETRIEVE RECORD (CLOSE FILE WHEN DONE) 04350C 2 = CLOSE FILE. 043601 04370 INTEGER KEYB(1),REC(1),IFOUND,IFER,NOPT 04380 +, DAT1(15),REQ1(24),R1KY(15),REC1(0042) 04390 +, USER(4),LU,NPORT,MODE 044001 04410 DATA DAT1 /'LAUTIFIL ',01,01,00/,REQ1/24*0/ 04420 DATA IOPN/0/ , IDUN/0/ 044301 04440C**** 04450C**** BEGIN PROGRAM ....... 044601 04470 IF ( NOPT.EQ.2 ) GO TO 500 04480 IF ( IOPN.EQ.1 ) GO TO 100 044901 04500C*** CHECK FOR LA LOOK-ALIKE 045101 04520 IF( IDUN.EQ.1 ) GO TO 5 04530 IDUN = 1 04540 CALL PGMIN( USER,LU,MODE,NPORT ) 04550 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 04560 IF ( ICM.EQ.0 ) GO TO 5 04570 CALL CCSMVA( DAT1,3,6,DAT1,1,16 ) 045801 04590 5 CONTINUE 04600 DO 20 I = 1,24 04610 REQ1(I) = 0 04620 20 CONTINUE 046301 04640 CALL OPENFL( REQ1,DAT1,ISTAT ) 04650 IF( ISTAT.LT.0 ) GO TO 800 04660 REQ1(23) = 1 04670 IOPN = 1 046801 04690 100 CONTINUE 04700 CALL CCSMVA( KEYB,1,4,R1KY,1,30 ) 04710 CALL READR ( REQ1,REC1,R1KY,ISTAT ) 04720 IF ( AND(ISTAT,$300).NE.0 ) GO TO 200 04730 IF ( ISTAT.LT.0 ) GO TO 800 047401 04750C*** RECORD FOUND PASS INFO BACK TO CALLER 047601 04770 120 CONTINUE 04780 IFER = ISTAT 04790 IFOUND = 0 04800 CALL CCSMVA( REC1,1,80,REC,1,80 ) 04810 IF( NOPT.EQ.1 ) GO TO 500 04820 GO TO 900 048301 04840C**** RECORD NOT FOUND RETURN BLANKS 048501 04860 200 CONTINUE 04870 IFER = AND( ISTAT,$7FFF ) 04880 IFOUND = 1 04890 CALL CCSMVA( REC1,1,0,REC,1,40 ) 04900 IF( NOPT.EQ.1 ) GO TO 500 04910 GO TO 900 049201 04930C**** CLOSE FILE AND RETURN 049401 04950 500 CONTINUE 04960 CALL CLOSFL( REQ1,ISTAT ) 04970 IOPN = 0 04980 GO TO 900 049901 05000C**** ERROR SECTION FOR FILE 050101 05020 800 CONTINUE 05030 IFOUND = 1 05040 IFER = ISTAT 05050 IF( AND(ISTAT,$8002).EQ.$8002 ) GO TO 900 05060 IREQ = AND(REQ1(4),$FF) 05070 IF(IREQ.LT.11) IREQ = IREQ-1 05080 IF(IREQ.EQ.18) IREQ = 10 05090 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 05100 GO TO 900 051101 05120 900 CONTINUE 05130 RETURN 05140 END 05150 END/ 05160PRTORF DCK/ I=13,H 05170PRTORF HOL/ 05180 SUBROUTINE PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 05190 1 /CCS3.0 SUBROUTINE PRTORF SL-XXX 052001 05210C** CYBERCREDIT FINANCIAL SERVICES. 05220C** CYBERCREDIT FIELD SUPPORT GROUPS 05230C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 05240C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 05250C** 05260C** ************ 04/06/84 ************ PROGRAMMER : RWE 052701 05280C**** PROGRAM DESCRIPTION : VALIDATE OUTPUT LOGICAL UNIT AND 05290C SET DIRECTION OF OUTPUT. 053001 05310C*** CALLING SEQUENCE : CALL PRTORF( IPF,LU,NLU,NPORT,IWAY ) 053201 05330C PARAMETERS 053401 05350C IPF : RETURNED VALUE DESIGNATING OUTPUT DIRECTION. 05360C 0 = OUTPUT TO LOCIGAL UNIT 'NLU' 05370C 1 = OUTPUT TO SYSPRT FILE 05380C LU : LOGICAL UNIT NUMBER OF REQUESTED OUTPUT DEVICE. 05390C NLU : RETURNED VALUE DESIGNATING VALIDATED LOGICAL 05400C UNIT TO OUTPUT TO. 05410C NPORT : CURRENT TERMINAL # ( FROM PGMIN ) 05420C IWAY : FLAG TO DETERMINE WHICH ACTION TO TAKE : 05430C 0 = FORCE OUTPUT TO DESIGNATED LOGICAL UNIT 05440C 1 = FORCE OUTPUT TO SYSPRT FILE 05450C 2 = NOT USED AT PRESENT TIME 05460C 3 = PROMPT OPERATOR FROM SCREEN, FOR OUTPUT DIRECTION 05470C 4 = GET 'IWAY' FLAG FROM UTIFIL 054801 05490 INTEGER IPF,PLU,NLU,NPORT,IWAY 05500 +, INP(41),CRT(4),PRINT(4),TAPE(5),MSGY(18) 05510 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 055201 05530 DATA MSG1/$180A,$0A07,'** SELECT DIRECTION OF OUTPUT ',$160A/ 05540 +, MSG2/$0D0A,' 0 = OUTPUT TO LOGICAL UNIT ',$1616/ 05550 +, MSG3/$0D0A,' 1 = OUTPUT TO SYSPRT FILE ',$1616/ 05560 +, MSG4/$0D0A,' ',$160A/ 05570 +, MSG5/$0D0A,' PLEASE ENTER SELECTION (0,1) : ',$1616/ 055801 05590 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 056001 05610 DATA CRT /'TERMINAL'/, PRINT /'PRINTER '/ 05620 +, TAPE /'TAPE DRIVE'/ 056301 05640C**** BEGIN PROGRAM ....... 056501 05660 MWAY = IWAY 05670 10 CONTINUE 05680 PLU = AND( PLU,$FF ) 05690 IF ( MWAY.EQ.1 ) GO TO 200 057001 05710 NLU = PLU 05720 IF ( NPORT.NE.00 ) NLU = 05 05730 IF ( NPORT.EQ.00 .AND. NLU.EQ.05 ) NLU = 04 05740 IF ( MWAY.EQ.3 ) GO TO 300 05750 IF ( MWAY.EQ.4 ) GO TO 400 057601 05770 100 CONTINUE 05780 IPF = 0 05790 IF ( MWAY.EQ.2 ) IPF = 0 05800 GO TO 800 058101 05820C*** OUTPUT FORCED TO SYSPRT FILE...... 058301 05840 200 CONTINUE 05850 IPF = 1 05860 GO TO 800 058701 05880C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 058901 05900 300 CONTINUE 05910 IF(NLU.EQ.05.OR.NLU.EQ.04) CALL CCSMVA( CRT,1,8,MSG2,18,12 ) 05920 IF(NLU.EQ.09.OR.NLU.EQ.12) CALL CCSMVA( PRINT,1,8,MSG2,18,12 ) 05930 IF(NLU.EQ.06.OR.NLU.EQ.16) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 05940 IF(NLU.EQ.17.OR.NLU.EQ.18) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 059501 05960 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 05970 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 05980 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 05990 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 060001 06010 310 CONTINUE 06020 CALL CCSMVA(INP,1,0,INP,1,82) 06030 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 06040 IF (ITC.EQ.4) GO TO 310 060501 06060C*** VALIDATE SELECTION.... 060701 06080 CALL CCSGET( INP,1,ICH ) 060901 06100 IF( INP(41).EQ.0 ) GO TO 320 06110 IF ( ICH.LT.$30 .OR. ICH.GT.$31 ) GO TO 310 061201 06130 320 IPF = AND( ICH,$F ) 06140 IF( IPF.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 06150 IF( IPF.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 061601 06170 CALL CCSMVA(INP,1,0,INP,1,82) 06180 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 06190 CALL CCSGET(INP,1,ICH) 06200 IF ( INP(41).EQ.0 ) GO TO 330 06210 IF ( ICH.NE.$59 ) GO TO 300 06220 330 CONTINUE 06230 GO TO 800 062401 06250C**** GET 'IWAY' WHAT TO DO FLAG FROM UTIFIL... 062601 06270 400 CONTINUE 06280 CALL GTSYSP( MWAY,73 ) 06290 IF ( MWAY.LT.0 .OR. MWAY.GT.3 ) MWAY = 0 06300 GO TO 10 063101 06320 800 RETURN 06330 END 06340 END/ 06350GETGRP DCK/ I=13,H 06360GETGRP HOL/ 06370 SUBROUTINE GETGRP( GRPBUF,IALL,IMODE ) 06380 1 /CCS3.0 SUBROUTINE GETGRP SL-XXX 063901 06400C** CYBERCREDIT FINANCIAL SERVICES. 06410C** CYBERCREDIT FIELD SUPPORT GROUPS 06420C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 06430C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 06440C** 06450C** ************ 04/06/84 ************ PROGRAMMER : RWE 064601 06470C**** PROGRAM DESCRIPTION : SELECT WHICH ACCOUNT GROUPS TO USE 064801 06490C*** CALLING SEQUENCE : CALL GETGRP( GRPBUF,IALL,IMODE ) 065001 06510C PARAMETERS 065201 06530C GRPBUF : 10 WORD ARRAY RETURNED TO PROGRAM WITH FROM 1 06540C TO 10 VALID ACCOUNT GROUPS 06550C ( FOR USE WITH FUNCTION 'ICKGRP' ) 06560C IALL : FLAG RETURNED DESIGNATING USE OF ACCOUNT GROUPS 06570C 0 = USE ALL ACCOUNT GROUPS 06580C 1 = USE ONLY ACCOUNT GROUPS IN GRPBUF ARRAY 06590C IMODE : FLAG TO DETERMINE WHICH ACTION TO TAKE : 06600C 0 = USE ALL ACCOUNT GROUPS 06610C 1 = USE ACCOUNT GROUPS 0-4 ONLY 06620C 2 = USE ACCOUNT GROUPS 5-9 ONLY 06630C 3 = PROMPT FROM SCREEN, WHICH OF (0-9) GROUPS TO USE 06640C 4 = PROMPT FROM SCREEN, EITHER ALL, OR 0-4, OR 5-9. 06650C 5 = GET 'IMODE' FLAG FROM UTIFIL 066601 06670 INTEGER GRPBUF(1),IALL,IMODE 06680 +, INP(41),MSGY(18),AGRPS(10),MINUS(10),ALL 06690 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 06700 +, MSGA(18),MSGB(18),MSGC(18),MSGD(18),MSGE(18),MSGF(20) 067101 06720 DATA MSG1/$180A,$0A0D,'** SELECT ACCOUNT GROUP OPTION',$160A/ 06730 +, MSG2/$0D0A,' 0 = ALL ACCOUNT GROUPS ',$1616/ 06740 +, MSG3/$0D0A,' 1 = ACCOUNT GROUPS 0-4 ONLY ',$1616/ 06750 +, MSG4/$0D0A,' 2 = ACCOUNT GROUPS 5-9 ONLY ',$160A/ 06760 +, MSG5/$0D0A,' PLEASE ENTER SELECTION(0,1,2) :',$1616/ 067701 06780 DATA MSGA/$180A,$0A0D,'* SELECT ACCOUNT GROUPS TO USE',$160A/ 06790 +, MSGB/$0D0A,' SEPARATE GROUPS BY COMMAS, ',$1616/ 06800 +, MSGC/$0D0A,' (I.E. 0,1,2,3, ETC...) OR ',$1616/ 06810 +, MSGD/$0D0A,' ENTER A FOR ALL GROUPS ',$160A/ 06820 +, MSGE/$0D0A,' PLEASE ENTER SELECTION -- :',$1616/ 068301 06840 DATA MSGF/$180A,'INVALID ENTRY : ',$160A/ 068501 06860 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 06870 +, AGRPS/'0,1,2,3,4,5,6,7,8,9,'/,MINUS/10*$FFFF/,ALL/'A,'/ 068801 06890C**** BEGIN PROGRAM ....... 069001 06910 MODE = IMODE 06920 IALL = 0 06930 CALL CCSMVA( MINUS,1,20,GRPBUF,1,20 ) 069401 06950 10 CONTINUE 06960 IF ( MODE.EQ.0 ) GO TO 50 06970 IF ( MODE.EQ.1 ) GO TO 100 06980 IF ( MODE.EQ.2 ) GO TO 200 06990 IF ( MODE.EQ.3 ) GO TO 300 07000 IF ( MODE.EQ.4 ) GO TO 400 07010 IF ( MODE.EQ.5 ) GO TO 500 070201 07030C**** SET AND USE ALL ACCOUNT GROUPS 070401 07050 50 CONTINUE 07060 IALL = 0 07070 CALL CCSMVA( AGRPS,1,20,GRPBUF,1,20 ) 07080 GO TO 800 070901 07100C**** SET AND USE GROUPS 0-4 ONLY 071101 07120 100 CONTINUE 07130 IALL = 1 07140 CALL CCSMVA( AGRPS,1,10,GRPBUF,1,10 ) 07150 GO TO 800 071601 07170C**** SET AND USE GROUPS 5-9 ONLY 071801 07190 200 CONTINUE 07200 IALL = 1 07210 CALL CCSMVA( AGRPS,11,10,GRPBUF,1,10 ) 07220 GO TO 800 072301 07240C**** ASK OPERATOR FROM SCREEN WHICH ACCOUNT GROUPS..... 072501 07260 300 CONTINUE 07270 CALL CCSMVA( MSG2,8,18,MSG2,4,30 ) 07280 CALL CCSMVA( MSG3,16,6,MSG3,4,30 ) 072901 07300 305 CONTINUE 07310 ASSIGN 305 TO IRTN 07320 ASSIGN 10 TO IRTN2 07330 CALL WTREAD(05,-1,MSGA ,36,0,0,0,ITC) 07340 CALL WTREAD(05,-1,MSGB ,36,0,0,0,ITC) 07350 CALL WTREAD(05,-1,MSGC ,36,0,0,0,ITC) 07360 CALL WTREAD(05,-1,MSGD ,36,0,0,0,ITC) 07370 MSGA = MSG1 073801 07390 310 CONTINUE 07400 CALL CCSMVA(INP,1,0,INP,1,82) 07410 CALL WTREAD(05,-1,MSGE ,36,-1,INP,80,ITC) 07420 IF (ITC.EQ.4) GO TO 310 07430 NCH = INP(41) 07440 NCH = (NCH+1)/2 07450 N2H = NCH*2 07460 CALL CCSPUT( $2C,N2H,INP ) 07470 IF ( INP.EQ.ALL ) GO TO 320 07480 GO TO 330 074901 07500C**** VERIFY ALL GROUPS TO BE USED... 075101 07520 320 CONTINUE 07530 MODE = 0 07540 CALL WTREAD( 05,-1,MSG2,36,0,0,0,ITC ) 07550 GO TO 425 075601 07570C**** VALIDATE INPUT FOR VALID GROUPS..... 075801 07590 330 CONTINUE 076001 07610 K = 1 07620 MELM= NCH-1 07630 IF (MELM.LE.1) GO TO 370 07640 DO 360 I=1,MELM 076501 07660 IF(INP(I).LT.INP(I+1))GO TO 360 07670 340 TEMP = INP(I) 07680 INP(I) = INP(I+1) 07690 INP(I+1) = TEMP 07700 DO 350 J=I,2,-K 07710 IF(INP(J).GT.INP(J-1))GO TO 360 07720 TEMP = INP(J) 07730 INP(J) = INP(J-1) 07740 INP(J-1) = TEMP 07750 350 CONTINUE 07760 360 CONTINUE 077701 07780C*** CHECK FOR DUPLICATE NUMBERS 077901 07800 JJ = NCH-1 07810 DO 365 I = 1,JJ 07820 IF ( INP(I).EQ.INP(I+1) ) GO TO 390 07830 365 CONTINUE 078401 07850C*** DISPLAY CHOICES AND VERIFY... 078601 07870 370 CONTINUE 07880 IF( INP(1).EQ.INP(2) ) GO TO 390 07890 DO 375 I = 1,NCH 07900 L = ( AND(INP(I),$FF00) )/256 07910 IF ( L.LT.$30 .OR. L.GT.$39 ) GO TO 390 07920 375 CONTINUE 07930 CALL CCSMVA( INP,1,N2H,MSG4,1,N2H ) 07940 CALL CCSMVA( INP,1,N2H-1,MSG3,11,20 ) 07950 CALL WTREAD( 05,-1,MSG3,36,0,0,0,ITC ) 07960 ASSIGN 380 TO IRTN2 07970 GO TO 425 079801 07990C*** SET GROUPS..... 080001 08010 380 CONTINUE 08020 IALL = 1 08030 CALL CCSMVA( MSG4,1,N2H,GRPBUF,1,N2H ) 08040 GO TO 800 080501 08060C*** ERROR IN NUMBER ENTRY ..... REPEAT PROMPT 080701 08080 390 CONTINUE 08090 MSGA = MSGB 08100 CALL CCSMVA( INP,1,N2H-1,MSGF,19,20 ) 08110 CALL WTREAD( 05,-1,MSGF,40,0,0,0,ITC ) 08120 GO TO IRTN 081301 08140C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 081501 08160 400 CONTINUE 08170 ASSIGN 400 TO IRTN 08180 ASSIGN 10 TO IRTN2 08190 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 08200 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 08210 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 08220 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 082301 08240 410 CONTINUE 08250 CALL CCSMVA(INP,1,0,INP,1,82) 08260 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 08270 IF (ITC.EQ.4) GO TO 410 082801 08290C*** VALIDATE SELECTION.... 083001 08310 CALL CCSGET( INP,1,ICH ) 083201 08330 IF( INP(41).EQ.0 ) GO TO 420 08340 IF ( ICH.LT.$30 .OR. ICH.GT.$32 ) GO TO IRTN 083501 08360 420 MODE = AND( ICH,$F ) 08370 IF( MODE.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,35,0,0,0,ITC) 08380 IF( MODE.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,35,0,0,0,ITC) 08390 IF( MODE.EQ.2 ) CALL WTREAD(05,-1,MSG4 ,35,0,0,0,ITC) 084001 08410 425 CONTINUE 08420 CALL CCSMVA(INP,1,0,INP,1,82) 08430 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 08440 CALL CCSGET(INP,1,ICH) 08450 IF ( INP(41).EQ.0 ) GO TO 430 08460 IF ( ICH.NE.$59 ) GO TO IRTN 08470 430 CONTINUE 08480 GO TO IRTN2 084901 08500C**** GET 'IMODE' WHAT TO DO FLAG FROM UTIFIL... 085101 08520 500 CONTINUE 08530 CALL GTSYSP( MODE,77 ) 08540 IF ( MODE.LT.0 .OR. MODE.GT.4 ) MODE = 0 08550 GO TO 10 085601 08570 800 RETURN 08580 END 08590 END/ 08600SYSPRT DCK/ I=13,H 08610SYSPRT HOL/ 08620 SUBROUTINE SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 08630 1 /CCS3.0 SUBROUTINE SYSPRT SL-XXX 086401 08650C** CYBERCREDIT FINANCIAL SERVICES. 08660C** CYBERCREDIT FIELD SUPPORT GROUPS 08670C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 08680C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 08690C** 08700C** ************ 04/06/84 ************ PROGRAMMER : RWE 087101 08720C**** PROGRAM DESCRIPTION : OUTPUT BUFFER TO LOGICAL UNIT OR 08730C TO A FILE 'SYSPRT'. 087401 08750C*** CALLING SEQUENCE : CALL SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 087601 08770C PARAMETERS 087801 08790C BUFFER : BUFFER CONTAINING CHARACTERS TO OUTPUT FROM. 08800C NTIMES : # OF TIMES TO OUTPUT THE BUFFER 08810C SYSPRM : 6 WORD ARRAY HOLDING PARAMETERS FOR SYSPRT 08820C SYSPRM(1) : PLN - NUMBER OF BYTES TO OUTPUT FROM BUFFER 08830C SYSPRM(2) : NLU - LOGICAL UNIT TO OUTPUT TO ( IGNORED IF 08840C OUTPUT IS TO FILE ) 08850C SYSPRM(3) : IPF - SWITCH DESIGNATING OUTPUT TO FILE OR LU 08860C 0 = LOGICAL UNIT. 1 = FILE. 2 = BOTH. 08870C SYSPRM(4) : NLINE - CURRENT LINE OR RECORD JUST OUTPUT. 08880C (INITIALIZED TO 0 BY CALLING PROGRAM) 08890C SYSPRM(5) : ISERR - ISTAT OF FILE MANAGER CALL TO FILE 08900C SYSPRM(6) : NU - NOT USED AT PRESENT TIME 08910C IOPT : WHAT TO DO FLAG. 0 = OUTPUT BUFFER TO FILE OR LU 08920C 1 = CLOSE FILE 089301 08940C**** SYSPRT PARAMETERS........ 089501 08960 INTEGER BUFFER(1),NTIMES,IOPT 08970 +, SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 089801 08990 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 09000 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 09010 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 090201 09030C**** FWRITE PARAMETERS..... 09040 INTEGER IFLAG,ITEMP(8) 090501 09060 DATA IFLAG /0/, ITEMP /8*0/ 090701 09080 INTEGER DAT1(15),REQ1(24),R1KY(15),REC1(0068) 09090 +, HEDR(18) 091001 09110 DATA HEDR/$0D0A,$0717,'ABORTED--PRINT FILE IS FULL FN='/ 09120 DATA DAT1 /'SYSPRT ',00,01,-1/,REQ1/24*0/ 09130 +, IOPN/0/ 091401 09150C**** 09160C**** BEGIN PROGRAM ....... 091701 09180 IF ( ISERR.LT.0 ) GO TO 800 09190 ISERR = 0 09200 LINE = NLINE 09210 LU = AND( NLU,$FF ) 09220 LENW = (PLN+1)/2 092301 09240 IF ( IOPT.NE.0 ) GO TO 950 09250 IF ( IPF.EQ.1 ) GO TO 400 09260 IF ( NTIMES.LE.0 ) GO TO 800 092701 09280 IF ( LU.EQ.05 .OR. LU.EQ.04 ) GO TO 20 09290 IF ( LU.EQ.09 .OR. LU.EQ.12 ) GO TO 20 09300 I = LENW 09310 GO TO 40 093201 09330 20 CONTINUE 09340 DO 30 I = LENW, 2, -1 09350 IF ( BUFFER(I).NE.$2020 ) GO TO 40 09360 30 CONTINUE 093701 09380 40 CONTINUE 09390 LENB = I * 2 094001 09410C*** WRITE BUFFER TO LOGICAL UNIT..... 094201 09430 IF ( LU.EQ.05 ) GO TO 140 09440 50 CONTINUE 094501 09460 DO 80 I = 1,NTIMES 094701 09480 ASSIGN 60 TO ICOMP 09490 CALL FWRITE( LU,BUFFER,LENB,ICOMP,IFLAG,ITEMP ) 09500 CALL DISP 09510 60 CONTINUE 095201 09530 80 CONTINUE 09540 GO TO 200 095501 09560C**** WRITE OUTPUT TO TERMINAL (MAX OF 132 BYTES)......... 095701 09580 140 CONTINUE 09590 DO 150 I = 1,NTIMES 096001 09610 ILN = LENB 09620 JLN = LENB 09630 IF ( ILN.GE.80 ) JLN = 80 096401 09650 CALL WTREAD( LU,-1,HEDR,2,0,0,0,ITC ) 09660 CALL WTREAD( LU,-1,BUFFER,JLN,0,0,0,ITC ) 096701 09680 JLN = ILN-80 09690 IF( JLN.LE.0 ) GO TO 150 097001 09710 CALL WTREAD( LU,-1,BUFFER(41),JLN,0,0,0,ITC ) 097201 09730 150 CONTINUE 097401 09750C**** INCREMENT LINE COUNT....... 097601 09770 200 CONTINUE 09780 NLINE = NLINE + NTIMES 09790 GO TO 800 098001 09810C**** WRITE BUFFER TO SYSPRT FILE.......... 098201 09830 400 CONTINUE 09840 IF ( IOPN.EQ.1 ) GO TO 420 098501 09860 DO 410 I = 1,24 09870 REQ1(I) = 0 09880 410 CONTINUE 098901 09900 CALL OPENFL( REQ1,DAT1,ISTAT ) 09910 IF( ISTAT.LT.0 ) GO TO 900 09920 IOPN = 1 099301 09940C**** OUTPUT BUFFER TO SYSPRT FILE.... 099501 09960 420 CONTINUE 09970 IF( NTIMES.LE.0 ) GO TO 800 09980 ILN = PLN 09990 IF( ILN.GT.132 ) ILN = 132 10000 CALL CCSMVA( BUFFER,1,ILN,REC1,1,132 ) 100101 10020 DO 440 I = 1,NTIMES 10030 CALL PUTS( REQ1,REC1,1,ISTAT ) 10040 IF( AND(ISTAT,$9000).EQ.$9000 ) GO TO 500 10050 IF( ISTAT.LT.0 ) GO TO 900 10060 440 CONTINUE 100701 10080 NLINE = NLINE+NTIMES 10090 GO TO 800 101001 10110C**** INFORM OPERATOR FILE IS FULL..... 101201 10130 500 CONTINUE 10140 ISERR = -1 10150 CALL CCSMVA( HEDR,1,36,REC1,1,132 ) 10160 CALL CCSMVA( DAT1,1,24,REC1,37,24 ) 10170 CALL WTREAD( 05,-1,REC1,64,0,0,0,ITC ) 10180 GO TO 950 101901 10200 800 CONTINUE 10210 RETURN 102201 10230C*** ERROR SECTION.... 102401 10250 900 CONTINUE 10260 ISERR = -1 10270 IREQ = AND(REQ1(4),$FF) 10280 IF(IREQ.LT.11) IREQ = IREQ-1 10290 IF(IREQ.EQ.18) IREQ = 10 10300 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 103101 10320C**** CLOSE FILE AND RETURN 103301 10340 950 CONTINUE 10350 CALL CLOSFL( REQ1,ISTAT ) 10360 IOPN = 0 10370 RETURN 10380 END 10390 END/ 10400ICKGRP DCK/ I=13,H 10410ICKGRP HOL/ 10420 INTEGER FUNCTION ICKGRP( GRPBUF,IALL,REC,IPOS ) 10430 1 /CCS3.0 SUBROUTINE ICKGRP SL-XXX 104401 10450C** CYBERCREDIT FINANCIAL SERVICES. 10460C** CYBERCREDIT FIELD SUPPORT GROUPS 10470C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 10480C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 10490C** 10500C** ************ 04/06/84 ************ PROGRAMMER : RWE 105101 10520C**** PROGRAM DESCRIPTION : VALIDATE RECORD FOR MATCH OF ACCT GROUP 105301 10540C*** CALLING SEQUENCE : 10550C ITF = ICKGRP( GRPBUF,IALL,REC,IPOS ) 10560C OR... IF ( ICKGRP( GRPBUF,IALL,REC,IPOS ).EQ. 1 ) GO TO 105701 10580C PARAMETERS 105901 10600C ICKGRP : RETURNED VALUE OF 0 = TRUE, OK TO USE RECORD 10610C 1 = FALSE, DON'T USE RECORD 10620C GRPBUF : 10 WORD ARRAY PASSED, CONTAINING VALID GROUPS 10630C ( BUILT BY SUBROUTINE 'GETGRP' ) 10640C IALL : PASSED FLAG DESIGNATING 10650C 0 = USE ALL ACCOUNT GROUPS ( FORCE ICKGRP TO TRUE ) 10660C 1 = LOOK FOR MATCH OF GROUP FROM RECORD, IN THE 10670C GRPBUF ARRAY 10680C REC : PASSED BUFFER OF RECORD CONTAING ACCT GROUP. 10690C IPOS : STARTING BYTE POS. IN REC OF ACCOUNT GROUP 107001 10710 INTEGER GRPBUF(1),IALL,REC(1),IPOS,TRUE,FALSE 107201 10730 DATA TRUE / 0/, FALSE / 1/ 107401 10750C**** 10760C**** BEGIN PROGRAM ....... 107701 10780 ICKGRP = TRUE 10790 IF ( IALL.EQ.0 ) GO TO 900 108001 10810 CALL CCSGET( REC,IPOS,IGRP ) 108201 10830 DO 200 I = 1,10 10840 J = I*2-1 10850 CALL CCSGET( GRPBUF,J,ICH ) 108601 10870 IF( ICH.EQ.$FF ) GO TO 800 10880 IF( ICH.EQ.IGRP ) GO TO 900 10890 200 CONTINUE 109001 10910C*** NO MATCH SET ICKGRP TO FALSE 109201 10930 800 CONTINUE 10940 ICKGRP = FALSE 10950 GO TO 900 109601 10970 900 RETURN 10980 END 10990 END/ 11000BHXDEC DCK/ I=13,H 11010BHXDEC HOL/ 11020 SUBROUTINE BHXDEC (NUM,IOUT) 11030 * /HEX TO DECIMAL W/LEADING BLANKS 11040C 11050 BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) 11060 DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) 11070C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. 11080 N=NUM 11090 DO 8 JK=1,3 11100 8 IOUT(JK)= $2020 11110 IF(N.EQ.0) IRIGHT(3)=$30 11120 IF(N.GE.0) GO TO 50 11130C MINUS NUMBER 11140 N=-N 11150 ILEFT(1)=$2D 1116050 CONTINUE 11170 I=5 1118055 CONTINUE 11190 IF(N.EQ.0) GO TO 200 11200 N1=(N/10)*10 11210 N2=N-N1+$30 11220 I1=I/2+1 11230 IF(AND(I,1).EQ.0) GO TO 100 11240 IRIGHT(I1)=N2 11250 GO TO 110 11260100 ILEFT(I1)=N2 11270110 CONTINUE 11280 N=N/10 11290 I=I-1 11300 IF(I.GT.0) GO TO 55 11310200 CONTINUE 11320 RETURN 11330 END 11340 END/ 11350 END/ 11360*REW,7 11370*K,I7,P21,L14 11380*FTN 11390*EOF 11400*CLOSE 11410*K,I13,L14 11420*Z 11430*Z 11440__ IF(N.EQ.0) GO TO 200 11200 N1=(N/10)*10 11210 N2=N-N1+$30 11220 I1=I/2+1 11230 IF(AND(I,1).EQ.0) GO TO 100 11240 IRIGHT(I1)=N2 11250( S l?J.MHUPDTCCS149 P(*JOB,,TWB.JOB MHUPDT INSTALL 08/23/84 00010*K,L14 00020*CTO, MHUPDT WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.MHUPDT , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.MHUPDT,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120MHUPDT DCK/ I,H 00130 DEL/ 2 00140 1 /B79 F CCS CCS 3.0 .LA - PSRD 07-83 SL-149 00150 DEL/ 42,48 00160 INTEGER DATAD(4),DATAC(4),DATAS(4),DATAT(4) 00170 DATA DATAD,DATAC,DATAS,DATAT/'DELQMST COSIGNERSUMHIST TAPEARC '/ 00180 DATA IDATAI /'LAINACCT',8*$2020,0,1,0/ 00190 DATA IDATAD /'LADLQMST',8*$2020,1,1,1/ 00200 DATA IDATAC /'LACOSIGN',8*$2020,1,1,1/ 00210 DATA IDATAA /'LAACTFIL',8*$2020,1,1,1/ 00220 DATA IDATAS /'LASUMHST',8*$2020,1,1,1/ 00230 DATA IDATAT /'LATAPARC',8*$2020,1,1,1/ 00240 DATA IDATAU /'LAUTIFIL',8*$2020,1,1,1/ 00250 INS/ 72 00260 CALL CCSCST(IDATAU,1,2,ID,1,8,ICM) 00270 IF(ICM.EQ.0) GO TO 5 00280 CALL CCSMVA(IDATAI,3,6,IDATAI,1,8) 00290 CALL CCSMVA(DATAD ,1,8,IDATAD,1,8) 00300 CALL CCSMVA(DATAC ,1,8,IDATAC,1,8) 00310 CALL CCSMVA(IDATAA,3,6,IDATAA,1,8) 00320 CALL CCSMVA(DATAS ,1,8,IDATAS,1,8) 00330 CALL CCSMVA(DATAT ,1,8,IDATAT,1,8) 00340 CALL CCSMVA(IDATAU,3,6,IDATAU,1,8) 00350 5 CONTINUE 00360 DEL/ 239 00370 GO TO 160 00380 DEL/ 251 00390C***** PSR 07/83 00400 IF (ICOMP.EQ.0) GO TO 360 00410C***** 00420 DEL/ 253,261 00430 DEL/ 285 00440 . GO TO 360 00450 DEL/ 298,299 00460C ACCT NOT R,S,W; READ NEXT INACCT RECORD 00470 GO TO 360 00480 DEL/ 339 00490C REC NOT THERE OR EOF, READ NEXT INACCT 00500 DEL/ 341 00510 . GO TO 360 00520 DEL/ 347,348 00530 IF(AND(IDLREC(153),$FF).EQ.$20) GO TO 360 00540 INS/ 364 00550C**************************************************** PSR (05/83) 00560C*** CHECK IF NAME CHANGE NOT COMPLETE - IF SO MOVE 00570C*** OLD NAME KEY TO CURRENT NAME KEY ! THEN DELETE 005801 00590 CALL CCSCST(IDLREC,1047,6,0,0,0,ICOMP) 00600 IF(ICOMP.NE.0) CALL CCSMVA(IDLREC,1047,6,IDLREC,18,6) 00610 INS/ 368 00620C**************************************************** PSR (05/83) 00630C*** IF CANT FIND OLD KEY 2 - THEN DONT WORRY ABOUT IT ! 006401 00650 IF(ISTAT.EQ.$8800) GO TO 720 00660C**************************************************** *** (05/83) 00670 INS/ 417 00680C ****************************************************** ???*0016 00690 GO TO 870 007001 00710C BLANK COSIGNER PART OF RECORD, NO 00720C COSIGNER FOUND 00730 860 CALL CCSBLK ( IDLREC, 500 ) 00740C ****************************************************** ???*0016 00750 DEL/ 420 00760C ****************************************************** ???*0016 00770 870 CONTINUE 00780C ****************************************************** ???*0016 00790 DEL/ 429 00800C ****************************************************** ???*0016 00810 IF ( ISTAT .GE. 0 ) GO TO 900 00820 IF ( AND(ISTAT,$8100) .NE. 0 ) GO TO 960 00830C ****************************************************** ???*0016 00840 INS/ 449 008501 00860C ****************************************************** ???*0016 00870C IF ACTFIL RECORD ALREADY CAME FROM TAPE 00880C HISTORY (SUFFIX > 50), CONTINUE TO READ 00890C AND DELETE BLOCKS OVER 50 - DO NOT SAVE 00900C TO TAPE 00910 IF ( IDLREC(K+8) .GE. $3531 ) GO TO 880 00920C ****************************************************** ???*0016 00930 DEL/ 509 00940 GO TO 1140 00950 DEL/ 518 00960 IF(ISTAT.GE.0) GO TO 1140 00970 DEL/ 522,528 00980 DEL/ 560,589 00990 END/ 01000*REW,7 01010*K,I7,P21,L14 01020*FTN 01030*EOF 01040*CLOSE 01050*K,I13,L14 01060*Z 01070*Z 01080__ ****************************************************** ???*0016 00840 INS/ 449 008501 00860C ****************************************************** ???*0016 00870C IF ACTFIL RECORD ALREADY CAME FROM TAPE 00880C HISTORY (SUFFIX > 50), CONTINUE TO READ 00890C AND DELETE BLOCKS OVER 50 - DO NOT SAVE 00900C TO TAPE 00910 IF ( IDLREC(K+8) .GE. $3531 ) GO TO 880 00920C ****************************************************** ???*0016 00930 DEL/ 509 00940 GO TO 1140 00950 DEL/ 518 00960 IF(ISTAT.GE.0) GO TO 1140 00970 DEL/ 522,528 00980 DEL/ 560,589 00990 END/ 01000(H SL J.NEWS CCS149 P(*JOB,,TWB.JOB NEWS INSTALL 08/23/84 00010*K,L14 00020*CTO, NEWS WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.NEWS , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.NEWS,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120NEWS DCK/ I,H 00130 END/ 00140*REW,7 00150*K,I7,P21,L14 00160*FTN 00170*EOF 00180*CLOSE 00190*K,I13,L14 00200*Z 00210*Z 00220__ DEL/ 522,528 00980 DEL/ 560,589 00990 END/ 01000(G } J.PGGEN CCS149 P(*JOB,,TWB.JOB PGGEN INSTALL 09/17/84 00010*K,L14 00020*CTO, PGGEN WEAVED AS OF 09/17/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.PGGEN , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.PGGEN,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120PGGEN DCK/ I,H 00020 END/ 00010*REW,7 00020*K,I7,P21,L14 00030*ASSEM 00040*REW,7,20 00050*K,I13,L2 00060*CSY,I20,P7 00070*COSY 00080PGGBLK DCK/ I,H 00040PGGEN0 DCK/ I,H 00010 DEL/ 2 00020 1 /B90 F CCS CCS 3.0 POST 3.0 PSR 12/28/2 SL-149 00030 DEL/ 93,94 00040 DEL/ 157 00050C***************************************************** ???*A??? 00060 IF(RADDR.EQ.$8010) GO TO 8010 00070C***************************************************** ???*A??? 00080PGGEN1 DCK/ I,H 00010 DEL/ 2 00020 1 /B91 F CCS CCS 3.0 PSR 03/23/81 SL-149 00030 DEL/ 36 00040CSPEC REVERSE DATES YYMMDD 00050 2 MSG5A(70),MSG5B(24),MSG5C(27),MSG5D(93),MSG6(83), 00060CSPEC END 00070 DEL/ 69 00080CPEC REVERSE DATES YYMMDD 00090 3NAME2 (CR) ',$D0A,' NOTE - DATE FIELDS MUST BE IN YEAR, MONTH, DA 00100 4Y ORDER, I.E. YYMMDD ',$D0A/ 00110CSPEC END 00120 DEL/ 116 00130CSPEC REVERSE DATES YYMMDD 00140 3 LNG5D/186/,LNG5A0/108/ 00150CSPEC END 00160 DEL/ 202 00170C***********************************************************A040*??? 00180 IF(AND(ISTAT,$300).NE.0) GO TO 1000 00190 IF(ISTAT.LT.0) GO TO 1010 00200C**********************************************************A040*??? 00210 DEL/ 210,212 00220C************** 3 LINES DELETED ***************************A040*??? 00230PGGEN3 DCK/ I,H 00010 DEL/ 2 00020 1 /B92 F CCS CCS 3.0 POST 3.0 PSR 12/28/2 SL-149 00030 DEL/ 33 00040C***************************************************** ???*A??? 00050 2 PRC060(3),PRC070(8),PRC080(8),PRC090(4),PRC100(37), 00060C***************************************************** ???*A??? 00070 DEL/ 51 00080C***************************************************** ???*A??? 00090 DATA PRC100 /'KF= ',35*$2020/ 00100C***************************************************** ???*A??? 00110 DEL/ 65 00120C***************************************************** ???A*??? 00130 2 LPC060/6/,LPC070/16/,LPC080/16/,LPC090/8/,LPC100/73/, 00140C***************************************************** ???A*??? 00150PGGN2E DCK/ I,H 00010 DEL/ 2 00020 1 /B93 F CCS CCS 3.0 SPECIAL 12/29/82 SL-149 00030 INS/ 34 00040 INTEGER IASLU(2) 00050C*********************************************************** ???*A079 00060 INTEGER RTTYPE 00070C*********************************************************** ???*A079 00080 INS/ 35 00090CSPEC REVERSE DATES YYMMDD 00100 INTEGER KSBIN,KSASC(2),F010(11),ICHGYR(19),ICHGMO(19) 00110 DATA F010/' INTEGER SAVE(3) '/ 00120 DATA ICHGYR/'CALL CCSMVA(WRKMST,K+XXXX,2,SAVE,1,2) '/ 00130 DATA ICHGMO/'CALL CCSMVA(WRKMST,K+XXXX,4,SAVE,3,4) '/ 00140 INTEGER USEDT(18),ISDATE 00150 DATA USEDT/'CALL CCSCST(SAVE,1,6,IVLXX,1,6,ICMP)'/ 001601 00170CSPEC END 00180 INS/ 37 00190C*********************************************************** ???*A079 00200 INTEGER F1047(10), F2047(19) 00210C*********************************************************** ???*A079 00220 DEL/ 57 00230 INTEGER J1000(3),J1100(3),J1200(2),J1300(2),J1400(4),J1500(5) 00240 DEL/ 69 00250 00260C*********************************************************** ???*A079 00270 DATA INCCS/'CALL QCST(A,WRKMST,K+XXXX,XXXX,WRKMST,K+XXXX,XXXX,ICMP 00280C*********************************************************** ???*A079 00290 DEL/ 73 00300C*********************************************************** ???*A079 00310 DATA IVCCS/'CALL QCST(A,WRKMST,K+XXXX,XXXX,IVLXX,1,XXXX,ICMP) '/ 00320C*********************************************************** ???*A079 00330 INS/ 82 00340C************************************************************** ???*A044 00350 INTEGER IRACMP(20) 00360 DATA IRACMP/'IF(ICMP.GE.0 .AND. JCMP.LE.0) GO TO 200 '/ 00370C************************************************************** ???*A044 00380 INS/ 85 00390C*********************************************************** ???*A079 00400 DATA F1047/' INTEGER A,N,T '/ 00410C*********************************************************** ???*A079 00420 DEL/ 101 00430C************************************************************** ???*AO45 00440 12720,',0, 9,0 ',$2F20/ 00450C************************************************************** ???*AO45 00460 INS/ 104 00470C*********************************************************** ???*A079 00480 DATA F2047/' DATA A,N,T',$2F20,'$41,$4E,$54',$2F20,' '/ 00490C*********************************************************** ???*A079 00500 DEL/ 128,129 00510C*********************************************************** ???*A079 00520 DATA F4000/' 115 DO 300 M = 1,9 '/ 00530 DATA F4100/' J = 1000*M-999'/ 00540C*********************************************************** ???*A079 00550 DEL/ 154 00560 DATA J1500/'*K,I08,P08'/ 00570 DEL/ 156 00580 DATA J1700/'*K,I08'/ 00590 INS/ 161 00600C GET SCRATCH LOGICAL UNIT FROM SYSDAT;LOCATION $B3 . 00610 ASSEM $C0B3,$6800,ISCRLU 00620C CONVERT TO ASCII & STORE IN THE TWO JCL ARRAYS. 00630 CALL BINASC (ISCRLU, IASLU) 00640 J1500(3) = IASLU(2) 00650 J1500(5) = IASLU(2) 00660 J1700(3) = IASLU(2) 00670 INS/ 180 00680CSPEC REVERSE DATE YYMMDD 00690 L = L + 80 00700 CALL CCSMVA(F010,1,22,WRPGWK,L,22) 00710CSPEC END 00720 INS/ 181 00730C*********************************************************** ???*A079 00740 CALL CCSMVA(F1047,1,20,WRPGWK,L,20) 00750 L = L + 80 00760C*********************************************************** ???*A079 00770 INS/ 221 00780C*********************************************************** ???*A079 00790 CALL CCSMVA(F2047,1,38,WRPGWK,L,38) 00800 L = L + 80 00810C*********************************************************** ???*A079 00820 INS/ 250 00830C ???*A085 00840 IF(J.LE.0) GO TO 3070 00850C ???*A085 00860 INS/ 318 00870C*********************************************************** ???*A079 00880C 00890C--- SET DATA TYPE INTO CALLS TO STRING-COMPARE SUBROUTINE. 00900 CALL CCSGET(TBLREC,15,RTTYPE) 00910 CALL CCSPUT(RTTYPE,11,INCCS) 00920 CALL CCSPUT(RTTYPE,11,IVCCS) 00930C***************************************************** ???*A079 009402 00950CSPEC REVERSE DATE YYMMDD 00960C CHECK IF A DATE FIELD BEING USED 00970 ISDATE = 0 00980 IF(AND(TBLREC(8),$00FF).EQ.$0059) ISDATE = 1 00990 IF(ISDATE.EQ.0) GO TO 3170 01000 CALL ASCBIN(TBLREC(4),K4LEN) 01010 CALL ASCBIN(TBLREC(5),K5LEN) 01020 KBIN = K4LEN * 100 + K5LEN - 1 01030 CALL BINASC(KBIN,KASC) 01040C NOW REVERSE THE DATE IN THE SAVE AREA FOR THE COMPARE 01050 3161 KSBIN = KBIN + 4 01060 CALL BINASC(KSBIN,KSASC) 01070 CALL CCSMVA(KSASC,1,4,ICHGYR,22,4) 01080 CALL CCSMVA(ICHGYR,1,38,WRPGWK,7,38) 01090 ASSIGN 3162 TO IRTN 01100 GO TO 3000 01110 3162 KSBIN = KBIN 01120 CALL BINASC(KSBIN,KSASC) 01130 CALL CCSMVA(KSASC,1,4,ICHGMO,22,4) 01140 CALL CCSMVA(ICHGMO,1,38,WRPGWK,7,38) 01150 ASSIGN 3170 TO IRTN 01160 GO TO 3000 01170 3170 CONTINUE 01180CSPEC END 01190 INS/ 324 01200CSPEC REVERSE DATES YYMMDD 01210C CHECK IF DATE FIELD 01220 IF(ISDATE.EQ.0) GO TO 3190 01230 CALL BINASC(K,KASC) 01240 CALL CCSMVA(KASC,3,2,USEDT,25,2) 01250 CALL CCSMVA(USEDT,1,36,WRPGWK,7,36) 01260 J = 1 01270 ASSIGN 3300 TO IRTN 01280 GO TO 3000 01290 3190 CONTINUE 01300CSPEC END 01310 DEL/ 368,378 01320C***************** 11 LINES DELETED HERE ************* ???*A044 01330 INS/ 380 01340CSPEC REVERSE DATES YYMMDD 01350C CHECK IF DATE FIELD 01360 IF(ISDATE.EQ.0) GO TO 3335 01370 CALL CCSMVA(KASC,3,2,USEDT,25,2) 01380C CHANGE THE RESULT FIELD TO A 'J'CMP FOR THIS COMPARE ONLY, IT IS 01390C CHANGED BACK RIGHT AFTER THE LINE IS WRITTEN 01400 CALL CCSPUT($4A,32,USEDT) 01410 CALL CCSMVA(USEDT,1,36,WRPGWK,7,36) 01420 ASSIGN 3332 TO IRTN 01430 GO TO 3000 01440C CHANGE IT BACK TO AN 'I'CMP 01450 3332 CALL CCSPUT($49,32,USEDT) 01460 CALL CCSMVA(IRACMP,1,40,WRPGWK,7,40) 01470 ASSIGN 3550 TO IRTN 01480 GO TO 3000 01490 3335 CONTINUE 01500CSPEC END 01510 INS/ 382 01520C************************************************************** ???*A044 01530C CHANGE THE RESULT FIELD TO A 'J'CMP FOR THIS COMPARE ONLY IT IS 01540C CHANGED BACK RIGHT AFTER THE LINE IS WRITTEN 01550 CALL CCSPUT($4A,45,IVCCS) 01560C************************************************************** ???*A044 01570 DEL/ 386,393 01580C************************************************************** ???*A044 01590C CHANGE IT BACK TO 'I'CMP 01600 3340 CALL CCSPUT($49,45,IVCCS) 01610 CALL CCSMVA(IRACMP,1,40,WRPGWK,7,40) 01620C************************************************************** ???*A044 01630 INS/ 405 01640CSPEC REVERSE DATES YYMMDD 01650C CHECK IF ITS A DATE FIELD 01660 IF(ISDATE.EQ.0) GO TO 3375 01670 CALL CCSMVA(KASC,3,2,USEDT,25,2) 01680 CALL CCSMVA(USEDT,1,36,WRPGWK,7,36) 01690 ASSIGN 3380 TO IRTN 01700 GO TO 3000 01710 3375 CONTINUE 01720CPEC END 01730 DEL/ 569,573 01740C POST 3.1 PSR 01750C ***** 5 COMMENT LINES DELETED HERE ***** 01760C END 01770 DEL/ 609 01780 CALL CCSMVA(J1500,1,10,WRPGWK,L,10) 01790 END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*REW,7,20 00050*K,I13,L2 00060*CSY,I20,P7 00070*COSY 00080PGGN2P DCK/ I,H 00100PGSEDT DCK/ I,H 00120 END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*REW,7,20 00050*K,I13,L2 00060*CSY,I20,P7 00070*COSY 00080PGSJL DCK/ I,H 00130PGSJR DCK/ I,H 00140PGSLST DCK/ I,H 00150 END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*EOF 00050*CLOSE 00060*K,I13,L14 00070*Z 00080*Z 00090__13,L2 00060*CSY,I20,P7 00070*COSY 00080PGGN2P DCK/ I,H 00100PGSEDT DCK/ I,H 00120 END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*REW,7,20 00050*K,I13,L2 00060*CSY,I20,P7 00070*COSY 00080PGSJL DCK/ I,H 00130PGSJR DCK/ I,H 00140PGSLST DCK/ I,H 00150 END/ 00010*REW,7 00020*K,I7,P21,L14 00030*FTN 00040*EOF 00050*CLOSE 00060*K,I13,L14 00070(Q T "J.PRTSCNCCS149 P(*JOB,,TWB.JOB PRTSCN INSTALL 08/23/84 00010*K,L14 00020*CTO, PRTSCN WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.PRTSCN , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.PRTSCN,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120PRTSCN DCK/ I,H 00130 DEL/ 2 00140 1 /C10 F CCS CCS 3.0 PSR'D SL-149 00150 DEL/ 112 00160C ****************************************************** ???*A021 00170 105 ILN = IOBUF(41) 00180 CALL CCSBLK (ACCTNO, 16) 00190 CALL CCSMVA (IOBUF, 1, ILN, ACCTNO, 1, 16) 00200C ****************************************************** ???*A021 00210PRNTIT DCK/ I,H 00220 END/ 00230*REW,7 00240*K,I7,P21,L14 00250*FTN 00260*EOF 00270*CLOSE 00280*K,I13,L14 00290*Z 00300*Z 00310__N,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.PRTSCN,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120PRTSCN DCK/ I,H 00130 DEL/ 2 00140 1 /C10 F CCS CCS 3.0 PSR'D SL-149 00150 DEL/ 112 00160C ****************************************************** ???*A021 00170 105 ILN = IOBUF(41) 00180 CALL CCSBLK (ACCTNO, 16) 00190 CALL CCSMVA (IOBUF, 1, ILN, ACCTNO, 1, 16) 00200C ****************************************************** ???*A021 00210PRNTIT DCK/ I,H 00220 END/ 00230*REW,7 00240*K,I7,P21,L14 00250( F  I.COLECTCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING COLECT FROM B.COLECT, CCS149 FILE 00030*OPEN,FN=B.COLECT,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,COLECT,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM COLECT HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ CALL CCSMVA (IOBUF, 1, ILN, ACCTNO, 1, 16) 00200C ****************************************************** ???*A021 00210PRNTIT DCK/ I,H 00220 END/ 00230*REW,7 00240*K,I7,P21,L14 00250(j T 8-J.QLOAD CCS149 P(*JOB,,TWB.JOB QLOAD INSTALL 08/23/84 00010*K,L14 00020*CTO, QLOAD WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.QLOAD , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.QLOAD,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120QLOAD DCK/ I,H 00130 DEL/ 2 00140 1 /C11 F CCS CCS 3.0 .LA - PSRD SL-149 00150 DEL/ 32 00160 INTEGER DDAT(4) 00170 DATA DDAT/'DLYASSN '/ 00180 DATA DDATA/'LADLYASN',8*$2020,0,20,0/, ITC/0/ 00190 INS/ 37 00200C********************************************************** ???*A001 00210 INTEGER QTMSB(7) 00220 DATA QTMSB/7*0/ 00230C********************************************************** ???*A001 00240 INS/ 39 00250 CALL CCSCST(DDATA,1,2,IDUSER,1,8,ICM) 00260 IF(ICM.NE.0) CALL CCSMVA(DDAT,1,8,DDATA,1,8) 00270 DEL/ 211 00280C********************************************************** ???*A001 00290C........USE MSB MODULO 30000 TO IMPLEMENT DOUBLE PRCISION ARITHMETIC 00300 IF (QT(AGE1) .LT. 30000) GO TO 470 00310 QT(AGE1) = 0 00320 QTMSB(AGE1) = QTMSB(AGE1) + 1 00330 470 QT(7) = QT(7) + 1 00340 IF (QT(7) .LT. 30000) GO TO 474 00350 QT(7) = 0 00360 QTMSB(7) = QTMSB(7) + 1 00370 474 CONTINUE 00380C********************************************************** ???*A001 00390 INS/ 226 00400C********************************************************** ???*A001 00410 IF (QTMSB(II) .EQ. 0) GO TO 515 00420C.........'QTMSB' = NO. OF MULTIPLES OF 30000. 00430C......... (ADJUST 10**4 DIGIT ONLY) 00440 QPRT(IJ) = $2030 + QTMSB(II)*3 + AND(QPRT(IJ),$F) 00450 515 CONTINUE 00460C********************************************************** ???*A001 00470 END/ 00480*REW,7 00490*K,I7,P21,L14 00500*FTN 00510*EOF 00520*CLOSE 00530*K,I13,L14 00540*Z 00550*Z 00560__ QT(AGE1) = 0 00320 QTMSB(AGE1) = QTMSB(AGE1) + 1 00330 470 QT(7) = QT(7) + 1 00340 IF (QT(7) .LT. 30000) GO TO 474 00350 QT(7) = 0 00360 QTMSB(7) = QTMSB(7) + 1 00370 474 CONTINUE 00380C********************************************************** ???*A001 00390 INS/ 226 00400C********************************************************** ???*A001 00410 IF (QTMSB(II) .EQ. 0) GO TO 515 00420C.........'QTMSB' = NO. OF MULTIPLES OF 30000. 00430C......... (ADJUST 10**4 DIGIT ONLY) 00440 QPRT(IJ) = $2030 + QTMSB(II)*3 + AND(QPRT(IJ),$F) 00450 515 CONTINUE 00460C********************************************************** ???*A001 00470 END/ 00480*REW,7 00490*K,I7,P21,L14 00500(e Vq 3+J.SUMACLCCS149 P(*JOB,,TWB.JOB SUMACL INSTALL 08/23/84 00010*K,L14 00020*CTO, SUMACL WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.SUMACL , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.SUMACL,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120SUMACL DCK/ I,H 00130 DEL/ 2 00140 1 /C20 F CCS CCS 3.0 .LA - PSRD SL-149 00150 INS/ 28 00160C ****************************************************** ???*A011 00170C 00180C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00190 INTEGER FDEL 00200 EXTERNAL FMRDEL 00210C ******************************************************* ???*A011 00220 DEL/ 34 00230 INTEGER IDAT(4) 00240 DATA IDAT /'DELQMST '/ 00250 DATA IDATA/'LADLQMST',8*$2020,1,7,0/ 00260 INS/ 43 00270 CALL CCSCST(IDATA,1,2,ID,1,8,ICM) 00280 IF(ICM.NE.0) CALL CCSMVA(IDAT,1,8,IDATA,1,8) 00290 INS/ 44 00300C ****************************************************** ???*A011 00310C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00320 ASSEM $C000,FMRDEL,$6800,FDEL 00330C ****************************************************** ???*A011 00340C 00350 INS/ 80 00360C ****************************************************** ???*A011 00370C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00380 CALL CCSCST(RECBUF,IW,2,FDEL,1,2,ICOMP) 00390 IF(ICOMP.EQ.0) GO TO 250 00400C ****************************************************** ???*A011 00410SUMHD DCK/ I,H 00420 END/ 00430*REW,7 00440*K,I7,P21,L14 00450*FTN 00460*EOF 00470*CLOSE 00480*K,I13,L14 00490*Z 00500*Z 00510__ INS/ 43 00270 CALL CCSCST(IDATA,1,2,ID,1,8,ICM) 00280 IF(ICM.NE.0) CALL CCSMVA(IDAT,1,8,IDATA,1,8) 00290 INS/ 44 00300C ****************************************************** ???*A011 00310C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00320 ASSEM $C000,FMRDEL,$6800,FDEL 00330C ****************************************************** ???*A011 00340C 00350 INS/ 80 00360C ****************************************************** ???*A011 00370C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00380 CALL CCSCST(RECBUF,IW,2,FDEL,1,2,ICOMP) 00390 IF(ICOMP.EQ.0) GO TO 250 00400C ****************************************************** ???*A011 00410SUMHD DCK/ I,H 00420 END/ 00430*REW,7 00440*K,I7,P21,L14 00450*FTN 00460*EOF 00470*CLOSE 00480*K,I13,L14 00490*Z 00500(/ $) J.TRENDFCCS149 P(*JOB,,TWB.JOB TRENDF INSTALL 08/23/84 00010*K,L14 00020*CTO, TRENDF WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.TRENDF , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.TRENDF,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120TRENDF DCK/ I,H 00130 DEL/ 2 00140 1 /C25 F CCS CCS 3.0 .LA - PSRD RWE 10/82 SL-XXX 00150 INS/ 33 001601 00170C**** TRENDF - MODIFIED TO USE RECORD BLOCKING. 00180C DON'T DO DELETE FROM ACCAGE. JUST FLAG RECORD SO IT 00190C CAN BE REMOVED BY DSORT. 00200C FIXED TO CLEAR AND CREATE RSWFIL IF BUILDING ACCAGE. 00210C AND ALSO WHEN OUTPUTTING TO RSWFIL DURING UPDATE OF 00220C ACCAGE TO MOVE CURRENT TO PREVIOUS ON RSWFIL RECORD. 00230 DEL/ 39,40 00240 INTEGER DELREQ(24),DELQRC(15004),DDATA(15),DELKEY(8) 00250 INTEGER DT(3),RDT(7),LRDT(4),READA,READD,EOFA,EOFD 00260 DEL/ 44 00270 INTEGER RSWB(2),RSW9(2,3),ACCRC1(1),RSWREC(620),RSWF 00280 EQUIVALENCE (DELQRC(1005),ACCRC1(1)) 00290 DEL/ 48 00300 DATA DELREQ/24*0/,DELQRC/15004*$2020/,DELKEY/8*$2020/ 00310 DATA RSWB/'RSW '/,RSW9/'998 999 997 '/,IFIRST/0/,RSWF/0/ 00320 DATA IOF/0/,IEND/0/,NUMPUT/0/,NUMHI/15/,LNDLQB/15000/ 00330 DEL/ 51,52 00340 DATA DT/3*$2020/,RDT/7*$2020/,LRDT/4*$2020/ 00350 DEL/ 83,85 00360C************************************************************** ???*A046 00370 DATA ACDATA/'LAACCAGE',8*$2020,1,1,-1/ 00380 DATA DDATA /'LADLQMST',8*$2020,1,1,0/ 00390 DATA RDATA /'LARSWFIL',8*$2020,0,1,0/ 00400 INTEGER DDAT(4) 00410 DATA DDAT/'DELQMST '/ 00420 INS/ 86 00430C************************************************************** ???*A043 00440 INTEGER DTMSG(32),DTINP(2) 00450 DATA DTMSG/$0A0D,'THE DATE ENTERED IS . IS THIS THE CORRECT 00460 1DATE? Y OR N',$0A0D/ 00470C************************************************************** ???*A043 00480 DEL/ 93,95 00490 CALL CCSCST(RDATA,1,2,IDUSER,1,8,ICM) 00500 IF(ICM.EQ.0) GO TO 5 00510 CALL CCSMVA(RDATA,3,6,RDATA,1,8) 00520 CALL CCSMVA(ACDATA,3,6,ACDATA,1,8) 00530 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00540 5 CONTINUE 00550 DEL/ 99 00560 INS/ 131 005701 00580C*** BLANK OUT RSW FLAG ON HEADER IN CASE NO INACTIVE RECORDS FOUND ! 00590 CALL CCSMVA(ACCREC,1,0,ACCREC,50,3) 00600 DEL/ 147,148 00610 160 CALL CCSMVA(RDT,1,0,RDT,1,14) 00620 CALL WTREAD(LUNIT,-1,MSG2,122,-1,RDT,12,ITC) 00630 INS/ 150 00640C************************************************************** ???*A043 00650C DATE CHECKING 00660 IF(RDT(1).EQ.$2020) CALL CCSMVA(DT,1,6,DTMSG,23,6) 00670 IF(RDT(1).NE.$2020) CALL CCSMVA(RDT,1,6,DTMSG,23,6) 00680C ASK IF IT IS THE CORRECT DATE 00690 165 DTINP(1) = $2020 00700 CALL WTREAD(LUNIT,-1,DTMSG,64,-1,DTINP,2,ITC) 00710C CHECK FOR AN 'N' AND IF SO GO REDO PROMPT FOR DATE 00720 IF(DTINP(1).EQ.$4E4F.OR.DTINP(1).EQ.$4E20) GO TO 160 00730C CHECK FOR 'Y' AND IF NOT GO REDO PROMPT FOR Y OR N 00740 IF(DTINP(1).EQ.YES(1).OR.DTINP(1).EQ.$5920) GO TO 167 00750C DATE WAS VERIFIED-CONTINUE 00760C************************************************************** ???*A043 00770 167 CONTINUE 00780 DEL/ 154 00790 IF(RDT(7).NE.6) GO TO 160 00800 DEL/ 189,190 00810 220 CONTINUE 00820 CALL CLOSFL(ACCREQ,ISTAT) 00830 NUMACC = (LNDLQB-1005)/42 00840 NUMDLQ = LNDLQB/1000 00850 ACDATA(13) = 0 00860 ACDATA(14) = NUMACC 00870 IF (INIT.NE.0) GO TO 225 00880 DDATA(13) = 0 00890 DDATA(14) = NUMDLQ 00900 ACDATA(13) = 1 00910 ACDATA(14) = 1 00920 CALL CLEAR(RSWREQ,RDATA,ISTAT) 00930 IF(ISTAT.GE.0) GO TO 225 00940 CALL FILERR(RDATA,01,ISTAT,LUNIT) 00950 GO TO 950 00960 225 CONTINUE 00970 DO 226 I = 1,24 00980 ACCREQ(I) = 0 00990 226 RSWREQ(I) = 0 01000 CALL OPENFL(ACCREQ,ACDATA,ISTAT) 01010 IF (ISTAT.GE.0) GO TO 228 01020 CALL FILERR(ACDATA,3,ISTAT,LUNIT) 01030 GO TO 950 01040 228 CONTINUE 01050 DEL/ 206,223 01060 240 CONTINUE 01070 CALL GETS(ACCREQ,ACCRC1,ACCKEY,ISTAT) 01080 IF(AND(ISTAT,$100).EQ.$100) IOF = 1 01090 IF(IOF.EQ.1) GO TO 250 01100 IF(ISTAT.GE.0) GO TO 250 01110 CALL FILERR(ACDATA,14,ISTAT,LUNIT) 01120 GO TO 950 01130 250 CONTINUE 01140 NUMRED = ACCREQ(15) 01150 IF (NUMRED.LE.0) GO TO 400 01160 DO 400 IL = 1,NUMRED 01170 IPT = IL*41-40 01180 IF (IFIRST.EQ.0) GO TO 395 01190 IF (ACCRC1(IPT).EQ.FDEL) GO TO 400 01200 CALL CCSMVA(ACCRC1(IPT),1,16,DELKEY,1,16) 01210 CALL READR(DELREQ,DELQRC,DELKEY,ISTAT) 01220 IF(AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 390 01230 DEL/ 228,229 01240 300 CONTINUE 01250 CALL CCSGET(DELQRC,306,MSTC) 01260 DO 305 I1 = 1,4 01270 CALL CCSGET(RSWB,I1,ICH) 01280 IF (ICH.NE.MSTC) GO TO 305 01290 GO TO 310 01300 305 CONTINUE 01310 310 IF (I1.LT.4) GO TO 315 01320 IF (UPDAT1.EQ.0.AND.UPDAT2.EQ.0) GO TO 340 01330 315 CONTINUE 01340 DEL/ 233 01350 CALL CCSMVA(ACCRC1(IPT),APOS(I),ALEN(I), 01360 + ACCRC1(IPT),APOS(I+4),ALEN(I)) 01370 DEL/ 238 01380 CALL CCSMVA(DELQRC,DPOS(I),DLEN(I), 01390 + ACCRC1(IPT),DPOS(I+6),DLEN(I)) 01400 DEL/ 242,281 01410 IF (I1.GE.4) GO TO 380 01420 CALL CCSCST(ACCRC1(IPT),35,3,RSWB,1,3,ICM) 01430 IF (ICM.EQ.0) GO TO 390 01440 NUMPUT = NUMPUT+1 01450 RSWF = 1 01460 IP1 = NUMPUT*41-40 01470 CALL CCSMVA(ACCRC1(IPT),1,82,RSWREC(IP1),1,82) 01480 CALL CCSMVA(RSW9(1,I1),1,3,RSWREC(IP1),35,3) 01490 CALL CCSMVA(RSWB,1,3,ACCRC1(IPT),35,3) 01500 IF (NUMPUT.LT.NUMHI) GO TO 375 01510 370 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 01520 IF(ISTAT.GE.0) GO TO 375 01530 CALL FILERR(RDATA,11,ISTAT,LUNIT) 01540 GO TO 950 01550 375 CONTINUE 01560 NUMPUT = 0 01570 IF (IEND.EQ.1) GO TO 420 01580 GO TO 400 01590 380 CONTINUE 01600 ASSIGN 385 TO IRTN 01610 GO TO 700 01620 385 CALL CCSMVA(DAYS,1,3,ACCRC1(IPT),35,3) 01630 GO TO 400 01640 390 CONTINUE 01650 CALL CCSMVA(RSWB,1,3,ACCRC1(IPT),35,3) 01660 RSWF = 1 01670 395 IFIRST = 1 01680 400 CONTINUE 01690 CALL UPDREC(ACCREQ,ACCRC1,ISTAT) 01700 IF (ISTAT.GE.0) GO TO 410 01710 CALL FILERR(ACDATA,15,ISTAT,LUNIT) 01720 GO TO 950 01730 410 CONTINUE 01740 IF (IOF.NE.1) GO TO 240 01750 IEND = 1 01760 IF (NUMPUT.GT.0) GO TO 370 01770 420 CONTINUE 01780 IF (RSWF.NE.1) GO TO 950 017901 01800C*** UPDATE HEADER RECORD TO REFLECT INACTIVE RECORDS ENCOUNTERED. 018101 01820 ACCKEY(1) = 0 01830 ACCKEY(2) = 1 018401 01850 CALL READR(ACCREQ,ACCRC1,ACCKEY,ISTAT) 01860 IF (ISTAT.GE.0) GO TO 430 01870 CALL FILERR(ACDATA,13,ISTAT,LUNIT) 01880 GO TO 950 01890 430 CONTINUE 01900 CALL CCSMVA(RSWB,1,3,ACCRC1,50,3) 01910 CALL UPDREC(ACCREQ,ACCRC1,ISTAT) 01920 IF (ISTAT.GE.0) GO TO 950 01930 CALL FILERR(ACDATA,15,ISTAT,LUNIT) 01940 GO TO 950 01950 DEL/ 287,310 01960 500 CONTINUE 01970 CALL GETS(DELREQ,DELQRC,DELKEY,ISTAT) 01980 IF(AND(ISTAT,$100).EQ.$100) IOF = 1 01990 IF (IOF.EQ.1) GO TO 530 02000 IF (ISTAT.GE.0) GO TO 530 02010 CALL FILERR(DDATA,14,ISTAT,LUNIT) 02020 GO TO 950 02030 530 CONTINUE 02040 NUMRED = DELREQ(15) 02050 IF (NUMRED.EQ.0) GO TO 590 02060 DO 590 IL = 1,NUMRED 02070 IPT = IL*1000-999 02080 IF(DELQRC(IPT).EQ.FDEL) GO TO 590 02090 CALL CCSBLK(ACCREC,82) 02100 DEL/ 315,319 02110 CALL CCSMVA(DELQRC(IPT),DPOS(K),DLEN(K), 02120 + ACCREC,DPOS(K+6),DLEN(K)) 02130 540 CONTINUE 02140 CALL CCSMVA(DELQRC(IPT),875,6,DELQDT,1,6) 02150 CALL CCSMVA(DELQRC(IPT),1,16,ACCREC,1,16) 021601 02170 CALL CCSGET(DELQRC(IPT),306,MSTC) 02180 DO 545 I1 = 1,4 02190 CALL CCSGET(RSWB,I1,ICH) 02200 IF (ICH.NE.MSTC) GO TO 545 02210 GO TO 547 02220 545 CONTINUE 02230 547 IF (I1.LT.4) GO TO 570 02240 DEL/ 334,356 02250 570 CONTINUE 02260 NUMPUT = NUMPUT+1 02270 IP1 = NUMPUT*41-40 02280 CALL CCSMVA(RSW9(1,I1),1,3,ACCREC,35,3) 02290 CALL CCSMVA(ACCREC,1,82,RSWREC(IP1),1,82) 02300 IF (NUMPUT.LT.NUMHI) GO TO 590 02310 575 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 02320 IF (ISTAT.GE.0) GO TO 580 02330 CALL FILERR(RDATA,11,ISTAT,LUNIT) 02340 GO TO 950 02350 580 CONTINUE 02360 NUMPUT = 0 02370 IF (IEND.EQ.1) GO TO 600 02380 590 CONTINUE 02390 IF (IOF.NE.1) GO TO 500 02400 IEND = 1 02410 IF (NUMPUT.GT.0) GO TO 575 02420 600 CONTINUE 02430 GO TO 950 02440 END/ 02450*REW,7 02460*K,I7,P21,L14 02470*FTN 02480*EOF 02490*CLOSE 02500*K,I13,L14 02510*Z 02520*Z 02530__ CALL CCSMVA(RSW9(1,I1),1,3,ACCREC,35,3) 02290 CALL CCSMVA(ACCREC,1,82,RSWREC(IP1),1,82) 02300 IF (NUMPUT.LT.NUMHI) GO TO 590 02310 575 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 02320 IF (ISTAT.GE.0) GO TO 580 02330 CALL FILERR(RDATA,11,ISTAT,LUNIT) 02340 GO TO 950 02350 580 CONTINUE 02360 NUMPUT = 0 02370 IF (IEND.EQ.1) GO TO 600 02380 590 CONTINUE 02390 IF (IOF.NE.1) GO TO 500 02400 IEND = 1 02410 IF (NUMPUT.GT.0) GO TO 575 02420 600 CONTINUE 02430 GO TO 950 02440 END/ 02450*REW,7 02460*K,I7,P21,L14 02470*FTN 02480*EOF 02490*CLOSE 02500( & UJ.TRNPLYCCS149 P(*JOB,,TWB.JOB TRNPLY INSTALL 08/23/84 00010*K,L14 00020*CTO, TRNPLY WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.TRNPLY , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.TRNPLY,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120TRNPLY DCK/ I,H 00130 DEL/ 2 00140 1 /C28 F CCS CCS 3.0 .LA - LKL07 SL-149 00150 DEL/ 7,12 00160 INS/ 103 00170C***************************************************************???*0022 00180C 00190C SET UP UTILITY FILE DATA TO BE USED FOR RETRIEVING COLLECTORS 00200C LAST NAME AND PUTTING IT IN ACTIVITY STRING INSTEAD OF COLLECTOR 00210C LOG ON ID 002201 00230 INTEGER UDATA(15),UTIREQ(24),UTIREC(40),HST(2),ID(4) 00240 DATA UDATA/'LAUTIFIL',8*$2020,1,1,0/ 00250 DATA UTIREQ/24*0/, HST/'HOST'/,IFG/0/ 00260C***************************************************************???*0022 00270 DEL/ 107,109 00280 INTEGER DDAT(4),CDAT(4),SDAT(4),IN1(4) 00290 DATA DDAT/'DELQMST '/,CDAT/'COSIGNER'/,SDAT/'SCRNFILE'/ 00300 DATA DDATA/'LADLQMST',8*$2020,1,1,1/ 00310 DATA CDATA/'LACOSIGN',8*$2020,1,1,1/ 00320 DATA TDATA/'LATRANFL',8*$2020,0,1,0/ 00330 DEL/ 113,114 00340 DATA SDATA/'LASCNFIL',8*$2020,1,1,0/ 00350 DATA ADATA/'LAADDACT',8*$2020,0,1,0/ 00360 DEL/ 161 00370 1 (TRNBUF(20),RESULT), 00380 INS/ 164 003901 00400 CALL PGMIN(ID,ISTAT,ISTAT,ISTAT) 00410 CALL CCSCST(UDATA,1,2,ID,1,8,ISTAT) 00420 IF(ISTAT.EQ.0) GO TO 5 00430 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00440 CALL CCSMVA(TDATA,3,6,TDATA,1,8) 00450 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00460 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00470 CALL CCSMVA(CDAT ,1,8,CDATA,1,8) 00480 CALL CCSMVA(SDAT ,1,8,SDATA,1,8) 00490 5 CONTINUE 00500 WRITE(5,6)ID 00510 6 FORMAT(/,'USERID =',4A2,' TYPE OK TO CONTINUE, OR EX TO EXIT',/) 00520 CALL WTREAD(5,-1,0,0,-1,IN1,6,ITC) 00530 IF(ITC.NE.2) GO TO 5 00540 IF(IN1.EQ.2HEX) GO TO 991 00550 IF(IN1.NE.2HOK) GO TO 5 00560 DEL/ 187 00570C***************************************************************???*0022 00580 IF(ISTAT.GE.0) GO TO 45 00590C***************************************************************???*0022 00600 INS/ 189 00610C***************************************************************???*0022 006201 00630 45 CALL OPENFL(UTIREQ,UDATA,ISTAT) 00640 IF(ISTAT.GE.0) GO TO 50 00650 CALL FILERR(UDATA,3,ISTAT,LU) 00660 GO TO 991 00670C***************************************************************???*0022 00680 DEL/ 224 00690 IF(AND(ISTAT,$100).EQ.$100) GO TO 99 00700 INS/ 226 00710 CALL CCSMVA(TRNBUF,1,16,ACCT,1,16) 00720 DEL/ 235 00730 DEL/ 240,242 00740C ****************************************************** ???*A020 00750 105 COUNT1 = COUNT1 + 1 00760 CALL READR (DEQREQ, SDEF, ACCT, ISTAT) 00770 IF(AND(ISTAT,$100).EQ.$100.OR.AND(ISTAT,WRONKY).EQ.WRONKY)GOTO 996 00780 IF(ISTAT.LT.0) GOTO 990 00790C INCREMENT COUNT OF ACTIVITIES PROCESSED 00800C ****************************************************** ???*A020 00810 DEL/ 247 00820C***************************************************************???*0022 00830C READ UTIFIL AND MOVE IN FIRST 4 CHARACTERS OF LAST NAME 00840C INSTEAD OF COLLECTOR ID 008501 00860 CALL CCSMVA(TRNBUF,17,4,UTIREC,1,4) 00870 CALL READR(UTIREQ,UTIREC,UTIREC,ISTAT) 00880 IF(ISTAT.LT.0.OR.AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 993 00890C RECORD RETRIEVED-MOVE IN THE NAME 00900 107 CALL CCSMVA(UTIREC,5,4,STRING,13,4) 00910C***************************************************************???*0022 00920 DEL/ 278 00930 205 CONTINUE 00940 INS/ 316 00950 COUNT2 = COUNT2 + 1 00960 INS/ 322 00970 COUNT2 = COUNT2 + 1 00980 DEL/ 339,340 00990 450 COUNT2 = COUNT2 + 1 01000 CALL READR(DEQREQ,SDEF,ACCT,ISTAT) 01010 IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,$100).EQ.$100)GOTO 996 01020 IF(ISTAT.LT.0) GO TO 990 01030 DEL/ 390,394 01040 GO TO 991 01050C ****************************************************** ???*0022 01060 996 COUNTB = COUNTB+1 01070 IF(IFG.EQ.0)WRITE(12,551) 01080 551 FORMAT( 1H1,/,20X,'TRANSACTION REPLAY -- REPORT',/, 01090 + 39X,'NEW DATA OR',/,5X,'ACCOUNT #',7X, 01100 + 'TYPE UPCD AC RC LT COMMENT') 01110 IFG = 1 01120 IF(KEY.EQ.2H01) GO TO 997 01130 WRITE(12,555)(TRNBUF(L),L=1,8),KEY,UPDCOD,(TRNBUF(M),M=17,31) 01140 555 FORMAT(2X,8A2,4X,A2,6X,A2,5X,15A2,4X,' NOT UPDATED***') 01150 COUNT2 = COUNT2 - 1 01160 GO TO 100 01170 997 WRITE(12,552)(TRNBUF(L),L=1,8),KEY,(TRNBUF(M),M=19,21), 01180 + (TRNBUF(N),N=22,50) 01190 552 FORMAT(2X,8A2,4X,A2,11X,3(2X,A2),3X,28A2,4X,' NOT UPDATED***') 01200 COUNT1 = COUNT1 - 1 01210 GO TO 100 01220C ****************************************************** ???*0022 01230 DEL/ 402 01240 557 FORMAT(' ...PROGRAM ABORTED. - RUN NOT COMPLETE') 01250 DEL/ 406 01260 GOTO 991 01270 DEL/ 409 01280 GOTO 991 01290C***************************************************************???*0022 01300C FILE ERROR ON READ OF UTIFIL 01310 993 WRITE(5,559) TRNBUF(9),TRNBUF(10) 01320 559 FORMAT(' COID : ',2A2,' NOT IN UTIFIL - USING HOST ID ') 01330 CALL CCSMVA(HST,1,4,UTIREC,5,4) 01340 GO TO 107 01350C***************************************************************???*0022 01360 INS/ 414 01370C***************************************************************???*0022 01380 CALL CLOSFL(UTIREQ,ISTAT) 01390C***************************************************************???*0022 01400 DEL/ 417 01410 1 ',I4,/,'TOTAL OTHER RECORDS ',I4,/, 01420R9BASE DCK/ I,H 01430R9FLDL DCK/ I,H 01440 END/ 01450*REW,7 01460*K,I7,P21,L14 01470*FTN 01480*EOF 01490*CLOSE 01500*K,I13,L14 01510*Z 01520*Z 01530__ GOTO 991 01290C***************************************************************???*0022 01300C FILE ERROR ON READ OF UTIFIL 01310 993 WRITE(5,559) TRNBUF(9),TRNBUF(10) 01320 559 FORMAT(' COID : ',2A2,' NOT IN UTIFIL - USING HOST ID ') 01330 CALL CCSMVA(HST,1,4,UTIREC,5,4) 01340 GO TO 107 01350C***************************************************************???*0022 01360 INS/ 414 01370C***************************************************************???*0022 01380 CALL CLOSFL(UTIREQ,ISTAT) 01390C***************************************************************???*0022 01400 DEL/ 417 01410 1 ',I4,/,'TOTAL OTHER RECORDS ',I4,/, 01420R9BASE DCK/ I,H 01430R9FLDL DCK/ I,H 01440 END/ 01450*REW,7 01460*K,I7,P21,L14 01470*FTN 01480*EOF 01490*CLOSE 01500<P o!kB.WRTOFECCS149 x032883< P1WRTOFE C54 F CCS CCS 3.0 PSR(08-22-84) SL-149@P@P,@P,@P,&@P,("  *@P,B<:,@P, @P,@P-2kxX^Y @P- pq@P-s!.@P-@P @Ps@P@P>99NO@PA000000000000@PM000000000000000000000000@P000000@PYWRS @P\000000000000@PG0000000010@PoYES @P'@Pq0000@P'LADLQMST  @P[@P,@P'LAWOEF  @P,DELQMST @P+w ANSWER (1 OR 2) @P+ ENTER AS-OF-DATE (MMDDYY) @P+ ENTER NUMBER OF DAYS DELINQUENT (NNN) @P+ ENTER WRITE-OFFS SINCE DATE (MMDDYY)@P+ ANSWER (1,2,OR 3) @P+ ARE SUBTOTALS DESIRED (YES/NO)@P+ RECORD COUNT--R RECORDS 000000000000@P+ RECORD COUNT--S RECORDS 000000000000@P+ RECORD COUNT--W RECORDS 000000000000@P, RECORD COUNT--OTHER RECORDS 000000000000 @P,, CHOOSE ONE OF THE FOLLOWING REPORTS:@P,? 1) ELIGIBLE FOR WRITE-OFF REPORT@P,S 2) ACTUAL WRITE-OFF REPORT @P,d CHOOSE ONE OF THE FOLLOWING WAYS TO PRINT THE WRITE-OFF REPORT: @P, 1) PRINT THE REPORT BY ACCOUNT TYPE, QUEUE ASSIGNED @P, 2) PRINT THE REPORT BY QUEUE ASSIGNED, ACCOUNT TYPE @P, 3) PRINT THE REPORT BY STRAIGHT LIST @P3$2Ykw@Pd"ra@FgO@P( @P-T,,,T',,,ȼ T',,',\,,',dd@P-@dddThhT,,,,,,,\,,,?,, ,\,@P-k,,S,,, d\,,+w,,,, Hd 2! !db\@P-,  \,,+,,,, \,,+,,,,,  T-(, @P-,T  ! J\,T-W,,+,,,, ̜d, ! !@P- d,!T-,q,, !\,>, !T,\@P.,,,d,,,\,,,,,,\,,,,,,\,,,,,,T-,@P.B\,,+,,,,,  H d ! ! 6\@P.m,T-,,+,,,, T-,o,,, \,?,,  d@P.[ l ̺  1dc ̱  2l̬  3l ̤  4l ̜  5lT@P.s',, (T',,,\'', '\',,, db /Ts@P.,,Ф,  *\',,, dd@ d,!s $,d@P/, $-d, X d,-hPT.}/~Y,,, C 1ր@P/DhT@P/I- T,T.-,  d !T'-T.; ,'-,\-@P/t,'-,/dLБ@P//lЌ܊ \T.s,,,,  *T.'-,,@P/ ld@ d,!` $,d, $-d, J-hT/0/~@P/Y,, 3 dۀ hT/G@P/- T/O,, T/f'-T/j ,'-,\q,'-,0dL0l@P0ܝ 0n@P-70 @P0 d,2d- 'hch 'h\- @P09'@P0< 1c 6  ,- d/~\/~-'- -- l\/~-'--@P0gl\/~-'- -l\/~-'--T/b,'-\c,'-,$ , d-@P0( h\'-@P0- !T'( ,,, (T/'- ,, l, Eϑ@P-;0@P0 d,̐-lT//~Y,,,  1TGAA \G\\@P0 \GMM \GSSO@P.0@P/0@P/0@P0 l,  d,\M,q,̼ T0|M, 1 l\S,q@P1(,̢ \S, 1 lT0\,q,, \\,ܷ 1@P1S l\A,q, \A,ܞ 21U\M,+-,\S,+-,\\@P1~,+-,\A,,-,T.o,,+,,,\,,+,,,\,,+,,,\,,,@P1-,,@P/1@P/1@P1Ts,\',@P.1@P.1@P1TTPWRTOFEPQ8STP 1FMRDEL-SAMONTO-?ADAYTO-DAYERTO-IPGMIN -CCSCST1;CCSMVA1ICALJL-NWTREAD1IDATVR-INTGR /TOPENFL.FILERR0PGETS /DAYS /CCSGET/CCSBLK/PUTS 0CCSADD0CLOSFL1PGMOUT1PWRTOFE P3INTGR B65 F CCS CCS 3.0 SL-149@P hlh !ThT(l @P"H TTh\h\hPINTGR %PQ8QI2FQ8PKUP+Q8PREP(CCSGETP PDAYS CALCULATE DAYS DIFFERENCE FOR TWO DATES (RWE) @P@P@P hTT !jTh\h\hT \\@PH !K\h\h\h\Tp8h(dhhȢ 4 @Psؕ hșhȐ;Ƞ ȝ  ؘ@Pdd \˸ T HTThz\hx\h\h\@Ph\hgPDAYS PHFLOT ^Q8PKUPQ8PREPCCSMVA IDATVR(ICCSAD/YMD1 9HXDEC P PYMD1 @P@P @P @P@PW@P hVBœS  hO(hp8hڌI lH D#DlB> h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hnPYMD1 PHFLOT 5Q8PKUPQ8PREPFLOAT @P PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP __v\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hn( MX  I.LODFILCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING LODFIL FROM B.LODFIL, CCS149 FILE 00030*OPEN,FN=B.LODFIL,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,LODFIL,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM LODFIL HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190____v\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hn*CLOSE 01500(a ': /)J.UPD400CCS149 P(*JOB,,TWB.JOB UPD400 INSTALL 08/23/84 00010*K,L14 00020*CTO, UPD400 WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.UPD400 , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.UPD400,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120UPD400 DCK/ I,H 00130 END/ 00140*REW,7 00150*K,I7,P21,L14 00160*ASSEM 00170*REW,7,20 00180*K,I13,L2 00190*CSY,I20,P7 00200*COSY 00210UP4MAC DCK/ I,H 00220UP4BLK DCK/ I,H 00230FUPD4X DCK/ I,H 00240UP4INI DCK/ I,H 00250UP4LAB DCK/ I,H 00260UP4NXT DCK/ I,H 00270UP4TOT DCK/ I,H 00280UP4END DCK/ I,H 00290UP4GTM DCK/ I,H 00300UP4GTC DCK/ I,H 00310UP4PRT DCK/ I,H 00320UP4FML DCK/ I,H 00330CHNGNF DCK/ I,H 00340 DEL/ 239 00350 300 DO 350 I=STAKPT,1,-1 00360R9BASE DCK/ I,H 00370R9FLDL DCK/ I,H 00380 END/ 00390*REW,7 00400*K,I7,P21,L14 00410*FTN 00420*EOF 00430*CLOSE 00440*K,I13,L14 00450*Z 00460*Z 00470__LK DCK/ I,H 00230FUPD4X DCK/ I,H 00240UP4INI DCK/ I,H 00250( M  I.LTRBLDCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING LTRBLD FROM B.LTRBLD, CCS149 FILE 00030*OPEN,FN=B.LTRBLD,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,LTRBLD,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM LTRBLD HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__13,L14 00450*Z 00460*Z 00470__LK DCK/ I,H 00230FUPD4X DCK/ I,H 00240UP4INI DCK/ I,H 00250(^ V ,J.WRTOFECCS149 P(*JOB,,TWB.JOB WRTOFE INSTALL 08/23/84 00010*K,L14 00020*CTO, WRTOFE WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.WRTOFE , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.WRTOFE,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120WRTOFE DCK/ I,H 00130 DEL/ 2 00140 1 /C54 F CCS CCS 3.0 PSR(08-22-84) SL-149 00150 DEL/ 18,19 00160 INTEGER DATE(3),NDAYS,DDAYS,EOF,FDEL,FMRDEL 00170 INTEGER IBUF(6),IDUSER(4),MDLDT(3),MSTDT(3),MLEN(11) 00180 DEL/ 24,25 00190 INTEGER DELQBF(24),DELQRC(10000),DDATA(15) 00200 INTEGER WOEFBF(24),WOEFRC(60),WDATA(15),WEFREC(874) 00210 DEL/ 37,38 00220 INTEGER DDAT(4) 00230 DATA DDATA/'LADLQMST',8*$2020,0,10,0/,SUB/0/,IFG/0/,NUMPUT/0/ 00240 DATA WDATA/'LAWOEF ',8*$2020,0,1,0/,DDAT/'DELQMST '/ 00250 DEL/ 83 00260 CALL CCSCST(WDATA,1,2,IDUSER,1,8,ICM) 00270 IF(ICM.EQ.0) GO TO 5 00280 CALL CCSMVA(WDATA,3,6,WDATA,1,8) 00290 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00300 5 CONTINUE 00310 ASSIGN 1000 TO CREATE 00320 ASSIGN 1500 TO COUNT 00330 DEL/ 99,100 00340 CALL WTREAD(LUNIT,-1,DSP1,18,-1,IBUF,10,ITC) 00350 IF(IBUF(6).NE.1) GO TO 120 00360 DEL/ 107,129 00370 220 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00380 IF(WFG1.NE.$32)CALL WTREAD(LUNIT,-1,DSP2,30,-1,IBUF,10,ITC) 00390 IF(WFG1.EQ.$32)CALL WTREAD(LUNIT,-1,DSP4,40,-1,IBUF,10,ITC) 004001 00410 IF(ITC.NE.2) GO TO 220 00420 IF(IBUF(6).NE.6) GO TO 220 00430 CALL CCSMVA(IBUF,1,6,ASOFDT,1,8) 00440 IF(IDATVR(ASOFDT,1).LT.0) GO TO 220 00450 IF(WFG1.EQ.$32) GO TO 300 00460 DEL/ 132,139 00470 260 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00480 CALL WTREAD(LUNIT,-1,DSP3,42,-1,IBUF,10,ITC) 00490 IF(ITC.NE.2) GO TO 260 00500 NCH = IBUF(6) 00510 IF(NCH.LT.1 .OR. NCH.GT.3) GO TO 260 005201 00530C CHECK FOR NUMERICS 00540 DO 280 II=1,NCH 00550 DEL/ 146,151 00560 290 CALL INTGR(IBUF,NCH,NDAYS) 00570 DEL/ 160,162 00580 320 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00590 CALL WTREAD(LUNIT,-1,DSP5,20,-1,IBUF,10,ITC) 00600 IF(ITC.NE.2) GO TO 300 00610 IF(IBUF(6).NE.1)GO TO 300 00620 DEL/ 168,171 00630 340 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00640 CALL WTREAD(LUNIT,-1,DSP6,34,-1,IBUF,10,ITC) 00650 IF(ITC.NE.2) GO TO 340 00660 DEL/ 210 00670 420 CONTINUE 00680 DEL/ 229 00690 450 CONTINUE 00700 DEL/ 240,249 007101 00720 500 CALL DAYS(DELQRC(JW+1),875,ASOFDT,1,ADAYS,0) 00730 CALL CCSGET( ADAYS,1,ICM ) 00740 CALL INTGR(ADAYS(2),4,DDAYS) 00750 IF( ICM.EQ.$2D ) DDAYS = -1 00760 DEL/ 253 00770 540 IF(DDAYS.LT.NDAYS) GO TO 580 00780 DEL/ 258 00790 DEL/ 264 00800 DEL/ 269 00810 DEL/ 286 00820 700 CONTINUE 00830 DEL/ 305 00840 730 CONTINUE 00850 DEL/ 316,331 00860 CALL DAYS(DELQRC(JW+1),857,ASOFDT,1,ADAYS,0) 00870 CALL CCSGET( ADAYS,1,ICM ) 00880 IF(ICM.NE.$2D) GO TO 780 008901 00900 DEL/ 340 00910 DEL/ 345,346 00920 780 ASSIGN 800 TO RETURN 00930 DEL/ 379,382 00940C IF BUFFER IS FULL. 009501 00960 1060 CONTINUE 00970 NUMPUT = NUMPUT + 1 00980 IWW = NUMPUT * 58 - 57 009901 01000 CALL CCSMVA(WOEFRC,1,115,WEFREC(IWW),1,115) 01010 IF(NUMPUT.LT.15) GO TO 1070 010201 01030 1065 CALL PUTS(WOEFBF,WEFREC,NUMPUT,ISTAT) 01040 IF(ISTAT.GE.0) GO TO 1068 01050 CALL FILERR(WDATA,11,ISTAT,LUNIT) 01060 GO TO 9500 010701 01080 1068 NUMPUT = 0 01090 IF(IFG.EQ.1) GO TO 9000 01100 DEL/ 410,429 01110 9000 CONTINUE 01120 IFG = 1 01130 IF(NUMPUT.NE.0) GO TO 1065 01140INTGR DCK/ I,H 01150DAYS DCK/ I=13,H 01160DAYS HOL/ 01170 SUBROUTINE DAYS( BUF1,BYT1,BUF2,BYT2,ASCDAY,DCALC ) 01180 + /CALCULATE DAYS DIFFERENCE FOR TWO DATES (RWE) 011901 01200C** CYBERCREDIT FINANCIAL SERVICES. 01210C** CYBERCREDIT FIELD SUPPORT GROUPS 01220C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 01230C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 01240C** 01250C** ************ 01/13/84 ************ PROGRAMMER : RWE 012601 01270C**** THIS SUBROUTINE WILL CALCULATE THE NUMBER OF DAYS DIFFERENCE 01280C**** FOR TWO DATES. 012901 01300C**** PARAMETERS... 01310C**** 01320C**** BUF1 - BUFFER CONTAINING THE FIRST DATE (PAST DATE) 01330C**** BYT1 - CHARACTER INDEX OF DATE STARTING POSITION IN BUF1 01340C**** BUF2 - BUFFER CONTAINING THE SECOND DATE (LATEST DATE) 01350C**** BYT2 - CHARACTER INDEX OF DATE STARTING POSITION IN BUF2 01360C**** ASCDAY- 3 WORD BUFFER TO RECEIVE # OF DAYS IN ASCII 01370C**** ZERO FILLED RIGHT ADJUSTED. 01380C**** DCALC- FLAG FOR # OF DAYS DIFFERENCE CALCULATION 01390C**** 0 = TOTAL DAYS DIFFERENCE 01400C**** NOT 0 = TOTAL WEEKDAYS DIFFERENCE - NO WEEKEND DAYS 014102 01420 INTEGER BUF1(1),BYT1,BUF2(1),BYT2,ASCDAY(3),DCALC 01430 1, DATE1(3),DATE2(3),DELTA,T1,T2,T3,NDAYS 01440 2, INYR1,INMO1,INDY1,IDYYR1,IDYWK1 01450 3, INYR2,INMO2,INDY2,IDYYR2,IDYWK2 014601 01470 REAL DYCT1,DYCT2 014802 01490C****** START PROGRAM 015001 01510 NDAYS = 0 015201 01530C**** GET FIRST DATE & DO CALC 01540 CALL CCSMVA(BUF1,BYT1,06,DATE1,01,06) 01550 IF ( IDATVR( DATE1, 1 ) .LT. 0 ) GO TO 200 01560C 01570 INMO1 = ICCSAD(DATE1(1)) 01580 INDY1 = ICCSAD(DATE1(2)) 01590 INYR1 = ICCSAD(DATE1(3)) 016001 01610 CALL YMD1 (INYR1,INMO1,INDY1,DYCT1,IDYYR1,IDYWK1) 016201 01630C**** GET SECOND DATE & DO CALC 01640 CALL CCSMVA(BUF2,BYT2,06,DATE2,01,06) 01650 IF ( IDATVR( DATE2, 1 ) .LT. 0 ) GO TO 200 01660C 01670 INMO2 = ICCSAD(DATE2(1)) 01680 INDY2 = ICCSAD(DATE2(2)) 01690 INYR2 = ICCSAD(DATE2(3)) 017001 01710 CALL YMD1 (INYR2,INMO2,INDY2,DYCT2,IDYYR2,IDYWK2) 017202 01730C******* CALCULATE DAYS DIFFERENCE 017401 01750 DELTA = DYCT2 - DYCT1 01760 T1 = DELTA/7 01770 T2 = DELTA - ( T1 * 7 ) 01780 T2 = T2+IDYWK1 01790 IF( DCALC.EQ.2 .AND. IDYWK1.GE.6 ) T2 = T2+1 01800 T3 = 0 01810 DO 150 IL = IDYWK1,T2 01820 IF (IL.EQ.06. OR .IL.EQ.07) T3=T3+1 01830 150 CONTINUE 01840 NDAYS = DELTA - ( T1*2 )-T3 01850 IF ( DCALC .EQ. 0 ) NDAYS = DYCT2 - DYCT1 01860C*** IF ( NDAYS .LT. 0 ) NDAYS = 0 018701 01880C**** NOW CONVERT DAYS TO ASCII 018901 01900 200 CALL HXDEC(NDAYS,ASCDAY) 019101 01920 RETURN 01930 END 01940 END/ 01950YMD1 DCK/ I=13,H 01960YMD1 HOL/ 01970 SUBROUTINE YMD1(IYR,IMO,IDYMO,DYCT,IDYYR,IDYWK) 01980C-----INPUTS IYR - YEAR ( 1 TO 99 ) 01990C IMO - MONTH( 1 TO 12 ) 02000C IDYMO - DAY OF MONTH ( 1 TO 31 ) 02010C-----OUTPUTS DYCT - DAY OF CENTURY (FROM JAN 1, 1901) 02020C IDYYR - DAY OF YEAR ( 1 TO 366 ) 02030C IDYWK - DAY OF WEEK ( 1 TO 7, MON IS 1 ) 02040C 02050 LEAPYR = 2 02060 IF ((IYR/4*4).EQ.IYR) LEAPYR = 1 02070 IMT = IMO*275 02080 IMT = IMT/9 02090 IDYYR = IMT+IDYMO-30 02100 IF (IMO.GT.2) IDYYR = IDYYR-LEAPYR 02110 YR=IYR-1 02120 DYYR=IDYYR 02130 TDYCT=YR*1461 02140 DYCT = TDYCT/4+DYYR 02150 DYCT2= DYCT 02160 DNUM=05*1000 02170 DMINUS=7*343 02180 IL = 0 02190 5 IF(DYCT2.LT.DNUM )GO TO 6 02200 IL = IL+1 02210 DYCT2=DYCT2-DMINUS 02220 GO TO 5 02230 6 CONTINUE 02240 IDYCT=DYCT2 02250 DYCT = IL * DMINUS + IDYCT 02260 IDYWK = IDYCT-IDYCT/7*7+1 02270 RETURN 02280 END 02290 END/ 02300HXDEC DCK/ I=13,H 02310HXDEC HOL/ 02320 SUBROUTINE HXDEC (NUM,IOUT) 02330 * /DECK-ID E27 ITOS 2.0 SUMMARY-132 02340C CONVERT HEX TO DECIMAL ASCII 02350C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 2.0 02360C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 02370C COPYRIGHT CONTROL DATA CORPORATION 1978 02380C 02390C** FUNCTION 02400C -------- 02410CS3 HXDEC CONVERTS A HEXADECIMAL NUMBER INTO AN ASCII 02420C DECIMAL NUMBER. 02430CS5 GENERAL DESCRIPTION 02440C ------------------- 02450CS3 HXDEC BLANKS OUT THE OUTPUT BUFFER, IOUT. THE 02460C SUBROUTINE THEN TESTS THE HEX NUMBER FOR ZERO. IF 02470C THE NUMBER IS ZERO, AN ASCII ZERO IS MOVED TO THE 02480C RIGHT BYTE OF THE THIRD WORD OF IOUT. IF THE 02490C NUMBER IS NOT ZERO AND IS NEGATIVE AN ASCII MINUS 02500C SIGN IS PLACED IN THE LEFT BYTE OF THE FIRST WORD 02510C OF IOUT AND THE HEX NUMBER IS COMPLIMENTED. AT 02520C THIS POINT ANOTHER TEST FOR ZERO IS MADE. IF THE 02530C NUMBER IS ZERO, NO CONVERSION TAKES PLACE, 02540C OTHERWISE THE HEX NUMBER IS CONVERTED TO AN ASCII 02550C DECIMAL NUMBER. 02560CE ENTRY/EXIT 02570C ---------- 02580CS3 HXDEC IS ENTERED WITH THE HEX NUMBER IN NUM AND 02590C EXITS WITH THE CONVERTED NUMBER IN IOUT. 02600C 02610 BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) 02620 DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) 02630C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. 02640 N=NUM 02650 DO 8 JK=1,3 02660 8 IOUT(JK)= $3030 02670 IF(N.EQ.0) IRIGHT(3)=$30 02680 IF(N.GE.0) GO TO 50 02690C MINUS NUMBER 02700 N=-N 02710 ILEFT(1)=$2D 0272050 CONTINUE 02730 I=5 0274055 CONTINUE 02750 IF(N.EQ.0) GO TO 200 02760 N1=(N/10)*10 02770 N2=N-N1+$30 02780 I1=I/2+1 02790 IF(AND(I,1).EQ.0) GO TO 100 02800 IRIGHT(I1)=N2 02810 GO TO 110 02820100 ILEFT(I1)=N2 02830110 CONTINUE 02840 N=N/10 02850 I=I-1 02860 IF(I.GT.0) GO TO 55 02870200 CONTINUE 02880 RETURN 02890 END 02900 END/ 02910 END/ 02920*REW,7 02930*K,I7,P21,L14 02940*FTN 02950*EOF 02960*CLOSE 02970*K,I13,L14 02980*Z 02990*Z 03000__ IF(N.EQ.0) GO TO 200 02760 N1=(N/10)*10 02770 N2=N-N1+$30 02780 I1=I/2+1 02790 IF(AND(I,1).EQ.0) GO TO 100 02800 IRIGHT(I1)=N2 02810 GO TO 110 02820100 ILEFT(I1)=N2 02830110 CONTINUE 02840 N=N/10 02850 I=I-1 02860 IF(I.GT.0) GO TO 55 02870200 CONTINUE 02880 RETURN 02890 END 02900 END/ 02910 END/ 02920*REW,7 02930*K,I7,P21,L14 02940*FTN 02950*EOF 02960*CLOSE 02970*K,I13,L14 02980*Z 02990*Z 03000(  WSTRENDFCCS149 P032883($$TWB.JOB,WEAVE,,TRENDF,CCS149 00010$$U.TRENDF,CCS149 00020$$TWFBEND,WEAVE 00030_ __ I=I-1 02860 IF(I.GT.0) GO TO 55 02870200 CONTINUE 02880 RETURN 02890 END 02900 END/ 02910 END/ 02920*REW,7 02930*K,I7,P21,L14 02940*FTN 02950*EOF 02960*CLOSE 02970*K,I13,L14 02980*Z 02990*Z 03000(c Bh 1*J.ACTADDCCS149 P(*JOB,,TWB.JOB ACTADD INSTALL 08/23/84 00010*K,L14 00020*CTO, ACTADD WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.ACTADD , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.ACTADD,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120ACTADD DCK/ I,H 00130 DEL/ 2 00140 1 /B01 F CCS CCS 3.0 .LA - PSRD SL-149 00150 DEL/ 22,24 00160 DATA TDATA /'LATRNSFL', 8*$2020, 0, 1, 0 / 00170 DATA ADATA /'LAACTFIL', 8*$2020, 1, 1, 1 / 00180 DATA UDATA /'LAUTIFIL', 8*$2020, 1, 1, 0 / 00190 INS/ 29 00200 CALL CCSCST(UDATA,1,2,USER,1,8,ISTAT) 00210 IF(ISTAT.EQ.0) GO TO 5 00220 CALL CCSMVA(TDATA,3,6,TDATA,1,8) 00230 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00240 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00250 5 CONTINUE 00260 INS/ 44 00270 UREQ(23) = 1 00280 DEL/ 61,63 00290C ****************************************************** ???*0012 00300C 3 LINES DELETED 00310C ****************************************************** ???*0012 00320 INS/ 92 00330C ****************************************************** ???*A028 00340C VERIFY BLOCK IS > 51 (I.E., BLOCK DID NOT COME FROM 00350C TAPE HISTORY) 00360 IF ( AREC(9) .GT. $3530 ) GO TO 300 00370C ****************************************************** ???*A028 00380R9BASE DCK/ I,H 00390R9FLDL DCK/ I,H 00400 END/ 00410*REW,7 00420*K,I7,P21,L14 00430*FTN 00440*EOF 00450*CLOSE 00460*K,I13,L14 00470*Z 00480*Z 00490__ CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00250(1| '{mU.CCSADDCCS149 P032883(CCSADD DCK/ I,H 00010 DEL/ 1 00020 NAM CCSADD A02 A CCS CCS 3.0 PSR'D SL-149 00030 DEL/ 85 00040 LDQ (POS1) STARTING POSITION IN FIRST ARRAY ???*A010 00050 DEL/ 89 00060 ADD ARR1 ADD ADDR TO ARRAY 1 TO GET ACTUAL ADDR???*A010 00070 DEL/ 93 00080 LDQ (POS1) LOAD Q WITH POSITION IN ARRAY OF FIRST???*A010 00090 DEL/ 99,109 00100 INA -$3A ???*A010 00110 SAM L03 SENSE DIGIT ASCII, BYPASS CONVERSION ???*A010 00120 INA -$4A+$3A ???*A010 00130 SAP L01 SENSE NOT POSITIVE DIGIT ???*A010 00140 INA -$10+$4A CONVERT POS. DIGIT($41-$49=POS. DIGITS???*A010 00150 JMP* L02 ???*A010 00160L01 INA -$7B+$4A ???*A010 00170 SAN L04 SENSE NOT POSITIVE ZERO ???*A010 00180 ENA $30 CONVERT POS. ZERO ???*A010 00190L02 SCA* (ARR1),Q STORE CONVERTED CHAR. ???*A010 00200L03 JMP* ISPOS1 ???*A010 00210L04 INA -$7D+$7B ???*A010 00220 SAZ ISZR1 SENSE NEG. ZERO ???*A010 00230 INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00240 DEL/ 157,167 00250 INA -$3A ???*A010 00260 SAM L13 SENSE DIGIT ASCII, BYPASS CONVERSION ???*A010 00270 INA -$4A+$3A ???*A010 00280 SAP L11 SENSE NOT POSITIVE DIGIT ???*A010 00290 INA -$10+$4A CONVERT POS. DIGIT ???*A010 00300 JMP* L12 ???*A010 00310L11 INA -$7B+$4A ???*A010 00320 SAN L14 SENSE NOT POSITIVE ZERO ???*A010 00330 ENA $30 CONVERT POS. ZERO ???*A010 00340L12 SCA* (ARR2),Q STORE CONVERTED CHAR. ???*A010 00350L13 JMP* ISPOS2 ???*A010 00360L14 INA -$7D+$7B ???*A010 00370 SAZ ISZR2 SENSE NEG. ZERO ???*A010 00380 INA -$19+$7D ???*A010 00390__ INA -$10+$4A CONVERT POS. DIGIT($41-$49=POS. DIGITS???*A010 00150 JMP* L02 ???*A010 00160L01 INA -$7B+$4A ???*A010 00170 SAN L04 SENSE NOT POSITIVE ZERO ???*A010 00180 ENA $30 CONVERT POS. ZERO ???*A010 00190L02 SCA* (ARR1),Q STORE CONVERTED CHAR. ???*A010 00200L03 JMP* ISPOS1 ???*A010 00210L04 INA -$7D+$7B ???*A010 00220 SAZ ISZR1 SENSE NEG. ZERO ???*A010 00230 INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00240 DEL/ 157,167 00250(r | U.CCSEACCCS149 P032883(CCSEAC DCK/ I,H 00010 DEL/ 1 00020 NAM CCSEAC A05 A CCS CCS 3.0 PSR'D SL-149 00030 INS/ 45 00040* ****************************************************** ???*A010 00050* 30 0 C0 00060* ***************************************************** ???*A010 00070 DEL/ 235 00080 NUM $3041 C0 - C1 0 A ???*A010 00090 DEL/ 331 00100 NUM $00C0 7A - 7B POSITIVE 0 ???*A010 00110__ INA -$7D+$7B ???*A010 00370 SAZ ISZR2 SENSE NEG. ZERO ???*A010 00380 INA -$19+$7D ???*A010 00390__ INA -$10+$4A CONVERT POS. DIGIT($41-$49=POS. DIGITS???*A010 00150 JMP* L02 ???*A010 00160L01 INA -$7B+$4A ???*A010 00170 SAN L04 SENSE NOT POSITIVE ZERO ???*A010 00180 ENA $30 CONVERT POS. ZERO ???*A010 00190L02 SCA* (ARR1),Q STORE CONVERTED CHAR. ???*A010 00200L03 JMP* ISPOS1 ???*A010 00210L04 INA -$7D+$7B ???*A010 00220 SAZ ISZR1 SENSE NEG. ZERO ???*A010 00230 INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00240 DEL/ 157,167 00250( i }U.CHNGNFCCS149 P032883(CHNGNF DCK/ I,H 00300 DEL/ 239 00301 300 DO 350 I=STAKPT,1,-1 00302__ INS/ 45 00040* ****************************************************** ???*A010 00050* 30 0 C0 00060* ***************************************************** ???*A010 00070 DEL/ 235 00080 NUM $3041 C0 - C1 0 A ???*A010 00090 DEL/ 331 00100 NUM $00C0 7A - 7B POSITIVE 0 ???*A010 00110__ INA -$7D+$7B ???*A010 00370 SAZ ISZR2 SENSE NEG. ZERO ???*A010 00380 INA -$19+$7D ???*A010 00390__ INA -$10+$4A CONVERT POS. DIGIT($41-$49=POS. DIGITS???*A010 00150 JMP* L02 ???*A010 00160L01 INA -$7B+$4A ???*A010 00170 SAN L04 SENSE NOT POSITIVE ZERO ???*A010 00180 ENA $30 CONVERT POS. ZERO ???*A010 00190L02 SCA* (ARR1),Q STORE CONVERTED CHAR. ???*A010 00200L03 JMP* ISPOS1 ???*A010 00210L04 INA -$7D+$7B ???*A010 00220 SAZ ISZR1 SENSE NEG. ZERO ???*A010 00230 INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00240 DEL/ 157,167 00250(s | U.CHSCRNCCS149 P032883(CHSCRN DCK/ I,H 00010 DEL/ 2 00020 1 /B25 F CCS CCS 3.0 PSR'D SL-149 00030 INS/ 77 00040C ****************************************************** ???*A026 00050 INTEGER NINES(5) 00060 DATA NINES/5*$3939/ 00070C ****************************************************** ???*A026 00080 INS/ 212 00090C ****************************************************** ???*A026 00100 CALL CCSCST (KEY, 1, 9, NINES, 1, 9, COMPIN) 00110 IF (COMPIN .NE. 0) GO TO 162 00120 GO TO 60 00130 162 CONTINUE 00140C ****************************************************** ???*A026 00150__ JMP* L02 ???*A010 00160L01 INA -$7B+$4A ???*A010 00170 SAN L04 SENSE NOT POSITIVE ZERO ???*A010 00180 ENA $30 CONVERT POS. ZERO ???*A010 00190L02 SCA* (ARR1),Q STORE CONVERTED CHAR. ???*A010 00200L03 JMP* ISPOS1 ???*A010 00210L04 INA -$7D+$7B ???*A010 00220 SAZ ISZR1 SENSE NEG. ZERO ???*A010 00230 INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00240 DEL/ 157,167 00250<s bz7HB.CHUPD2CCS149 x032883< PCHUPD2 B26 F CCS CCS 3.0 .LA - PSRD 08-83 SL-149@P@P @P @P @P @P  @P  @P &h@P *+50@P 6514@P ;@Pe@P}CHUPTEMP SYSVOL @P@PCHUPTEMP  @P@PЂ@P@P@P@P  @P DELQMST ACTFIL UPREQ @P 9LADLQMSTLAACTFILLAUPDREQ@P MOUNT TAPE LABELED: / / ENTER "OK" FOR READY ENTER "NX" FOR NEXT TAPE EN@P TER "EX" TO END @P ROKEX@P NX@P F@P T@P ] INCORRECT TAPE MOUNTED @P j ACCOUNT=# NOT FOUND ON @P END OF HISTORY@P END OF REEL X MOUNT REEL X@P TAPE @P YES NO@P @P ;T)   T 9 )   T   9 hhT 6Tz" @P f hȯ hT@P pب 1 hȡ h\@P }؛ 1 d 5h\@P 1 d  !h\@P 1T d l ,h 4f 1 ,hT@P   d E  " l n 1 1 l @nܲ 1  d&\@P   " lT   " d  dTe}  d  fd@P  1Te}  l̤ )T} E  @P + l\ ̒ !T-   d E   "T N- !  !\ @P V ! j " !T B- # $  $ % % \ d 1d \- # $  $5d 6d  7d @P T  & ' & P  ( P R 9 S   \- # $  $\-  ̓@P ̎ "\- # $  $ %̦  ; T  lr d )T $ * ) UT@P T L   j + ̉ T [    % % T 1\   ,@P \   -T  & - F F F (k !\ $  $\  $  $ %  @P-\  & ] . F F F (I l\ !  ! %̫ !̧  d TT-   d E@PXT 9  j +   /  " l d \    \- 0@P 1  1AT  "T  !  ! % %   \ !  ! %  l@P  2d d  l 3,h\@P !  ! % ,d *d 4ڜ"T d 5T 5 c"TY @P !  !d \  0 G 0̾,h\@P 6 7  6 7T G  d E  1P !  O 8\  0 0 lTP@P1 ߤ \ G 0 0 l\ ˬ  lT ̾ " @P\l\ ̲ " "̸T      " d JT bz y @Pd hT n@P 1 l h\@P 1 l h\@P 1 lր h\@P 1T T 1 @P @PN@Pg@Pn@PT  & j 9 F F F ( d c@P @P @PT # E  @P @P J@P @P\ A E   @Ps@P\ 9 E  \ = E  @P )@P E@P @P\r T \ \ \  d : f 1T } Th@P f@P(1H1,20A2,9X,26HTAPE HISTORY UPDATE REPORT,/,1X,20A2,14X,9HRUN DATE:,A2,1H/,A2,1H/,A2,@P"T9 \^" l $ d\ @PihT hTllh\rrT@P9 h\9̵huT9̪hk\9̡hb\9@P̘hX\9̍hMT !ƌhB\9h8\9@Ph.\9h$\9dT|gaaT!9xT@P!@P # 7T ^"KlTB9T9\9\!9@PFx\\9\9 lTa̠ \aܬ 1\a@Pq9l\!9x\d\9\9Tl\9 T @P!9xTl\9\'9\rT59\!9x\l@PT19\9\/9\!9x\@P8@PT@P"@PTTPSUMACLPQ8STP FMRDELPGMIN CCSCSTXCCSMVAUTHEADSUMHD )OPENFLFILERRGETS $CCSBLKCCSGETmCCSADDEDIT PIDATVRFWRITEDISP TOTEDTCLOSFLPGMOUTPSUMACL PISUMHD C21 F CCS CCS 3.0 SL-149@P@P d (5z@P)9@Q *7&bK8@P@P@P_ @P @P 00 @PACCOUNT SUMMARY LIST REPORT @PPAGE@PAS OF:@PACCOUNT NUMBER BORROWERS NAME@PJDELINQUENT DELINQUENT CURRENT QUEUE @PaPROMISED TO PAY NEXT REVIEW @P$DATE AMOUNT PAYOFF DATE AMOUNT CONTACT CODE @P'p8h(dhp8h(dhp8h(dhh 0h 0ȈhȺ 0hȵ 0@PRhTtT_t\t\t\t hT@P}  \ ؊ 1\tlTtT\t@P\t\tTtl\t\\t\t@Pl\t\TVtTZ`t\t\J t! \a"t#"@P d\t\\t\$$t%&l\t\\t/lTt@P)T@P(@P/@P2HTTh\hy\h hehPSUMHD 4PQ8PKUP:Q8PREP7CCSBLKCCSMVACCSCSTyFWRITE&DISP .EDIT P __aPROMISED TO PAY NEXT REVIEW (D z; U.TIMUSECCS149 P032883(TIMUSE DCK/ I,H 00010 DEL/ 2,3 00020 X 1 D10 R CCS CCS 3.0 PSR'D SL-149 00030 F* D10 R CCS CCS 3.0 PSR'D SL-149 00040 DEL/ 36 00050 I****************************************************** ???*A016 00060 I 136 136 AFLAG 00070 I****************************************************** ???*A016 00080 DEL/ 67 00090 C****************************************************** ???*A016 00100 C AFLAG COMP 'Z' 62 00110 C****************************************************** ???*A016 00120__(@P/@P2HTTh\hy\h hehPSUMHD 4PQ8PKUP:Q8PREP7CCSBLKCCSMVACCSCSTyFWRITE&DISP .EDIT P __aPROMISED TO PAY NEXT REVIEW <R njB.TRNPLYCCS149 x032883< P dTRNPLY C28 F CCS CCS 3.0 .LA - LKL07 SL-149@P@P@PEXOK!^#0102  +8 jJp Pcy@Pj@P_'@P @P@P>LAUTIFIL  @PM@PHOST@P@P@P,@PS@Pb@Pz@P@PDELQMST COSIGNERSCRNFILE@PLADLQMST  @PDLACOSIGN  @PkLATRANFL  @P@P@P @P(@PS@Pg@P@P@PLASCNFIL  @PLAADDACT  @P@P8@P0360@P@PY @P#@P9PP@P,0130@P.60909193@P5@P @P<1 N @P4@P;@P2@P!@P:?@P @P0Nl1E(@P@PTT>ȹ ,T>>\kk\ \@P\D\Tz'E dhT@P= 1T @PE(/,8HUSERID =,4A2,37H TYPE OK TO CONTINUE, OR EX TO EXIT,/) @PdT T (T@P\,D '\D\Sk '\k\z '\ @P\ '\\M≯ '\>Tz̨ ̠@P "T\z̒  "\(\z՜  @P"\Tz d d! d"TS8ʤǜ !T@P;3Tk24T ̖@Pf ̎̈ "\\e\Meeٜ @P "\e\̠d#TY#\T;@P\9 \\\ \@P, !- 1. 1// 2 1 2 3@P Td ,hDd ,h d d@P /\ l ,h'Dl ,h(lT$T^,  1-@P Z  T\$\T,$ ";@P \T,̾ "T  d ,hDd ,d .@P d d \ l l4l lT K   "@P   T T C\  $@P  l dd!.̡ $  +h\:@P &  +܀h\ @P 7  7 \ \<̞ "Ȕ \@P b\=T " @P w@P w@P wT  2@Pu @P TR@Pj @Pp @P 2 T.r  @@P (1H1,/,20X,28HTRANSACTION REPLAY -- REPORT,/,39X,12HNEW DATA OR,/,5X,9HACCOUNT #,7X,3@P 6HTYPE UPCD AC RC LT COMMENT) @P lI\z  dhT;@P 1\\ dh\@P 1TC@P (2X,8A2,4X,A2,6X,A2,5X,15A2,4X,15H NOT UPDATED***)@P ; lT z  W l̶h\@P 3ܰ 1\ l̺h\@P Bܴ 1 dh\@P P 21\@P W(2X,8A2,4X,A2,11X,3(2X,A2),3X,28A2,4X,15H NOT UPDATED***) @P t4 l@P z@P z@P z@P z@P z@P z@P zT \r @P (39HREPLACE SCREEN FILE AND RESTART PROGRAM)@P T@Py @P @P @P @P @P @P @PZ @P @P T &r @P (41H ...PROGRAM ABORTED. - RUN NOT COMPLETE)@P ?@P d @P @P @P \D@P v @P \@P @P @P \z T \T @P (9H COID : ,2A2,32H NOT IN UTIFIL - USING HOST ID ) @P T e@P5 @P TS\\,\\M\z \4\;\3\2\G@P (26HTOTAL ACTIVITIES UPDATED ,I4,/,26HTOTAL CHANGES UPDATED ,I4,/,26HTOTAL OTHER @P ERECORDS ,I4,/,26HTOTAL NOT UPDATED  ,I4) @P `T TPTRNPLYPQ8STP cQ8QINI Q8QX Q8QEND AMONTOADAYTO!AYERTO&PGMIN CCSCST CCSMVA WTREADeOPENFLFILERR {READR PGETCHFCLOSFL GETS *PUTACFICCSAD CCSBLK fWRITER xUPDREC xPUTS lPGMOUT aPTRNPLY PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP __ (26HTOTAL ACTIVITIES UPDATED ,I4,/,26HTOTAL CHANGES UPDATED ,I4,/,26HTOTAL OTHER @P ERECORDS ,I4,/,26HTOTAL NOT UPDATED  ,I4) @P `T TPTRNPLYPQ8STP cQ8QINI Q8QX Q8QEND AMONTOADAYTO!AYERTO&PGMIN CCSCST CCSMVA WTREADeOPENFLFILERR {READR PGETCHFCLOSFL GETS *PUTACFICCSAD CCSBLK fWRITER xUPDREC xPUTS lPGMOUT aPTRNPLY PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDL(O z;U.UPDMACCCS149 P032883(UPDMAC DCK/ I,H 00010 DEL/ 2 00020 1 /C36 F CCS CCS 3.0 PSR'D SL-149 00030 DEL/ 191,194 00040C ****************************************************** ???*A029 00050 INTEGER HDLIN(66,3), HDLINT(2) 00060 INTEGER COLHD(66,2), COLHDT(2) 00070 COMMON / UPD / HDLIN, HDLINT, COLHD, COLHDT 00080C ****************************************************** ???*A029 00090_ __ PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDL (O B !J.ACTMTNCCS149 P(*JOB,,TWB.JOB ACTMTN INSTALL 08/23/84 00010*K,L14 00020*CTO, ACTMTN WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.ACTMTN , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.ACTMTN,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120ACTMTN DCK/ I,H 00130 DEL/ 2 00140 1 /B03 F CCS CCS 3.0 &LA SL-149 00150 DEL/ 20 00160 DATA ADATA / 'LAACTFIL', 8*$2020, 1, 1, 0 / 00170 INS/ 25 00180 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00190 IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250*CLOSE 00260*K,I13,L14 00270*Z 00280*Z 00290__, IS NOW BEING COMPILED TO B.ACTMTN , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.ACTMTN,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120ACTMTN DCK/ I,H 00130 DEL/ 2 00140 1 /B03 F CCS CCS 3.0 &LA SL-149 00150 DEL/ 20 00160 DATA ADATA / 'LAACTFIL', 8*$2020, 1, 1, 0 / 00170 INS/ 25 00180 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00190 IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250(H w-WSACTADDCCS149 P032883($$TWB.JOB,WEAVE,,ACTADD,CCS149 00010$$U.ACTADD,CCS149 00020R9BASE DCK/ I,H 00030R9FLDL DCK/ I,H 00040$$TWFBEND,WEAVE 00050_ __ DEL/ 20 00160 DATA ADATA / 'LAACTFIL', 8*$2020, 1, 1, 0 / 00170 INS/ 25 00180 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00190 IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250( kD }cWSCCSADDCCS149 P032883($$TWBNJOB,WEAVE,,CCSADD,CCS149 00010$$U.CCSADD,CCS149 00020$$TWABEND,WEAVE 00030_ __ __ DEL/ 20 00160 DATA ADATA / 'LAACTFIL', 8*$2020, 1, 1, 0 / 00170 INS/ 25 00180 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00190 IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250( s |WSCCSEACCCS149 P032883($$TWBNJOB,WEAVE,,CCSEAC,CCS149 00010$$U.CCSEAC,CCS149 00020$$TWABEND,WEAVE 00030_ __ __ DEL/ 20 00160 DATA ADATA / 'LAACTFIL', 8*$2020, 1, 1, 0 / 00170 INS/ 25 00180 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00190 IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250( B  I.ACTMTNCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING ACTMTN FROM B.ACTMTN, CCS149 FILE 00030*OPEN,FN=B.ACTMTN,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,ACTMTN,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM ACTMTN HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250( { {mWSCHUPD2CCS149 P032883($$TWB.JOB,WEAVE,,CHUPD2,CCS149 00010$$U.CHUPD2,CCS149 00020$$TWFBEND,WEAVE 00030_ __SE 00140*CTO, PROGRAM ACTMTN HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250( | {MWSCPYINDCCS149 P032883($$TWB.JOB,WEAVE,,CPYIND,CCS149 00010$$U.CPYIND,CCS149 00020$$TWFBEND,WEAVE 00030_ __SE 00140*CTO, PROGRAM ACTMTN HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250( g z7WSDHUPDTCCS149 P032883($$TWB.JOB,WEAVE,,DHUPDT,CCS149,LC 00010$$U.DHUPDT,CCS149 00020$$TWFBEND,WEAVE 00030_ __SE 00140*CTO, PROGRAM ACTMTN HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00200 END/ 00210*REW,7 00220*K,I7,P21,L14 00230*FTN 00240*EOF 00250(} Su K5J.NMCHNGCCS149 P(*JOB,,TWB.JOB NMCHNG INSTALL 08/23/84 00010*K,L14 00020*CTO, NMCHNG WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.NMCHNG , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.NMCHNG,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120NMCHNG DCK/ I,H 00130 DEL/ 2 00140 1 /B82 F CCS CCS 3.0 .LA PSR(05/83) SL-149 00150 DEL/ 19,20 00160 INTEGER DDAT(4) 00170 DATA DDAT /'DELQMST '/ 00180 DATA DDATA/'LADLQMST', 8*$2020, 1, 1, 1 / 00190 DATA ADATA/'LAADDACT', 8*$2020, 0, 1, 0 / 00200 INS/ 21 00210 INTEGER KYERR(29) 00220 DATA KYERR/$D0A,'NAME CHANGE KEY-INDEX ERROR *** ' 00230 1, 'PROGRAM CONTINUING..',$2E07/ 00240 INS/ 24 00250 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00260 IF(ICM.EQ.0) GO TO 5 00270 CALL CCSMVA(DDAT,1,8,DDATA,1,8) 00280 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00290 5 CONTINUE 00300 INS/ 52 00310C**************************************************** PSR(05/83) 00320C UPDATE ADDACT RECORD . SO WE DONT CHANGE NAME TWICE 003301 00340 CALL CCSPUT( $5A, 17, ADDREC ) 00350 CALL UPDREC( ADDREQ, ADDREC, ISTAT ) 00360 IF (ISTAT.GE.0) GO TO 215 00370 CALL FILERR(ADATA,15,ISTAT,LU) 00380 GOTO 300 003901 00400 215 CONTINUE 00410 INS/ 64 00420C**************************************************** PSR(05/83) 00430C CHECK IF OLD KEY AND NEW KEY ARE SAME IF SO THEN 00440C BLANK OUT OLD KEY AND UPDATE RECORD. 004501 00460 CALL CCSCST(DEQREC,18,6,DEQREC,1047,6,ICOMP) 00470 IF(ICOMP.NE.0) GO TO 225 004801 00490 222 CALL CCSBLK(DEQREC(524),6) 00500 CALL UPDREC( DEQREQ, DEQREC, ISTAT ) 00510 IF (ISTAT.GE.0) GO TO 200 00520 CALL FILERR(DDATA,15,ISTAT,LU) 00530 GO TO 200 005401 00550 225 CONTINUE 00560 INS/ 69 00570 IF(ISTAT.EQ.$8800) GO TO 228 00580 INS/ 73 00590C**************************************************** PSR(05/83) 00600C*** KEY INDEX ERROR - REPORT, THEN CONTINUE PROCESSING 006101 00620 228 CONTINUE 00630C** CALL WTREAD(LU,-1,KYERR,58,0,0,0,ITC) 00640 INS/ 77 00650 IF(ISTAT.EQ.$8010) GO TO 222 00660 END/ 00670*REW,7 00680*K,I7,P21,L14 00690*FTN 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750__ CALL UPDREC( DEQREQ, DEQREC, ISTAT ) 00510 IF (ISTAT.GE.0) GO TO 200 00520 CALL FILERR(DDATA,15,ISTAT,LU) 00530 GO TO 200 005401 00550 225 CONTINUE 00560 INS/ 69 00570 IF(ISTAT.EQ.$8800) GO TO 228 00580 INS/ 73 00590C**************************************************** PSR(05/83) 00600C*** KEY INDEX ERROR - REPORT, THEN CONTINUE PROCESSING 006101 00620 228 CONTINUE 00630C** CALL WTREAD(LU,-1,KYERR,58,0,0,0,ITC) 00640 INS/ 77 00650 IF(ISTAT.EQ.$8010) GO TO 222 00660 END/ 00670*REW,7 00680*K,I7,P21,L14 00690*FTN 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( H$ w-WSDMPFILCCS149 P032883($$TWB.JOB,WEAVE,,DMPFIL,CCS149 00010$$U.DMPFIL,CCS149 00020$$TWFBEND,WEAVE 00030_ __ CALL WTREAD(LU,-1,KYERR,58,0,0,0,ITC) 00640 INS/ 77 00650 IF(ISTAT.EQ.$8010) GO TO 222 00660 END/ 00670*REW,7 00680*K,I7,P21,L14 00690*FTN 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( H+ w-WSEDIT CCS149 P032883($$TWBNJOB,WEAVE,,EDIT,CCS149 00010$$U.EDIT,CCS149 00020$$TWFBEND,WEAVE 00030_ __ CALL WTREAD(LU,-1,KYERR,58,0,0,0,ITC) 00640 INS/ 77 00650 IF(ISTAT.EQ.$8010) GO TO 222 00660 END/ 00670*REW,7 00680*K,I7,P21,L14 00690*FTN 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( H2 w-WSLODFILCCS149 P032883($$TWB.JOB,WEAVE,,LODFIL,CCS149 00010$$U.LODFIL,CCS149 00020$$TWFBEND,WEAVE 00030_ __ CALL WTREAD(LU,-1,KYERR,58,0,0,0,ITC) 00640 INS/ 77 00650 IF(ISTAT.EQ.$8010) GO TO 222 00660 END/ 00670*REW,7 00680*K,I7,P21,L14 00690*FTN 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( H9 w-WSLTPRNTCCS149 P032883($$TWBNJOB,WEAVE,,LTPRNT,CCS149 00010$$U.LTPRNT,CCS149 00020$$TWFBEND,WEAVE 00030_ __ CALL WTREAD(LU,-1,KYERR,58,0,0,0,ITC) 00640 INS/ 77 00650 IF(ISTAT.EQ.$8010) GO TO 222 00660 END/ 00670*REW,7 00680*K,I7,P21,L14 00690*FTN 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( U-  I.QLOAD CCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING QLOAD FROM B.QLOAD, CCS149 FILE 00030*OPEN,FN=B.QLOAD,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,QLOAD,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM QLOAD HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( K+ vWSLTRBLDCCS149 P032883($$TWB.JOB,WEAVE,,LTRBLD,CCS149 00010$$U.LTRBLD,CCS149 00020$$TWFBEND,WEAVE 00030_ __SE 00140*CTO, PROGRAM QLOAD HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( WSTRENDPCCS149 Pd($$TWB.JOB,WEAVE,,TRENDP,CCS149 00010$$TWFTNHOL,RWE,,TRENDP,CCS149 00020$$TWFTNHOL,RWE,,GETSW,CCS149 00030$$TWFTNHOL,RWE,,GTSYSP,CCS149 00040$$TWFTNHOL,RWE,,GETUTI,CCS149 00050$$TWFTNHOL,RWE,,PRTORF,CCS149 00060$$TWFTNHOL,RWE,,GETGRP,CCS149 00070$$TWFTNHOL,RWE,,SYSPRT,CCS149 00080$$TWFTNHOL,RWE,,ICKGRP,CCS149 00090$$TWFTNHOL,RWE,,ICHKZB,RWE 00100$$TWFBEND,WEAVE 00110_ __ 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( WSGETSW CCS149 P999999($$TWBNJOB,WEAVE,,GETSW,CCS149 $$TWFTNHOL,RWE,,GETSW,CCS149 $$TWFBEND,WEAVE __FTNHOL,RWE,,GTSYSP,CCS149 00040$$TWFTNHOL,RWE,,GETUTI,CCS149 00050$$TWFTNHOL,RWE,,PRTORF,CCS149 00060$$TWFTNHOL,RWE,,GETGRP,CCS149 00070$$TWFTNHOL,RWE,,SYSPRT,CCS149 00080$$TWFTNHOL,RWE,,ICKGRP,CCS149 00090$$TWFTNHOL,RWE,,ICHKZB,RWE 00100$$TWFBEND,WEAVE 00110_ __ 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750( WSGTSYSPCCS149 P999999($$TWBNJOB,WEAVE,,GTSYSP,CCS149 $$TWFTNHOL,RWE,,GTSYSP,CCS149 $$TWFBEND,WEAVE __FTNHOL,RWE,,GTSYSP,CCS149 00040$$TWFTNHOL,RWE,,GETUTI,CCS149 00050$$TWFTNHOL,RWE,,PRTORF,CCS149 00060$$TWFTNHOL,RWE,,GETGRP,CCS149 00070$$TWFTNHOL,RWE,,SYSPRT,CCS149 00080$$TWFTNHOL,RWE,,ICKGRP,CCS149 00090$$TWFTNHOL,RWE,,ICHKZB,RWE 00100$$TWFBEND,WEAVE 00110_ __ 00700*EOF 00710*CLOSE 00720*K,I13,L14 00730*Z 00740*Z 00750(z TFTRENDPCCS149 P2( PROGRAM TRENDP 00010 1 /CCS3.0 TREND ANALYSIS REPORT SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/24/84 ************ PROGRAMMER : RWE 000901 00100C REPORT FROM THE AGEWRK FILE. 001101 00120 EXTERNAL FMRDEL,FMEOFC 00130 INTEGER FMRDEL,FDEL,FMEOFC,FEOF 001401 00150 INTEGER DAT1(15),LD1(4),REQ1(24),R1KY(15),REC1(0412) 001601 00170 INTEGER UTFILE(4),SYPFIL(4) 00180 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 001901 00200 EQUIVALENCE ( REQ1(15), NUMRD ) 00210 INTEGER HEAD(18) 002201 00230 DATA HEAD/$0D0A,$0A17,'EXECUTING TRENDP ',$0F16/ 00240 DATA DAT1 /'LAAGEWRK ',00,10,00/,REQ1/24*0/ 002501 00260 DATA LD1/'AGEWRK '/ 002701 00280 INTEGER USER(4),U(8),GRPBUF(10),DATE(3),HDR(20,3) 00290 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF,F1,F2 00300 +, IPAGE,SVTID(2) 00310 +, SVQID(2),IOSW,IQT,MNUPRO(3) 003201 00330 DATA PLU/12/,IPAGE/0/ 00340 +, SVQID/2*$FFFF/,KFLG/0/,IQT/17/,IDUN/0/,IFOUND/0/,I1P/0/ 00350 +, SVTID/2*$FFFF/,IWAY/3/,MNUPRO/'MNUPRO'/,IMODE/3/ 003601 00370 INTEGER STG(36),TEMP(10),A00(6),A01(6) 00380 +, TOT14(7),APAGE(6) 003901 00400 DATA A00 /'000000000000'/, A01 /'000000000001'/ 00410 +, APAGE/'000000000000'/,TOT14/'00000000000000'/ 004201 00430 INTEGER TBL1(6),TBL2(6),IADYS(2,11) 00440 +, BA(6,11,9),BC(6,11,9),TA(6,11,9),TC(6,11,9) 004501 00460 DATA TBL1,TBL2 / 12*'00' / 00470 +, IADYS/' 029 059 089 119 149 179 996 997 998 999 '/ 00480 +, BA,BC,TA,TC/ 2376*'00' / 004901 00500C**** SYSPRT PARAMETERS........ 005101 00520 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 005301 00540 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 00550 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 00560 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 005701 00580 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 005901 00600C**** SCREEN INPUT AND OUTPUT BUFFERS 00610 INTEGER INP(41),MSG01(31),NAA(16),TAA(14),MSGEOF(09) 006201 00630 DATA MSG01/ 'FORMER STATUS CURRENT PAYOFF ' 00640 +, ' ',$1616 / 00650 DATA NAA /' TOTALS '/ 00660 +, TAA /'PRODUCT REPORT TOTALS '/ 00670 +, MSGEOF/'- END OF REPORT - '/ 006801 00690 INTEGER L01(66),L02(66),L03(66),L04(66),L05(66),L06(66),L07(66) 00700 +, L08(66),L13(66),L14(66) 007101 00720C POS. 01 +------------------ THRU ------------------+ 44 00730 DATA L01/'1---------- HDR1 GOES HERE -------------- ' 00740 +, ' DELINQUENT TREND ANALYSIS ' 00750 +, ' AMOUNT PAST DUE PAGE '/ 007601 00770C POS. 01 +------------------ THRU ------------------+ 44 00780 DATA L02/' ---------- HDR2 GOES HERE -------------- ' 00790 +, ' FOR GROUP QUEUE ' 00800 +, ' RUN DATE '/ 008101 00820C POS. 01 +------------------ THRU ------------------+ 44 00830 DATA L03/' ---------- HDR3 GOES HERE -------------- ' 00840 +, ' FROM: TO: ' 00850 +, ' '/ 008601 00870C POS. 01 +------------------ THRU ------------------+ 44 00880 DATA L04/' ' 00890 +, ' ' 00900 +, ' '/ 009101 00920C POS. 01 +------------------ THRU ------------------+ 44 00930 DATA L05/' 00 - 29 30 - 59 60 - ' 00940 +, '89 90 - 119 120 - 149 150 - 179 ' 00950 +, ' 180 + WRITE OFF RELEASED SATISIFIED '/ 009601 00970C POS. 01 +------------------ THRU ------------------+ 44 00980 DATA L06/' ' 00990 +, ' ' 01000 +, ' '/ 010101 01020C POS. 01 +------------------ THRU ------------------+ 44 01030 DATA L07/' ' 01040 +, ' ' 01050 +, ' '/ 01060 01070C POS. 01 +------------------ THRU ------------------+ 44 01080 DATA L08/' ' 01090 +, ' ' 01100 +, ' '/ 011101 01120C POS. 01 +------------------ THRU ------------------+ 44 01130 DATA L13/' NEWLY ADDED 00 - 29 30 - 59 ' 01140 +, ' 60 - 89 90 - 119 120 - 149 15' 01150 +, '0 - 179 180 + PAGE TOTALS '/ 011601 01170C POS. 01 +------------------ THRU ------------------+ 44 01180 DATA L14/' **TRENDP** ERROR IN FILE : XXXXXXXX ' 01190 +, ' RUN ABORTED ********** ' 01200 +, ' '/ 012101 01220C**** 01230C**** BEGIN PROGRAM ....... 012401 01250C**** GET RECORD DELETE CODE AND END OF FILE CODE. 01260 ASSEM $C000,FMRDEL,$6800,FDEL 01270 ASSEM $C000,FMEOFC,$6800,FEOF 012801 01290C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 013001 01310 CALL GETSW( U(1) ) 01320 IF( U(1).EQ.0 ) IQT = 25 01330 CALL PGMIN ( USER,LU,MODE,NPORT ) 013401 01350C*** CCS/LA LOOK-ALIKE..... 013601 01370 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 01380 IF ( ICM.EQ.0 ) GO TO 5 01390 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 01400 5 CONTINUE 014101 01420 CALL CCSMVA( USER,1,8,HEAD,23,8 ) 01430 CALL WTREAD( LU,-1,HEAD,36,0,0,0,ITC ) 01440 CALL UTHEAD( HDR,DATE ) 014501 01460 CALL GTSYSP( IWAY, 33 ) 01470 CALL GTSYSP( IMODE, 34 ) 01480 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01490 CALL GETGRP( GRPBUF,IALL,IMODE ) 015001 01510C**** OPEN FILES AND GET UTIFIL RECORDS 015201 01530 CALL SYSPRT( L01,0,SYSPRM,0 ) 01540 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01550 IF( ISERR.LT.0 ) GO TO 9820 015601 01570 CALL OPENFL( REQ1,DAT1,ISTAT ) 01580 IF ( ISTAT.LT.0 ) GO TO 9800 01590 REQ1(23) = 1 016001 01610C*** MOVE IN HEADERS AND SYSTEM DATE.... 016201 01630 CALL EDIT( DATE,1,L03,120,1 ) 01640C--- CALL CCSTIM( L02(40) ) 01650 CALL CCSMVA( HDR(01,01),1,40,L01,2,40 ) 01660 CALL CCSMVA( HDR(01,02),1,40,L02,2,40 ) 01670 CALL CCSMVA( HDR(01,03),1,40,L03,2,40 ) 01680 IF( U(2).EQ.1 ) CALL CCSMVA( MSG01,15,14,L01,92,16 ) 01690 IF(NPORT.NE.0 .AND. IPF.NE.1) CALL CCSPUT( $0C,1,L01 ) 017001 01710C**** RETRIEVE RECORDS....... AND PROCESS 017201 01730 200 CONTINUE 01740 IOF = 0 01750 CALL GETS( REQ1,REC1,R1KY,ISTAT ) 01760 IF( AND(ISTAT,$100).EQ.$100 ) IOF = 1 01770 IF( AND(ISTAT,$8100).EQ.$8100) GO TO 440 01780 IF( ISTAT.LT.0 ) GO TO 9800 017901 01800 220 CONTINUE 01810 DO 400 J = 1, NUMRD 01820C----- REMEMBER TO ADJUST CALC FOR RECORD SIZE 01830 IP = J *41 -40 018401 01850 IF(REC1(IP).EQ.FDEL) GO TO 400 01860 IF(REC1(IP).EQ.FEOF) GO TO 400 018701 01880C*** CHECK IF OK TO USE THIS ACCOUNT GROUP....... 018901 01900 IF (ICKGRP(GRPBUF,IALL,REC1(IP),1).EQ.1 )GO TO 400 019101 01920 IF( I1P .EQ.0 ) GO TO 260 01930 CALL CCSCST(REC1(IP),IQT,4,SVQID,1,4,IQM) 01940 IF( IQM.NE.0 ) GO TO 260 01950 IF( U(3).EQ.1 ) GO TO 230 01960 CALL CCSCST( REC1(IP),01,01,SVTID,1,4,ICM ) 01970 IF( ICM.NE.0 ) GO TO 260 019801 01990C**** PROCESS RECORD........ 020001 02010 230 CONTINUE 02020 CALL CCSMVA( REC1(IP),IQT,4,SVQID,1,4 ) 02030 CALL CCSMVA( REC1(IP),01, 1,SVTID,1,4 ) 020401 02050 I02 = ICHKZB( REC1(IP),38,3 ) 02060 I04 = ICHKZB( REC1(IP),35,3 ) 02070 IF( I02.EQ.0 .AND. I04.EQ.0 ) GO TO 400 020801 02090 IY = 1 02100 GO TO 250 02110 236 IF( I02.EQ.1 ) GO TO 255 02120 237 CONTINUE 02130 IF( U(2).EQ.0 ) CALL CCSMVA( REC1(IP),59,7,TBL1,4,7 ) 02140 IF( U(2).EQ.1 ) CALL CCSMVA( REC1(IP),41,7,TBL1,4,7 ) 021501 02160 CALL CCSADD( A01,4,BC(1,IX,IY),1,BC(1,IX,IY),1 ) 02170 CALL CCSADD( TBL1,4,BA(1,IX,IY),1,BA(1,IX,IY),1 ) 021801 02190C*** SET LAST RUN PARAMETERS 022001 02210 IX = 1 02220 IF( I02.EQ.0 ) IY = 1 022301 02240 CALL CCSMVA( REC1(IP),59,7,TBL1,4,7 ) 02250 IF( U(2).EQ.1 ) CALL CCSMVA( REC1(IP),41,7,TBL1,4,7 ) 02260 IF( I02 .EQ.1 ) CALL CCSMVA( REC1(IP),68,7,TBL1,4,7 ) 02270 IF(I02.EQ.1.AND.U(2).EQ.1)CALL CCSMVA(REC1(IP),50,7,TBL1,4,7) 022801 02290 CALL CCSADD( A01,4,BC(1,IX,IY),1,BC(1,IX,IY),1 ) 02300 CALL CCSADD( TBL1,4,BA(1,IX,IY),1,BA(1,IX,IY),1 ) 023101 02320 GO TO 400 023301 02340C**** SET INDEX ACROSS 023501 02360 250 CONTINUE 02370 DO 252 IX = 2,11 02380 CALL CCSCST( REC1(IP),35,3,IADYS(1,IX),1,3,ICM ) 02390 IF( ICM.GT.0 ) GO TO 252 02400 GO TO 236 02410 252 CONTINUE 02420 GO TO 236 024301 02440C**** SET INDEX DOWN 024501 02460 255 CONTINUE 02470 DO 257 IY = 2,8 02480 CALL CCSCST( REC1(IP),38,3,IADYS(1,IX),1,3,ICM ) 02490 IF( ICM.GT.0 ) GO TO 257 02500 GO TO 237 02510 257 CONTINUE 02520 GO TO 237 025301 02540C**** OUTPUT HEADER INFO........... 02550 02560 260 CONTINUE 02570 NLINE = 0 02580 IPAGE = IPAGE+1 025901 02600 IF( I1P.GE.2 ) GO TO 265 02610 I1P = I1P + 1 02620 IPAGE = 0 02630 IF( I1P.EQ.2 ) GO TO 230 026401 02650C*** FIRST PAGE PROCESSING... 026601 02670 CALL EDIT( REC1(IP),29,L03,74,1 ) 02680 CALL EDIT( REC1(IP),35,L03,60,1 ) 02690 IF( U(1).EQ.0 ) CALL CCSMVA( TAA,1,7,L02,70,7 ) 02700 GO TO 400 027101 02720 265 CONTINUE 02730 CALL CCSADD( A01,4,APAGE,1,APAGE,1 ) 02740 CALL CCSMVA( APAGE,1,12,TOT14,1,12 ) 02750 CALL EDIT ( TOT14,6,TEMP,1,3 ) 02760 CALL CCSMVA(TEMP,3,5,L01,124,5) 027701 02780 CALL CCSMVA( SVTID,1,1,L02,67,1 ) 02790 CALL CCSMVA( SVQID,1,4,L02,78,4 ) 02800 IF( IDUN.EQ.2 ) CALL CCSMVA( NAA,1,32,L02,56,32 ) 028101 02820 CALL SYSPRT( L01,1,SYSPRM,0 ) 02830 CALL SYSPRT( L02,1,SYSPRM,0 ) 02840 CALL SYSPRT( L03,1,SYSPRM,0 ) 02850 CALL SYSPRT( L04,2,SYSPRM,0 ) 028601 02870 CALL SYSPRT( L05,1,SYSPRM,0 ) 028801 02890 DO 275 M1 = 1,9 02900 DO 270 M2 = 1,11 02910 IP2 = M2 * 12 - 11 02920 IP1 = IP2 + 4 029301 02940 IF( M1.GE.9 ) GO TO 267 02950 CALL CCSADD( BA(1,M2,M1),4,TA(1,M2,M1),1,TA(1,M2,M1),1 ) 02960 CALL CCSADD( BC(1,M2,M1),4,TC(1,M2,M1),1,TC(1,M2,M1),1 ) 029701 02980 CALL CCSADD( BA(1,M2,M1),4,BA(1,M2,9),1,BA(1,M2,9),1 ) 02990 CALL CCSADD( BC(1,M2,M1),4,BC(1,M2,9),1,BC(1,M2,9),1 ) 03000 IF( M1.EQ.8 .AND. M2.LT.11 ) GO TO 267 030101 03020 CALL CCSMVA(A00,1,12,BA(1,1,9),1,12 ) 03030 CALL CCSMVA(A00,1,12,BC(1,1,9),1,12 ) 03040 DO 267 M4 = 2,11 03050 CALL CCSADD( BA(1,M4,9),4,BA(1,1,9),1,BA(1,1,9),1 ) 03060 CALL CCSADD( BC(1,M4,9),4,BC(1,1,9),1,BC(1,1,9),1 ) 030701 03080 267 CONTINUE 03090 CALL EDIT( BA(1,M2,M1),4,TEMP,1,3 ) 03100 CALL CCSMVA( TEMP,1,07,L07,IP2+3,07 ) 03110 CALL CCSMVA( TEMP,11,1,L07,IP2+10,1 ) 031201 03130 CALL CCSMVA( BC(1,M2,M1),1,12,TOT14,1,12 ) 03140 CALL EDIT ( TOT14,6,TEMP,1,3 ) 03150 CALL CCSMVA( TEMP,2,6,L08,IP1,6 ) 03160 270 CONTINUE 03170 IF( M1.EQ.2 ) CALL CCSMVA(MSG01,1,14,L06,2,14) 03180 IF( M1.EQ.2 ) CALL SYSPRT( L06,1,SYSPRM,0 ) 03190 IF( M1.EQ.9 ) CALL SYSPRT( L04,1,SYSPRM,0 ) 03200 M3 = M1 * 14 - 13 03210 CALL CCSMVA( L13,M3,14,L06,2,14 ) 032201 03230 CALL SYSPRT( L06,1,SYSPRM,0 ) 03240 CALL SYSPRT( L07,1,SYSPRM,0 ) 03250 CALL SYSPRT( L08,1,SYSPRM,0 ) 03260 CALL SYSPRT( L04,1,SYSPRM,0 ) 03270 275 CONTINUE 032801 03290C**** ZERO SUB TOTAL ARRAYS 033001 03310 BA = A00 03320 CALL CCSMVA( BA,1,1188,BA,2,1187 ) 03330 CALL CCSMVA( BA,1,1188,BC,1,1188 ) 033401 03350 IF( IDUN.EQ.1 ) GO TO 450 03360 IF( IDUN.EQ.2 ) GO TO 455 03370 GO TO 230 033801 03390 400 CONTINUE 03400 IF( ISERR.LT.0 ) GO TO 9900 03410 IF (IOF.NE.1) GO TO 200 03420 440 CONTINUE 03430 IDUN = 1 03440 GO TO 260 034501 03460C*** SET UP AND PRINT FINAL PAGE OF REPORT..... 034701 03480 450 CONTINUE 03490 IDUN = 2 03500 CALL CCSMVA( TAA,9,14,L13,114,14 ) 03510 CALL CCSMVA( TA,1,1188,BA,1,1188 ) 03520 CALL CCSMVA( TC,1,1188,BC,1,1188 ) 03530 GO TO 260 035401 03550 455 CONTINUE 03560 CALL SYSPRT( L04,03,SYSPRM,0 ) 03570 CALL CCSMVA( MSGEOF,1,18,L04,57,18 ) 03580 CALL SYSPRT( L04,01,SYSPRM,0 ) 03590 GO TO 9900 036001 03610C**** ERROR SECTION FILE 1 03620 9800 CONTINUE 03630 IREQ = AND(REQ1(4),$FF) 03640 IF (IREQ.LT.11) IREQ = IREQ-1 03650 IF (IREQ.EQ.18) IREQ = 10 03660 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 03670 CALL CCSMVA( DAT1,1,8,L14,32,8 ) 03680 IERR = 1 03690 GO TO 9900 037001 03710C**** ERROR SECTION FILE 2 03720 9810 CONTINUE 037301 03740C**** ERROR SECTION FILE 3 03750 9820 CONTINUE 03760 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 03770 IERR = 1 03780 GO TO 9900 037901 03800C**** CLOSE THE FILES AND EXIT........ 03810 9900 CONTINUE 03820 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 038301 03840 CALL CLOSFL( REQ1,ISTAT ) 03850 CALL SYSPRT( L04,0,SYSPRM,1 ) 038601 03870 CALL PGMOUT 03880 END 03890_   __ ( K9 vyWSMHUPDTCCS149 P032883($$TWB.JOB,WEAVE,,MHUPDT,CCS149,LC 00010$$U.MHUPDT,CCS149 00020$$TWFBEND,WEAVE 00030_ __ (Fs FWSJ.PROCCCS149 P999999082384($$TWJ.PROC,,,ACTADD 00010$$TWJ.PROC,,,ACTMTN 00020$$TWJ.PROC,,,AVMCON 00030$$TWJ.PROC,,,CCSDMP 00040$$TWJ.PROC,,,CCSSPC 00050$$TWJ.PROC,,,CHEKID 00060$$TWJ.PROC,,,CHUPD2 00070$$TWJ.PROC,,,CMPACC 00080$$TWJ.PROC,,,COLCHG 00090$$TWJ.PROC,,,COLECT 00100$$TWJ.PROC,,,COLSTS 00110$$TWJ.PROC,,,CPYIND 00120$$TWJ.PROC,,,DALIST 00130$$TWJ.PROC,,,DECMTN 00140$$TWJ.PROC,,,DHUPDT 00150$$TWJ.PROC,,,DMPFIL 00160$$TWJ.PROC,,,FIXINA 00170$$TWJ.PROC,,,LODFIL 00180$$TWJ.PROC,,,LTRBLD 00190$$TWJ.PROC,,,LTRPRT 00200$$TWJ.PROC,,,LTRSTA 00210$$TWJ.PROC,,,MHUPDT 00220$$TWJ.PROC,,,NEWS 00230$$TWJ.PROC,,,NMCHNG 00240$$TWJ.PROC,,,PGGEN 00250$$TWJ.PROC,,,PHDEL1 00260$$TWJ.PROC,,,PHDEL2 00270$$TWJ.PROC,,,PRETSR 00280$$TWJ.PROC,,,PRTSCN 00290$$TWJ.PROC,,,QLOAD 00300$$TWJ.PROC,,,RSWCHG 00310$$TWJ.PROC,,,SRREQ 00320$$TWJ.PROC,,,SUMACL 00330$$TWJ.PROC,,,TIMUSE 00340$$TWJ.PROC,,,TRENDF 00350$$TWJ.PROC,,,TRENDP 00360$$TWJ.PROC,,,TRNPLY 00370$$TWJ.PROC,,,UPD400 00380$$TWJ.PROC,,,UPD500 00390$$TWJ.PROC,,,UPDATE 00400$$TWJ.PROC,,,USEMTN 00410$$TWJ.PROC,,,UTFMTN 00420$$TWJ.PROC,,,WRTOFE 00430$$TWJ.PROC,,,WRTOFP 00440_  __ ( K@ vyWSNEWS CCS149 P032883($$TWB.JOB,WEAVE,,NEWS,CCS149 00010NEWS DCK/ I,H 00020$$TWFBEND,WEAVE 00030_ __ __ ( KG vyWSPRETSRCCS149 P032883($$TWB.JOB,WEAVE,,PRETSR,CCS149 00010$$U.PRETSR,CCS149 00020$$TWFBEND,WEAVE 00030_ __ __ (R{ nWSPRTSCNCCS149 P032883($$TWB.JOB,WEAVE,,PRTSCN,CCS149 00010$$U.PRTSCN,CCS149 00020PRNTIT DCK/ I,H 00030$$TWFBEND,WEAVE 00040_ __ __ ( R nWSQLOAD CCS149 P032883($$TWB.JOB,WEAVE,,QLOAD,CCS149 00010$$U.QLOAD,CCS149 00020$$TWFBEND,WEAVE 00030_ __ __ __ ( R nU.SUMACLCCS149 P032883(SUMACL DCK/ I,H 00010 DEL/ 2 00020 1 /C20 F CCS CCS 3.0 .LA - PSRD SL-149 00030 INS/ 28 00040C ****************************************************** ???*A011 00050C 00060C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00070 INTEGER FDEL 00080 EXTERNAL FMRDEL 00090C ******************************************************* ???*A011 00100 DEL/ 34 00110 INTEGER IDAT(4) 00120 DATA IDAT /'DELQMST '/ 00130 DATA IDATA/'LADLQMST',8*$2020,1,7,0/ 00140 INS/ 43 00150 CALL CCSCST(IDATA,1,2,ID,1,8,ICM) 00160 IF(ICM.NE.0) CALL CCSMVA(IDAT,1,8,IDATA,1,8) 00170 INS/ 44 00180C ****************************************************** ???*A011 00190C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00200 ASSEM $C000,FMRDEL,$6800,FDEL 00210C ****************************************************** ???*A011 00220C 00230 INS/ 80 00240C ****************************************************** ???*A011 00250C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00260 CALL CCSCST(RECBUF,IW,2,FDEL,1,2,ICOMP) 00270 IF(ICOMP.EQ.0) GO TO 250 00280C ****************************************************** ???*A011 00290_ __ INTEGER FDEL 00080 EXTERNAL FMRDEL 00090C ******************************************************* ???*A011 00100 DEL/ 34 00110 INTEGER IDAT(4) 00120 DATA IDAT /'DELQMST '/ 00130 DATA IDATA/'LADLQMST',8*$2020,1,7,0/ 00140 INS/ 43 00150 CALL CCSCST(IDATA,1,2,ID,1,8,ICM) 00160 IF(ICM.NE.0) CALL CCSMVA(IDAT,1,8,IDATA,1,8) 00170 INS/ 44 00180C ****************************************************** ???*A011 00190C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00200 ASSEM $C000,FMRDEL,$6800,FDEL 00210C ****************************************************** ???*A011 00220C 00230 INS/ 80 00240C ****************************************************** ???*A011 00250<\k #eB.TIMUSECCS149 x999999042784< P TIMUSE CCS3.0 TIME USAGE REPORT SL-XXX @P@P @P@P$@P @PF( @P܁@PE@P@P<@PJ& 3)@-1L5R9X=^Adj|:@Pc,!@P %6';+8@P@P/K@P@PUTIFIL SYSPRT @P EXECUTING TIMUSE @PLATRNSFLLA  @P@PLACOLSTSLA  @P@P@PTRNSFL @PCOLSTATS@P6 @P;@PdEND ALL @P}@P8@PjMNUPRO@P9@Pm000000000000AARR@P000000000000000000000001000000000000000000000000@P000000000000@P00000000000000@P@P TOTAL ACCOUNTS WORKED : - END OF REPORT - @P1---------- HDR1 GOES HERE -------------- TIME USAGE REPORT @P PAGE @P4 @P7 ---------- HDR2 GOES HERE -------------- AS OF:  @Pb @Pv @Py ---------- HDR3 GOES HERE --------------  @P @P @P  @P @P @P COLLECTOR: QUEUES:  @P( @P< @P? ACCOUNT START STOP ELAP NEXT ACT RES LTR  @Pj @P~ @P NUMBER TIME TIME TIME CONTACT CDE CDE CDE COMMENT  @P @P @P : : :  @P @P @P ********************************************************************@P0************************** @PD @PG TOTAL ACCOUNTS TIME: :  @Pr @P @P **TIMUSE** ERROR IN FILE : XXXXXXXX RUN ABORTED **********  @P @P @P!Th p8 0Ȉ 0 @P0HTTh@P:@P:hhT57T T\\@PeT5TT8\9T678T:9T@P '\ "T " d/\ " d@PT7\\ 7\!y  7 T @PdT@1̹ l̲ܜ̫ " d'"$ d@P?   d ?hT:@P6 Ӏ ?hTI@PBh ; hTTVT\@PmGp4d,ddXdYXd\G lT \G@P d dm\} ހ?h\@Ph dܑ?h\@PhTh<~ "~ T\h<\<\<@PTd<\<\<\<\<\<@P\<\<\<\<TT\@PE\\T\7\y\} \@Pp\\?\\@PM@P 2ހ?h T@@Pm ?h ?h T@P@P@P@P@Pۀ?h\@PmT7 dŀ?hT@P\̵?h\@P̪ ?hT@P  T ̒?h\@P?h\@P    \\?hT@P#  ݀?h\@P.  Ҁ?h\@P9uǀ?h\@PD xTux l \  ll\@Po̒?h\@Py?h\@P?h\@P ?hT!@PTS d d\{ \h€?h %l\@P\  Tפ 8 " d\\@PT\ l 1T " +\@P T l\̷ l 1T̝ "  l 2@P F@P H@P H@P: H@P H@P L@P L "  @P X@P, X@P X@P X d} NW@Pl c@P c\\T\T\\@P \\J@P @P @P d # l  lT5T  d (@P @P l # l  l\5\ l @P @P @P \ l \T\Th<~T TTPTIMUSEPQ8STP Q8PKUP6Q8PREP3FMRDEL;FMEOFC?MOD "PGMIN CCCSCSTCCSMVA WTREADlUTHEADvGTSYSPzPRTORFGETGRPPSYSPRT OPENFLEDIT rCCSPUTGETS ICKGRP2CCSADDGETUTI CCSGETTIMDIFJREADR UPDREC WRITER 5FILERR PCLOSFL PGMOUT PTIMUSE PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVA0 MT3 ]T33E] > (3Th H3 1T3\ A M30 > M\3; A@P0,  A\33 > C3 C\33 = = 03 C\ >33 C C3T 4 ?33 > >3\  30 > >\3;  >@P0W >T A\33 > M >0 XT30̫ ̦ &\33 I 1\̝ 13T38̓@P0 ̍ 3&\ J3 1\T0 VT3 (3T L3 1T3T >3; P > P@PHMPADDIT PCCSMVACCSPUT PUTS FILERRUPDENDCCSADDDFORMLNZWRITERdREADR |CCSBLKUPDRECP PCHNGNF B24 F CCS CCS 3.0 SL-149@P@P1@P4@P@P0@PN@Pl1@PE@P(,@P!@P$@P'@P*@P-@P0 @P5 , h h hTȷ \Ȫ t\@P`Ȟ  l@Pn hh hȻ!" ( hʓ !ȏ谚 Ȩf dؚ@P 5h !0 2. d3 h hT@P@P  h\4@P4 \5H2TThbhmhhhh\hZheh\hVhjh\h@PQheh\hIhJhRh\hhhh\ha'PCHNGNFPQ8PKUPQ8PREPAMONTO:ADAYTO>AYERTOBCCSCSTECCSMVAP P [ CONUPD 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  C =3 = 2 2 70 ژ(0T h\hȞ #Ț dhȗhT 0 >h\@Pr hȍ(Έh 1 *T >33 Q > Qx hȴ!& ( h @P !ȥhȡh ȝhT@P@P =ؐ3\ R33 R 2̒ A 4TH33 C =3 = 2 2 &\33 C3 C\@P3 > M]3 > MT0 ]T3E] >00 (Th30 H 1TT33 R 0 RH>PCONUPDPCCSCSTICCSAD[ICALJLlCCSMVACHNGNFCCSPUTPUTS FILERRUPDENDP P [COSUPD B33 F CCS CCS 3.0 SL-149@P@P@P@P@PY@PT3 R =3 = 2 2 \13 R30 = = 2 \3 R =3 = 2 YT3; > M@P00 > N\11 ?T33g  (T630 I 1T 10/ *T@P3[g0  3&\6 J3 1\\11 ?T30g &\630 L 1\@PH|PCOSUPDPCCSCSTCCSMVA+WRITER:FILERRIUPDENDOREADR ZUPDRECuP P [ FORMLN B53 F CCS CCS 3.0 SL-149@PWRITEOFF @PRELEASE @P$SATISFY @P6ADD @PHUPDATE @PZREACTIVATE @PlREJECT - ACCOUNT NOT ACTIVE FOR 30X @P~REJECT - NO ACCOUNT FOR 30X CODE @PREJECT - INVALID TRANSACTION CODE @P ,,hT@P3 > S 3 ? S\33 > @ A03 @\ A33 M F M 1? #  )\33 R Q8 R @P3\ 33 R Q R % !3T 30 > >\33  ?03 @\ 30 ? @ 3\ 3 > >\@P3 ?0 @ HTThŀPFORMLNPQ8PKUPQ8PREPCCSMVAEDIT P P [FUPDAT B56 F CCS CCS 3.0 SL-149@PTTT0 TTTT33 > @ - >3 @ 2 2 \33 > @ +30 > @ 2  \@P3+ > @ )30 > @ 2 'T0 T300 13T L3 1\ lT 43; ? > @PV >T0 o\33 > @ / >3 @ 2̶  T F3\ 4 ? 30 > >\0 W TTTTT@P33̻ 3'\ I3 1T \ 70 3 T\\\3\̝ &\3; L 1@P\\ T\\\T3= '3TG L3 1\\0 9H/PFUPDATPUPINITLABHANNXTRANTOTALP UPDENDGETMASCCSCSTRSWIT 6UPDRECFILERRCCSADDPPRTLINXFORMLNgUNCUPDyPCONUPD{ADDIT }COSUPDWRITERUPDIT REACITP P [GETMAS B58 F CCS 3.0 09-22-81 SL-149@P@P,@P.@P UPDATE WAITING ACCT. NO. @P'.L@P)@P/T33 A M > >0 MT30 >00 0  (T33 J 1T 5@P0Z /ެ  d0-T31 A M) M+Ⱥ \31 A M) M\* R'0 RT 1@P,(,- lT.HPGETMASPCCSMVA0READR 8FILERRMUPDENDSCCSCSThWTREADCCSBLKP P [LABHAN B67 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT   T3 @ hT3 > Wz0 W 1\@P \3 @ h3T lHPLABHANPNXTRANTAPMOTCCSMVACLOSFLP P [LNXTRAN B85 F CCS CCS 3.0 SL-149@P@P@P1h T300 1'0 T30 K 1T dT 1 @P. T0T h  l @P0< T =HPNXTRANHPSTATIT2GETS FILERRUPDEND"FREAD (DISP 0CCSE2AAP P [PRTLIN C09 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T 4 ?33 > > d [@P05 d0 \ hT [ T 9 [ؿ 10 T1 Z3 T;\  Z@P3` \\ _13 Z \T30 @0 (T3 H0 1T0 &̞ l \@P3 Z0 \3\ Z0 \3\ ?0 &3\ H0 1\̥ \13 Z 8\\@P0 >̺ &\30 H 1\T Z H TThhh4PPRTLINPQ8PKUPQ8PREPCCSADD*CCSGET33 C C3\ = =10 L\3; = =@P00 GT CT33 4 ? >3 >\33  > 03 >\ 33 > >3\ > M30 > XT308@P[  (T3 I0 1T 1/T30  3&\ J3 1\T8 VT@P30 &3\ L0 1\T33 > P 3 > P " 9 0X :l3T 3 ;\3; > M= >@P M\ 33 > A= N0 ATGGdIHdJ0dK\33  > IL3 > I\ "33 > UR >0 YT%38= >@P (3Tb H3 1Th 3\= >0 &3\ H0 1\HPREACITPCCSPUT CCSMVAFORMLN3CCSADD6WRITERSFILERRUPDENDREADR nCCSBLKUPDRECPUTACFCCSTIMPUTS P P [kRSWIT C16 F CCS CCS 3.0 SL-149@P@PWRS@P999 @P998 @P997 @P @P @P - ACCOUNT NOT IN ACCAGE @P0  d0T E0  3  l\ D0HhlT3; C@P0E  C 0(π h  (ʀ hT 4 ?@PV >@PX > ( Vh 0( Vh\ @Pg >@Pi > ( hh 0( hh\ @Px >@Pz > ( Dh 0( Dh\ @P >@P >\33 F 0 F\\33 M3 > M\31  > 03 ?\ 3 C C3Tw3 > (T@P3 H0 1TT3@ M30 > > MT3 >0  1ݤ0  \3; J 1@P\\ 33 > O >0 OyT3 &\33 M 10\d00 \33  A 0; A\ @P3 @ 03 @\ 33 F  F3\  F30  F\33  A3  A $h\@P3- > @3  @T33  F3  F\33  F 03 F\ 33 A  AހhT@P0O T3 >00 (T30 H 1T@P%c@P2c@PcHPRSWIT fPFORMLN"CCSMVA3CCSADDRPUTS RFILERR\UPDENDbREADR DELRECCCSPUTMP P [TOTALP 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 D C3 > C\ 3 D C >03 C\ D13 Cb > C3\ D C0 > C\39 D C@P0 > C\31 D C.3 > C\ 3 D Cr >0 C h h D(hT@Pȵ  D(hT 9@Pا 1ء 1T1 A3 ? @\ 13 A" ? @1\ Af3 ? @\ 13 A ? @1\ A)3 ? @\ @P, Am ?03 @\ P A0 ? @\3 V A ?03 @\ J A09 ? @\3 Au >03 @\ t A0 > @\3 z A >0; @\ n A@P3WA > @1\ A|3 > @\ b13 A > @1\ h A3 > @\ \13 AH > @ d D,hT@P} 1H"PTOTALPPCCSMVACCSGETCCSPUTEDIT  PRTLIN{P P [UNCUPD C31 F CCS CCS 3.0 SL-149@P @P@P@P!@Pkk@@PE@P@Pkk@P qq@P#ww @P& @P) @P,@P/ @P2 @P5@P8@P;@P>@PA@PD@PG@PJ@PM(@PP@PS@PV@PY@P\@P_@PbT 33 > C 0 C h!( ( hʝ ʘ !hހhڀ hր@P h\@P@P0 1\ > >T0\ >1 >\1HPUNCUPDPCCSMVAcCCSPYTP P [Q8QBDS C46 F CCS CCS 3.0 SL-149@P8 :01@P0 ;0360@P8@P8 3 @P0 000000000000@P0 000000000000@P8 @P0 - ACCOUNT ALREADY IN ACCAGE @P0  CO HOST @P8 9 @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 40000000001@P0 000000000000@P0 000000000000@P0 000000000000@P0 000000000000000000000000000000000000@P0 000000000000@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 Q@P8 R@P8 S#@P8 T(@P8 U7@P8 VB@P8 WP@P8 XR@P8 Y`@P8 Z@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 [sUPDEND 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 ATHPUPDENDoPCLOSFLTAPMOTgPGMOUTkP P [.UPDIT C48 F CCS CCS 3.0 SL-149@PT33  > 03 >\ 33 > >3\  30 > >\33  >3 >\ 433 ? > 0 >T B@P+HPUPDIT *PCCSADDFORMLN%P P [UPINIT C49 F CCS CCS 3.0 SL-149@P@P T 1d0 d 0d T3 > ~3 ? >T33 > C 3 > C 8"d @P4h h "p8n (h 1 T3 (T33 @ 1 T @P_  \30 .\30 @ 1\  d 3\X &\33X @ 13\\ 0 &@P3\ @3 1\\30g6̽ &\630 @ 1\3\Eh̰ &\33h @ 13\\w0̣ &;\ @@P 1\\30̖ &\30 @ 1\3TM00 (TV30 @ 1T0\ "0 9 #;\%@P &3\ @0 1\\3 .٤  \30 @ 1\0 d dT330 F8¤ @P ̽0 ̸ &\X30 J 1\ B, hT'0; B T@P0% ? T0 G 1\300 H̖ 0  (T3X J0 1T03 H h/T2@P0P$ G)d T3 > M\30 >   &\30 J 1\  8 d@P|HPUPINIT~PAMONTOADAYTOAYERTOPGMIN EDIT CCSMVA OPENFLFILERR@UPDENDFREADR ICCSADNCCSBLKVP __ [UPINIT C49 F CCS CCS 3.0 SL-149@P( B  I.ACTADDCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING ACTADD FROM B.ACTADD, CCS149 FILE 00030*OPEN,FN=B.ACTADD,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,ACTADD,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM ACTADD HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190____ [UPINIT C49 F CCS CCS 3.0 SL-149@PC ****************************************************** ???*A011 00250(/ WSGETUTICCS149 P999999($$TWBNJOB,WEAVE,,GETUTI,CCS149 $$TWFTNHOL,RWE,,GETUTI,CCS149 $$TWFBEND,WEAVE __N,FN=B.ACTADD,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,ACTADD,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM ACTADD HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190____ [UPINIT C49 F CCS CCS 3.0 SL-149@PC ****************************************************** ???*A011 00250( WSLTRPRTCCS149 P($$TWB.JOB,WEAVE,,LTRPRT,CCS149 00010$$TWFTNHOL,RWE,,LTRPRT,CCS149 00020$$TWFTNHOL,RWE,,GTSYSP,CCS149 00030$$TWFTNHOL,RWE,,GETUTI,CCS149 00040$$TWFTNHOL,RWE,,PRTORF,CCS149 00050$$TWFTNHOL,RWE,,GETGRP,CCS149 00060$$TWFTNHOL,RWE,,SYSPRT,CCS149 00070$$TWFTNHOL,RWE,,ICKGRP,CCS149 00080$$TWFBEND,WEAVE 00090_ ____ [UPINIT C49 F CCS CCS 3.0 SL-149@PC ****************************************************** ???*A011 00250(d ( 2*J.UTFMTNCCS149 P(*JOB,,TWB.JOB UTFMTN INSTALL 08/23/84 00010*K,L14 00020*CTO, UTFMTN WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.UTFMTN , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.UTFMTN,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120UTFMTN DCK/ I,H 00130 DEL/ 2 00140 1 /F51 F CCS CCS 3.1 LKL07 02-84 SL-149 00150 DEL/ 70 00160 DATA CS / $1820 / 00170 INS/ 158 00180C ADD 'HOST,TRND,LTR3&4 RECORDS TO UTIFIL AND MAKE THEM PROTECTED... 00190 DATA KEY18 / 'LTR3' , -1, 0 / 00200 DATA KEY19 / 'LTR4' , -1, 0 / 00210 DATA KEY20 / 'HOST' , 0, 2 / 00220 DATA KEY21 / 'TRND' , 0, 2 / 00230 DATA KEY22 / '** ' , 0, 0 / 00240 DEL/ 162,166 00250C **** 00260 DEL/ 236,243 00270 100 CALL CCSBLK( INBUF, 76 ) 00280 CALL WTREAD( LU, -1, INOPER, 74, -1, INBUF, 76, TC ) 00290C ** CHECK FOR RUBOUT IF IT IS REPEAT REQUEST. 00300 IF ( TC.EQ.04 ) GO TO 100 00310C ** CHECK IF NO CHARS ENTERED 00320 IF ( INCHAR.EQ.0 ) GO TO 900 00330 DEL/ 258,262 00340 125 CALL CCSBLK( INBUF, 76 ) 00350 CALL WTREAD( LU, -1, INKEY, 38, -1, INBUF,76, TC ) 00360 IF ( TC.EQ.04 ) GO TO 125 00370 CALL CCSMVA( INBUF,1,4,KEY,1,4 ) 00380 DEL/ 424,425 00390 900 PGINOU(19) = $4F55 00400 PGINOU(20) = $5420 00410 END/ 00420*REW,7 00430*K,I7,P21,L14 00440*FTN 00450*EOF 00460*CLOSE 00470*K,I13,L14 00480*Z 00490*Z 00500__**** 00260 DEL/ 236,243 00270 100 CALL CCSBLK( INBUF, 76 ) 00280 CALL WTREAD( LU, -1, INOPER, 74, -1, INBUF, 76, TC ) 00290C ** CHECK FOR RUBOUT IF IT IS REPEAT REQUEST. 00300 IF ( TC.EQ.04 ) GO TO 100 00310C ** CHECK IF NO CHARS ENTERED 00320 IF ( INCHAR.EQ.0 ) GO TO 900 00330 DEL/ 258,262 00340 125 CALL CCSBLK( INBUF, 76 ) 00350 CALL WTREAD( LU, -1, INKEY, 38, -1, INBUF,76, TC ) 00360 IF ( TC.EQ.04 ) GO TO 125 00370 CALL CCSMVA( INBUF,1,4,KEY,1,4 ) 00380 DEL/ 424,425 00390 900 PGINOU(19) = $4F55 00400 PGINOU(20) = $5420 00410 END/ 00420*REW,7 00430*K,I7,P21,L14 00440*FTN 00450*EOF 00460*CLOSE 00470*K,I13,L14 00480*Z 00490*Z 00500(gTp 5n+J.VFYACFCCS149 P032883(*JOB,, VFYACF INSTALL 03/16/83 00010*K,L14 00020*CTO, VFYACF WEAVED AS OF 03/16/83 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BNVFYACF, CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BNVFYACF,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120VFYACF DCK/ I=13,H 00130VFYACF HOL/ 00140 SUBROUTINE VFYACF(BUF) 00150 1 /ROUTINE TO VERIFY ACTIVITY BLOCK LENGTH 001602 00170C REVISED 08/05/82 00180C THIS ROUTINE VERIFIES THE LENGTH PORTION OF THE ON-LINE ACTIVITY 00190C BLOCK. IF THE LENGTH EXCEEDS 360 OR CONTAINS AN INVALID CHAR, 00200C THEN THE BLOCK IS BLANKED OUT. 002101 00220 INTEGER BUF(1) 002302 00240C SKIP TEST IF BLOCK IS BLANK 00250 IF(BUF(154).EQ.$2020.AND.BUF(155).EQ.$2020) GO TO 15 002601 00270C VERIFY THAT ALL CHAR OF LENGTH ARE NUMERICS. 00280 DO 10 I = 1,4 00290 CALL CCSGET(BUF(154),I,J) 00300 IF(J.LT.$30.OR.J.GT.$39) GO TO 20 00310 IF(I.EQ.1.AND.J.NE.$30) GO TO 20 00320 10 CONTINUE 003301 00340C VERIFY LENGTH DOES NOT EXCEED MAX OF 360 00350 I = AND(BUF(154),$F) * 100 + ICCSAD(BUF(155)) 00360 IF (I.GT.360) GO TO 20 00370 15 RETURN 003801 00390C ERROR - CLEAR BLOCK & CONTINUE 00400 20 CALL CCSBLK(BUF(154),360) 00410 RETURN 00420 END 00430 END/ 00440 END/ 00450*REW,7 00460*K,I7,P21,L14 00470*FTN 00480*EOF 00490*CLOSE 00500*K,I13,L14 00510*Z 00520*Z 00530__ DO 10 I = 1,4 00290 CALL CCSGET(BUF(154),I,J) 00300 IF(J.LT.$30.OR.J.GT.$39) GO TO 20 00310 IF(I.EQ.1.AND.J.NE.$30) GO TO 20 00320 10 CONTINUE 003301 00340C VERIFY LENGTH DOES NOT EXCEED MAX OF 360 00350 I = AND(BUF(154),$F) * 100 + ICCSAD(BUF(155)) 00360 IF (I.GT.360) GO TO 20 00370 15 RETURN 003801 00390C ERROR - CLEAR BLOCK & CONTINUE 00400 20 CALL CCSBLK(BUF(154),360) 00410 RETURN 00420 END 00430 END/ 00440 END/ 00450*REW,7 00460*K,I7,P21,L14 00470*FTN 00480*EOF 00490*CLOSE 00500( r?TFSRREQ CCS149 P032883( PROGRAM SRREQ 00010 1 /XXX F CCS CCS 3.0 .LA PSR 02/83 SL-149 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 00040C CYBERCREDIT SYSTEM 00050C 000601 00070C THIS PROGRAM HANDLES THE SUPERVISOR REQUESTS INSTEAD OF IN 00080C TIMUSE. IT IS EXECUTED IN LD/M 000901 00100 INTEGER LU,MODE,ID(4),PORT 001101 00120 INTEGER IOBUF(41),XYN,TC,COMPIN,ISTAT 00130 DATA XYN/-1/ 001401 00150 INTEGER SR(2),BLANK(2),COID(2),SRID(2),ACTREC 00160 DATA SR/'SR '/,BLANK/' '/,ACTREC/'01'/ 001701 00180 INTEGER ERRMSG(50),ERRLEN 00190 DATA ERRLEN/100/ 00200 DATA ERRMSG / 00210 1 $D0A,'THE RECORD FOR COLLECTOR IS NOT IN THE UTILITY FI 00220 2LE',$D0A,'THIS SR REQUEST WILL NOT BE PROCESSED ',$D0A/ 002301 00240 INTEGER DDATA(15),TDATA(15),UDATA(15),NUMREC,MAXREC 00250 DATA DDATA/'LADLYWRK',8*$2020,0,1,0/ 00260 DATA TDATA/'LATRNSFL',8*$2020,0,10 ,0/ 00270 DATA UDATA/'LAUTIFIL',8*$2020,1,1,1/ 002801 00290 INTEGER DLYREQ(24),TRNREQ(24),UTIREQ(24) 00300 DATA DLYREQ/24*0/,TRNREQ/24*0/,UTIREQ/24*0/ 003101 00320 INTEGER DLYWRK(20),TRNREC(690),UTIREC(40) 00330 DATA DLYWRK/20*$2020/,TRNREC/690*$2020/,UTIREC/40*$2020/ 003401 00350C EQUIVALENCES FOR NUMBER OF RECORDS RETRIEVED PER 'GETS' 00360C REQUEST FROM TRANSACTION FILE AND MAXIMUM NUMBER OF RECORDS 00370C TO RETRIEVE 00380 EQUIVALENCE (NUMREC,TDATA(15)) 00390 EQUIVALENCE (MAXREC,TRNREQ(15)) 004001 00410 INTEGER AMONTO,ADAYTO,AYERTO,DATE(3) 00420 EXTERNAL AMONTO,ADAYTO,AYERTO 004301 00440C RETRIEVE SYSTEM DATE 00450 DATE(1) = AND($FFFF,AMONTO) 00460 DATE(2) = AND($FFFF,ADAYTO) 00470 DATE(3) = AND($FFFF,AYERTO) 004801 00490C BEGIN PROCESSING 005001 00510 CALL PGMIN(ID,LU,MODE,PORT) 00520 CALL CCSCST(DDATA,1,2,ID,1,8,ICM) 00530 IF(ICM.EQ.0) GO TO 5 00540 CALL CCSMVA(DDATA,3,6,DDATA,1,8) 00550 CALL CCSMVA(TDATA,3,6,TDATA,1,8) 00560 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00570 5 CONTINUE 005801 00590C OPEN FILES 00600 50 CALL OPENFL(UTIREQ,UDATA,ISTAT) 00610 IF(ISTAT.GE.0) GO TO 100 00620 CALL FILERR(UDATA,3,ISTAT,LU) 00630 GO TO 900 006401 00650 100 CALL OPENFL(TRNREQ,TDATA,ISTAT) 00660 IF(ISTAT.GE.0) GO TO 150 00670 CALL FILERR(TDATA,3,ISTAT,LU) 00680 GO TO 900 006901 00700C**** FIRST CLEAR THE DLYWRK FILE 007101 00720 150 CONTINUE 00730 CALL CLEAR(DLYREQ,DDATA,ISTAT) 00740 DO 151 I = 1,24 00750 151 DLYREQ(I) = 0 007601 00770 CALL OPENFL(DLYREQ,DDATA,ISTAT) 00780 IF(ISTAT.GE.0) GO TO 200 00790 CALL FILERR(DDATA,3,ISTAT,LU) 00800 GO TO 900 008101 00820C READ THE TRANSACTION FILE BLOCK 00830 200 CALL GETS(TRNREQ,TRNREC,TRNREC,ISTAT) 00840 IF(AND(ISTAT,$8100).EQ.$8100) GO TO 800 00850 IF(ISTAT.GE.0) GO TO 250 00860 CALL FILERR(TDATA,14,ISTAT,LU) 00870 GO TO 900 008801 00890C PROCESS THE BLOCK 00900 250 DO 700 I = 1, MAXREC 009101 00920 J = 138*I-137 009301 00940C SEE IF THIS WAS AN ACTION RECORD 00950 CALL CCSCST(TRNREC,J+28,2,ACTREC,1,2,COMPIN) 00960 IF(COMPIN.NE.0) GO TO 700 009701 00980C SEE IF IT WAS A SUPERVISOR REQUEST 00990 CALL CCSCST(TRNREC,J+36,2,SR,1,2,COMPIN) 01000 IF(COMPIN.NE.0) GO TO 700 010101 010201 01030C READ THE UTILITY FILE RECORD WITH COID TO GET SUPERVISOR 01040 260 CALL CCSMVA(TRNREC,J+16,4,COID,1,4) 01050 CALL READR(UTIREQ,UTIREC,COID,ISTAT) 01060 IF(AND(ISTAT,$100).EQ.$100.OR.ISTAT.EQ.$200) GO TO 300 01070 IF(ISTAT.GE.0) GO TO 270 01080 CALL FILERR(UDATA,13,ISTAT,LU) 01090 GO TO 800 011001 01110C FOUND RECORD LOOK FOR SUPERVISOR 01120 270 CALL CCSMVA(UTIREC, 37 ,4,SRID,1,4) 01130 CALL CCSCST(SRID,1,4,BLANK,1,4,COMPIN) 01140 IF(COMPIN.EQ.0) CALL CCSMVA(SR,1,4,SRID,1,4) 011501 01160C NOW BUILD DLYWRK FILE 01170 CALL CCSMVA(TRNREC,J,16,DLYWRK,1,16) 01180 CALL CCSMVA(SRID,1,4,DLYWRK,17,4) 01190 CALL CCSMVA(DATE,1,6,DLYWRK,21,6) 01200C IS COMPLETE WRITE IT AND GO GET NEXT RECORD 01210 CALL PUTS(DLYREQ,DLYWRK,1,ISTAT) 01220 IF(ISTAT.GE.0) GO TO 290 01230 CALL FILERR(DDATA,11,ISTAT,LU) 01240 GO TO 900 012501 01260 290 CALL CCSBLK(DLYWRK,40) 01270 GO TO 700 012801 01290C ERROR ON READING THE COLLECTOR ID IN UTILITY FILE-REPORT IT 01300C AND CONTINUE 01310 300 CALL CCSMVA(TRNREC,J+16,4,ERRMSG,28,4) 01320 CALL WTREAD(LU,XYN,ERRMSG,ERRLEN,0,0,0,TC) 013301 01340 700 CONTINUE 013501 01360C ALL TRANSACTIONS FROM THIS BLOCK PROCESSED, CHECK IF THIS IS 01370C THE LAST BLOCK FROM TRANSACTION FILE, IF NOT GET NEXT BLOCK 01380 710 GO TO 200 013901 01400C LAST BLOCK PROCESSED CLOSE FILES AND EXIT 01410 800 CALL CLOSFL(UTIREQ,ISTAT) 01420 CALL CLOSFL(TRNREQ,ISTAT) 01430 CALL CLOSFL(DLYREQ,ISTAT) 014401 01450 900 CALL PGMOUT 01460 END 01470_ __ 01260 290 CALL CCSBLK(DLYWRK,40) 01270 GO TO 700 012801 01290C ERROR ON READING THE COLLECTOR ID IN UTILITY FILE-REPORT IT 01300C AND CONTINUE 01310 300 CALL CCSMVA(TRNREC,J+16,4,ERRMSG,28,4) 01320 CALL WTREAD(LU,XYN,ERRMSG,ERRLEN,0,0,0,TC) 013301 01340 700 CONTINUE 013501 01360C ALL TRANSACTIONS FROM THIS BLOCK PROCESSED, CHECK IF THIS IS 01370C THE LAST BLOCK FROM TRANSACTION FILE, IF NOT GET NEXT BLOCK 01380 710 GO TO 200 013901 01400C LAST BLOCK PROCESSED CLOSE FILES AND EXIT 01410 800 CALL CLOSFL(UTIREQ,ISTAT) 01420 CALL CLOSFL(TRNREQ,ISTAT) 01430 CALL CLOSFL(DLYREQ,ISTAT) 014401 01450 900 CALL PGMOUT 01460 END 01470_ ( F J.COLSTSCCS149 P(*JOB,,TWB.JOB COLSTS INSTALL 08/23/84 00010*K,L14 00020*CTO, COLSTS WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.COLSTS , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.COLSTS,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120COLSTS DCK/ I=13,H 00130COLSTS HOL/ 00140 PROGRAM COLSTS 00150 1 /CCS3.0 COLLECTOR STATISTICS REPORT SL-XXX 001601 00170C** CYBERCREDIT FINANCIAL SERVICES. 00180C** CYBERCREDIT FIELD SUPPORT GROUPS 00190C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00200C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00210C** 00220C** ************ 04/30/84 ************ PROGRAMMER : RWE 002301 00240C**** PROGRAM DESCRIPTION : 002501 00260C THE COLLECTOR STATISTICS REPORT PROCESSOR PRINTS A REPORT OF THE 00270C ACTIONS & RESULTS CODE ACTIVITY ON A DAILY, WEEKLY OR MONTHLY 00280C BASIS. IT MAY ALSO ZERO OUT THE DAILY OR WEEKLY ACTIVITY 00290C COUNTS AS REQUESTED VIA THE RPG SWITCH. IT USES THE FILE 'UTIFIL' 00300C TO ACQUIRE THE ACTION AND RESULT CODES AND THE COLLECTOR NAMES 00310C AND INITIALS. IT PROCESSES THE FILE 'COLSTATS' WHICH HAS BEEN 00320C PREVIOUSLY GENERATED OR UPDATED BY THE TIME USAGE PROCESSOR. 003301 00340C THE RPG SWITCH IS USED TO DETERMINE WHICH PROCESSING IS TO BE 00350C DONE AS FOLLOWS: 00360C - DAILY COLLECTOR STATISTICS REPORT (U1 ON) 00370C - WEEKLY COLLECTOR STATISTICS REPORT (U2 ON) 00380C - MONTHLY COLLECTOR STATISTICS REPORT (U3 ON) 00390C - ZERO THE DAILY COUNTS (U4 ON) 00400C - ZERO THE WEEKLY COUNTS (U5 ON) 00410C ( NOTE - THE MONTHLY COUNTS ARE ZEROED BY CLEARING THE 'COLSTATS' 00420C FILE IN THE PROCEDURE STREAM) 004301 00440C THE REPORTS PRINT THE COLLECTOR STATISTICS FROM THE VARIOUS 00450C ACTION AND RESULTS CODES COUNT. THERE IS MAXIMUM 32 CODES EACH. 00460C ONLY 16 CODES ARE PRINTED ON A LISTING PAGE. THUS IF THE SYSTEM H 00470C MORE THAN 16 CODES DEFINED, THE REPORT PAGE CONSISTS OF TWO LISTIN 00480C PAGES. COLLECTOR TOTALS ARE PRINTED ONLY ON THE SECOND PAGE IN TH 00490C CASE. THE TWO PAGES ARE NUMBERED A & B. 00500C ACCURACY IS AS FOLLOWS: 00510C TOTAL EACH CODE - 4 DIGITS 00520C COLLECTOR TOTALS- 6 DIGITS 00530C CODE TOTALS - 6 DIGITS 00540C GRAND TOTAL - 6 DIGITS 005501 00560 INTEGER BYPASS,CNTNDX,CODE,CODEX,CODSUM(32),CODSUL(32) 00570 +, COLSUM(128),COLSUL(128),COLID(2),COUNT(128,32) 00580 +, INAME(9,128),ZEROS(2) 005901 00600 INTEGER DAILY(3),MONTHY(4),WEEKLY(3),ACTC(2),RESC(2) 00610 +, EORMSG(11),GOTHDR,GRANDM,GRANDL,TOTL(3),IASCII(3) 00620 +, ICNT(4),IVAL,IVAL2,JCNT,KEYCOL(4),NOCODE 00630 +, PAGE,PAGEAB,PRT,RECUTI(40),RESULT(4) 00640 +, OCOLID(2),UTKEY(2),UTCODB(40),UTCODE(32) 006501 00660 EQUIVALENCE ( UTCODE,UTCODB(3) ) 006701 00680 DATA DAILY/'DAILY '/,MONTHY/'MONTHLY '/,WEEKLY/'WEEKLY'/ 00690 +, TOTL/'TOTALS'/,RESULT/'RESULTS '/ 00700 +, ACTC/'ACTC'/,RESC/'RESC'/ 00710 +, BYPASS/0/,KEYCOL/4*0/,NOCODE/32/,ZEROS/'0000'/ 00720 DATA EORMSG/'*** END OF REPORT ***'/ 007301 00740 INTEGER HDLIN5(66),HDLINX(66),HDLN6A(66),HDLN6B(66) 007501 00760 DATA HDLIN5/33*$2020,'ACTIONS ',29*$2020/ 00770 +, HDLINX/66*$2020/ 00780 +, HDLN6A/' COLLECTOR NAME ',58*$2020/ 00790 +, HDLN6B/' COLLECTOR NAME ',55*$2020,'TOTAL '/ 008001 00810 INTEGER DAT1(15),LD1(4),REQ1(24),REC1(0012) 008201 00830 INTEGER UTFILE(4),SYPFIL(4) 00840 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 008501 00860 EQUIVALENCE ( REQ1(15), NUMRD ) 00870 INTEGER HEAD(18) 008801 00890 DATA HEAD/$0D0A,$0A17,'EXECUTING COLSTS ',$0F16/ 00900 DATA DAT1 /'LACOLSTSLA ',01,01,00/,REQ1/24*0/ 009101 00920 DATA LD1/'COLSTATS'/ 009301 00940 INTEGER USER(4),U(8),GRPBUF(10),DATE(3),HDR(20,3) 00950 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 00960 +, IPAGE,MTOT(6),LTOT(6),TOT14(7),TEMP(8) 009701 00980 DATA PLU/12/,IPAGE/0/,MTOT/'000000000000'/ 00990 +, IFOUND/0/,LTOT/'000000000000'/ 01000 +, IWAY/3/,IMODE/3/,TOT14/'00000000000000'/ 010101 01020C**** SYSPRT PARAMETERS........ 010301 01040 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 010501 01060 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 01070 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 01080 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 010901 01100 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 011101 01120 INTEGER L01(66),L02(66),L03(66),L04(66),L14(66) 011301 01140C POS. 01 +------------------ THRU ------------------+ 44 01150 DATA L01/'1---------- HDR1 GOES HERE -------------- ' 01160 +, ' COLLECTOR STATISTICS REPORT ' 01170 +, ' PAGE '/ 011801 01190C POS. 01 +------------------ THRU ------------------+ 44 01200 DATA L02/' ---------- HDR2 GOES HERE -------------- ' 01210 +, ' AS OF: ' 01220 +, ' '/ 012301 01240C POS. 01 +------------------ THRU ------------------+ 44 01250 DATA L03/' ---------- HDR3 GOES HERE -------------- ' 01260 +, ' ' 01270 +, ' '/ 012801 01290C POS. 01 +------------------ THRU ------------------+ 44 01300 DATA L04/' ' 01310 +, ' ' 01320 +, ' '/ 01330C POS. 01 +------------------ THRU ------------------+ 44 01340 DATA L14/' **COLSTS** ERROR IN FILE : XXXXXXXX ' 01350 +, ' RUN ABORTED ********** ' 01360 +, ' '/ 01370. 013801 01390C**** 01400C**** BEGIN PROGRAM ....... 014101 01420C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 014301 01440 CALL GETSW ( U(1) ) 01450 CALL PGMIN ( USER,LU,MODE,NPORT ) 014601 01470C*** CCS/LA LOOK-ALIKE..... 014801 01490 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 01500 IF ( ICM.EQ.0 ) GO TO 5 01510 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 01520 5 CONTINUE 015301 01540 CALL CCSMVA( USER,1,8,HEAD,23,8 ) 01550 CALL WTREAD( LU,-1,HEAD,36,0,0,0,ITC ) 01560 CALL UTHEAD( HDR,DATE ) 015701 01580 CALL GTSYSP( IWAY, 17 ) 01590 CALL GTSYSP( IMODE, 18 ) 01600 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01610 CALL GETGRP( GRPBUF,IALL,IMODE ) 016201 01630C ..CHECK SWITCH SETTING 01640C .. NOTE - ONLY FIRST BIT SET IN SWITCH IS PROCESSED. 016501 01660 DO 110 IU = 1,3 01670 IF (U(IU) .EQ. 1) GO TO 100 01680 110 CONTINUE 016901 01700 DO 120 IU = 4,5 01710 IF (U(IU) .EQ. 1) GO TO 700 01720 120 CONTINUE 017301 01740C .. NO SWITCHES SET, EXIT. 01750 GO TO 9900 017601 01770C**** OPEN FILES AND GET UTIFIL RECORDS 017801 01790 100 CONTINUE 01800 CALL SYSPRT( L01,0,SYSPRM,0 ) 01810 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01820 IF( ISERR.LT.0 ) GO TO 9820 018301 01840 CALL OPENFL( REQ1,DAT1,ISTAT ) 01850 IF ( ISTAT.LT.0 ) GO TO 9800 01860 REQ1(23) = 1 018701 01880 CALL EDIT( DATE,1,L02,70,1) 01890C--- CALL CCSTIM( L02(40) ) 01900 CALL CCSMVA( HDR(01,01),1,40,L01,2,40 ) 01910 CALL CCSMVA( HDR(01,02),1,40,L02,2,40 ) 01920 CALL CCSMVA( HDR(01,03),1,40,L03,2,40 ) 01930 IF(NPORT.NE.0 .AND.IPF.NE.1) CALL CCSPUT( $0C,1,L01 ) 019401 01950C ..SET FOR PROCESSING ACTION CODE REPORT (ACTC) 019601 01970 130 CONTINUE 01980 IBYTE = 8+(IU-1)*4 019901 02000 CALL CCSMVA( ACTC ,1,4,UTKEY,1,4 ) 02010 140 CALL GETUTI( UTKEY,UTCODB,IFOUND,IFER,0 ) 02020 IF( IFER.LT.0 ) GO TO 9820 02030 IF( IFOUND.NE.0 ) GO TO 9820 020401 02050C ..CLEAR COUNT MATRIX AND COLLECTOR TOTALS 02060 DO 230 I = 1,128 02070 DO 225 J = 1,32 02080 COUNT(I,J) = 0 02090 225 CONTINUE 02100 COLSUM(I) = 0 02110 COLSUL(I) = 0 02120 230 CONTINUE 021301 02140C ..INITIALIZE GRAND TOTAL 02150 GRANDL = 0 02160 GRANDM = 0 02170C ..SET COLLECTOR INDEX = 0 (INITIALIZATION) 02180 ICOLX = 0 02190 CALL CCSMVA( INAME,1,0,INAME,1,40 ) 022001 02210C .. BEGIN PROCESSING OF COLSTATS RECORD 02220C ..READ COLSTATS RECORD (UNLESS PREVIOUS REC. NOT PROCESSED YET) 02230 235 IF (BYPASS .NE. 0) GO TO 240 02240 CALL GETS ( REQ1, REC1, KEYCOL, ISTAT) 02250C ..CHECK FOR EOF 02260 IF (AND(ISTAT,$8100) .EQ. $8100) GO TO 300 02270 IF( ISTAT.LT.0 ) GO TO 9800 02280C ..CHECK FOR CHANGE IN CODE TYPE(ACTION TO RESULT); GO 02290C .. PRINT REPORT. 02300 240 IF (AND(REC1,$FF00) .NE. AND(UTKEY,$FF00)) GO TO 300 02310C ..CLEAR BYPASS READ OF COLSTATS RECORD FLAG 02320 BYPASS = 0 02330C ..IF ICOLX(COLLECTOR INDEX) = 0(FIRST TIME) 02340C .. DO NOT CHECK FOR NEW COLLECTOR 02350 IF (ICOLX .NE. 0) GO TO 245 02360C ..FIRST TIME PROCESSING 02370C .. SET UP COLLECTOR ID 02380 CALL CCSMVA (REC1, 2, 4, COLID, 1, 4) 02390C ..SET COLLECTOR INDEX TO FIRST 02400 ICOLX = 1 02410C ..GO GET NAME,INITIAL FOR FIRST COLLECTOR 02420 GO TO 255 02430C ..IF NO CHANGE IN COLLECTOR, BYPASS PROCESSING FOR 02440C .. LAST COLLECTOR 02450 245 CALL CCSMVA (REC1, 2, 4, COLID, 1, 4) 02460 IF (COLID(1) .EQ. OCOLID(1) .AND. COLID(2) .EQ. OCOLID(2)) 02470 1 GO TO 260 02480C ..NEW COLLECTOR LOGIC 02490C ..SUM COLLECTOR CODES OF LAST COLLECTOR 02500 ASSIGN 250 TO IRTN 02510 GO TO 980 02520C ..BUMP COLLECTOR INDEX 02530 250 ICOLX = ICOLX + 1 02540C ..GET COLLECTOR NAME, INITIAL FROM UTIFIL FILE. 025501 02560 255 CALL GETUTI( COLID,RECUTI,IFOUND,IFER,0 ) 02570 IF( IFER.LT.0 ) GO TO 9820 02580 IF( IFOUND.NE.0 ) CALL CCSMVA( COLID,1,4,RECUTI,5,4 ) 025901 02600C ..SAVE NAME AND INITIAL 02610 CALL CCSMVA (RECUTI, 5, 15, INAME(1,ICOLX), 3, 16) 02620 CALL CCSMVA (RECUTI, 20, 1, INAME(1,ICOLX), 1, 2) 02630C ..UPDATE CURRENT COLLECTOR ID 02640 OCOLID(1) = COLID(1) 02650 OCOLID(2) = COLID(2) 02660C ..SEARCH CODE ARRAY FOR MATCHING CODE TO GENERATE INDEX 02670C .. FOR COUNT STORE IN COUNT MATRIX 02680 260 CALL CCSMVA (REC1, 6, 2, CODE, 1, 2) 02690 DO 270 I = 1,NOCODE 02700 IF (UTCODE(I) .EQ. CODE) GO TO 280 02710 270 CONTINUE 02720C ..IF NO CODE FOUND, IQNORE COLSTATS RECORD 02730 GO TO 295 02740C ..CALC. CODE INDEX TO COUNT MATRIX 02750 280 CONTINUE 02760 CODEX = I 027701 02780C ..REMOVE FROM RECORD FOR PROCESSING 02790 CALL CCSMVA (REC1, IBYTE, 4, ICNT, 1, 4) 02800C ..CONVERT TO HEX 02810 JCNT = (AND(ICNT(1),$0F00)/$100) * 10 02820 JCNT = (JCNT + AND(ICNT(1),$F)) * 10 02830 JCNT = (JCNT + (AND(ICNT(2),$0F00))/$100) * 10 02840 JCNT = JCNT + AND(ICNT(2),$F) 02850C ..ADD TO COUNT MATRIX 02860 COUNT(ICOLX,CODEX) = COUNT(ICOLX,CODEX) + JCNT 02870C ..ADD TO GRAND TOTAL 02880C .. (2 WORD ARITHMETIC MODULE 10**4) 02890 GRANDL = GRANDL + JCNT 02900 IF (GRANDL .LT. 10000) GO TO 290 02910 GRANDM = GRANDM + 1 02920 GRANDL = GRANDL-10000 02930 290 CONTINUE 02940C .. END OF PROCESSING OF ONE COLSTATS RECORD 02950 295 GO TO 235 02960C ..SUM LAST COLLECTOR'S CODES 02970 300 CONTINUE 02980 IF( ICOLX.EQ.0 ) ICOLX = 1 02990 ASSIGN 305 TO IRTN 03000 GO TO 980 030101 03020C ..BEGIN CODE TOTALS PROCESSING 03030C ..CALC. CODES TOTALS(2 WD ARITHMETIC MODULO 10**4) 03040 305 DO 320 I=1,NOCODE 03050 CODSUL(I) = 0 03060 CODSUM(I) = 0 03070 DO 310 J = 1,ICOLX 03080 CODSUL(I) = CODSUL(I) + COUNT(J,I) 03090 IF (CODSUL(I) .LT. 10000) GO TO 310 03100 CODSUM(I) = CODSUM(I) + 1 03110 CODSUL(I) = CODSUL(I)-10000 03120 310 CONTINUE 03130 320 CONTINUE 031401 03150C ..BEGIN REPORT GENERATION AND PRINT 03160 400 CONTINUE 031701 03180C ..SET UP TYPE REPORT PER U1,U2,U3 03190 422 GOTO (430, 440, 450), IU 03200 430 CALL CCSMVA (DAILY, 1, 5, L01, 55, 5) 03210 GO TO 460 03220 440 CALL CCSMVA (WEEKLY, 1, 6, L01, 54, 6) 03230 GO TO 460 03240 450 CALL CCSMVA (MONTHY, 1, 7, L01, 53, 7) 03250C ..RESET PAGE COUNTER 03260 460 PAGE = 0 03270C ..MOVE IN 'RESULTS' TEXT IF RESULT REPORT 03280 IF (UTKEY .NE. $5245) GO TO 470 03290 CALL CCSMVA (RESULT, 1, 7, HDLIN5, 67, 7) 03300C ..SET UP FIRST 16 CODES 03310 470 DO 480 I = 1,16 03320 J = I*2 - 1 03330 JJ = 26 + (I-1)*6 03340 CALL CCSMVA (UTCODE, J, 2, HDLN6A, JJ, 2) 03350 480 CONTINUE 03360C ..BLANK FIELD FOR 'TOTAL' TEXT 03370 CALL CCSMVA(I, 1, 0, HDLN6A, 127, 5) 03380C .. NOTE - EACH PAGE OF REPORT MAY CONSIST OF 1 OR 2 LISTING 03390C .. PAGES. IF TWO PAGES, THEY ARE CALLED PAGE A & B. 03400C ..INITIALIZE PAGE TYPE(A OR BLANK IF 1 LISTING PAGE) 03410C .. (DOUBLE * IS USED TO INDICATE FIRST NON-CODE ENTRY) 03420 PAGEAB = $2020 03430 IF (UTCODE(17) .NE. $2A2A) PAGEAB = $4120 03440C ..IF MORE THAN 16 CODES, SET UP 2ND 16 CODES 03450 IF (PAGEAB .EQ. $2020) GO TO 494 03460 DO 490 I = 17,32 03470 J = I*2 -1 03480 JJ = 26 + (I-17)*6 03490 CALL CCSMVA (UTCODE, J, 2, HDLN6B, JJ, 2) 03500 490 CONTINUE 03510 GO TO 500 03520C ..MOVE 'TOTAL' TEXT FOR COLLECTOR TOTALS HEADING 03530 494 CALL CCSMVA (TOTL, 1, 5, HDLN6A, 127, 5) 03540C ..INITIALIZE INDICIES TO COUNT MATRIX 03550 500 ICOLX = 0 03560C 03570C .. BEGIN PRINT PAGE LOGIC 03580C ..SAVE ICOLX(COLLECTOR INDEX) FOR PAGE B PROCESSING 03590 505 ICOLXV = ICOLX 03600C ..BUMP PAGE COUNT 03610 PAGE = PAGE + 1 03620 IVAM = 0 03630 IVAL = PAGE 03640 ASSIGN 507 TO IRTN2 03650 GO TO 990 036601 03670C*** PRINT HEADER LINES 1-5. RESENT LINE COUNT, SET PAGE TYPE. 036801 03690 507 CONTINUE 03700 CALL CCSMVA (IASCII, 3, 4, L01, 125, 4) 03710 510 CALL CCSMVA (PAGEAB, 1, 1, L01, 129, 1) 03720 ICOLX = ICOLXV 03730 LNCNT = 0 03740 ASSIGN 520 TO IRTN 03750 GO TO 900 03760C ..PRINT HEADER LINES 6,7 PER PAGE TYPE (A OR B) 03770 520 ASSIGN 530 TO IRTN 03780 IF (PAGEAB .EQ. $4220) GO TO 904 03790 GO TO 902 03800C ..BUMP COLLECTOR INDEX 03810 530 ICOLX = ICOLX + 1 03820C ..CHECK FOR END 03830 IF (ICOLX .GT. 128) GO TO 550 03840C ..CHECK FOR ANY CODES; IF NONE, GO TO NEXT COLLECTOR 03850 IF (COLSUM(ICOLX) .EQ. 0 .AND. COLSUL(ICOLX) .EQ. 0) GO TO 530 03860C ..PRINT 1 LINE OF COLLECTOR ACTIVITY 03870 ASSIGN 535 TO IRTN 03880 IF (PAGEAB .EQ. $2020) GO TO 908 03890 IF (PAGEAB .EQ. $4220) GO TO 910 03900 GO TO 906 03910C ..BUMP LINE COUNT (DOES NOT INCLUDE HEADER LINES) 03920 535 LNCNT = LNCNT + 1 03930C ..CHECK FOR ENOUGH LINES THIS PAGE 03940 IF (LNCNT .LE. 40) GO TO 530 03950C 03960C ..END OF PAGE PROCESSING 03970C ..IF SINGLE PAGE PER CODES, GO START NEXT PAGE OF REPORT 03980 IF (PAGEAB .EQ. $2020) GO TO 505 03990C ..FOR TWO PAGES PER CODES, SET TO PAGE B OR GO START 04000C .. NEW REPORT PAGE 04010 IF (PAGEAB .EQ. $4120) GO TO 540 04020 PAGEAB = $4120 04030 GO TO 505 04040 540 PAGEAB = $4220 04050 GO TO 510 04060C ..PRINT TOTALS LINE 04070C ..IF SINGLE PAGE PER CODES, PRINT TOTALS & EXIT 04080 550 IF (PAGEAB .NE. $2020) GO TO 560 04090C ..PRINT TOTALS FOR SINGLE PAGE PER CODES, SET RETURN TO 04100C .. END REPORT PRINTING 04110 ASSIGN 570 TO IRTN 04120 GO TO 930 04130C ..FOR TWO PAGES PER CODES, 04140C ..PRINT TOTALS PAGE A, SET RETURN FOR PAGE B 04150C ..OR PRINT TOTALS PAGE B, SET RETURN TO END REPORT PRINTING 04160 560 ASSIGN 570 TO IRTN 04170 IF (PAGEAB .EQ. $4220) GO TO 940 04180 ASSIGN 540 TO IRTN 04190 GO TO 920 04200C ..IF THIS WAS ACTION REPORT, SET TO PROCESS RESULTS REPORT 04210 570 IF (UTKEY(1) .NE. $4143) GO TO 580 04220C ..SET FOR PROCESSING RESULTS REPORT(RESC) 042301 04240 CALL CCSMVA( RESC,1,4,UTKEY,1,4 ) 042501 04260 BYPASS = 1 04270 GO TO 140 04280C ..PRINT 'END OF REPORT' LINE, SET RETURN TO EXIT 04290 580 ASSIGN 9900 TO IRTN 04300 GO TO 970 04310C 04320C ..END OF REPORT LOGIC 04330. 04340C ..BEGIN CLEAR COUNT LOGIC 04350C 04360C ..OPEN COLSTATS FILE 043701 04380 700 CONTINUE 04390 DAT1(13) = 0 04400 DAT1(14) = 400 04410 DAT1(15) = -1 04420 CALL OPENFL ( REQ1, DAT1 , ISTAT) 04430 IF (ISTAT .LT. 0) GO TO 9800 044401 04450 710 CALL GETS ( REQ1,COUNT,KEYCOL,ISTAT ) 044601 04470 IF( AND( ISTAT,$8100).EQ.$8100 ) GO TO 9900 04480 IF( ISTAT.LT.0 ) GO TO 9800 044901 04500C ..CLEAR COUNTS PER SWITCH(U4,U5); IU = 4,5 04510 720 J = REQ1(15) 04520 JJ = 8 + (IU-4)*4 - 20 04530 DO 730 I = 1,J 04540 JJ = JJ + 20 04550 CALL CCSMVA (ZEROS, 1, 4, COUNT, JJ, 4) 04560 730 CONTINUE 045701 04580 CALL UPDREC ( REQ1,COUNT,ISTAT ) 04590 IF (ISTAT .LT. 0) GO TO 9800 046001 04610 GO TO 9900 04620. 04630C .. PSEUDO SUBROUTINES 04640C 04650C ..PRINT HEADER LINES 1-5 04660 900 CONTINUE 04670 CALL SYSPRT( L01,1,SYSPRM,0 ) 04680 CALL SYSPRT( L02,1,SYSPRM,0 ) 04690 CALL SYSPRT( L03,1,SYSPRM,0 ) 04700 CALL SYSPRT( L04,1,SYSPRM,0 ) 04710 CALL SYSPRT( HDLIN5,1,SYSPRM,0 ) 04720 GO TO IRTN 047301 04740C ..PRINT LINES 6,7 PAGE A 04750 902 CALL SYSPRT( HDLN6A,1,SYSPRM,0 ) 04760 GO TO 905 047701 04780C ..PRINT LINE 6,7 PAGE B 04790 904 CALL SYSPRT( HDLN6B,1,SYSPRM,0 ) 04800 905 CALL SYSPRT( L04,1,SYSPRM,0 ) 04810 GO TO IRTN 048201 04830C ..PRINT 1 LINE OF COLLECTOR STATISTICS 04840C ..ENTRY FOR PAGE A 04850C ..BLANK FILL COLLECTOR TOTAL FIELD 04860 906 CALL CCSMVA (I, 1, 0, HDLINX, 127, 5) 04870 IB = 1 04880 GO TO 914 04890C .. ENTRY FOR SINGLE PAGE REPORT PAGE 04900 908 IB = 1 04910 GO TO 912 04920C .. ENTRY FOR PAGE B 04930 910 IB = 17 04940C ..CONVERT & STORE COLLECTOR TOTAL 04950 912 CONTINUE 04960 IVAM = COLSUM(ICOLX) 04970 IVAL = COLSUL(ICOLX) 04980 ASSIGN 913 TO IRTN2 04990 GO TO 990 050001 05010 913 CONTINUE 05020 CALL CCSMVA( IASCII,01,06,HDLINX,126,06 ) 050301 05040 914 CONTINUE 050501 05060C ..CONVERT COUNTS & STORE IN LINE 05070 ASSIGN 915 TO IRTN2 05080 DO 916 I = 1,16 05090 IF( UTCODE(IB).EQ.$2A2A ) GO TO 916 05100 IVAM = 0 05110 IVAL = COUNT(ICOLX,IB) 05120C ..CONVERT 05130 GO TO 990 05140 915 JX = 24 + (I-1)*6 05150 CALL CCSMVA (IASCII, 3, 4, HDLINX, JX, 4) 05160 IB = IB + 1 05170 916 CONTINUE 05180C ..MOVE INITIAL, NAME TO LINE 05190 CALL CCSMVA (INAME(1,ICOLX), 1, 17, HDLINX, 2, 17) 05200C ..PRINT LINE 05210 CALL SYSPRT( HDLINX,1,SYSPRM,0 ) 05220 GO TO IRTN 052301 05240C ..PRINT TOTALS LINE LOGIC 05250C .. ENTRY FOR PAGE A (NO GRAND TOTAL) 05260C ..BLANK FILL GRAND TOTAL FIELD 05270 920 CALL CCSMVA (I, 1, 0, HDLINX, 126, 6) 05280 IB = 1 05290 GO TO 960 05300C .. ENTRY FOR SINGLE PAGE REPORT PAGE 05310 930 IB = 1 05320 GO TO 950 05330C .. ENTRY FOR PAGE B 05340 940 IB = 17 053501 05360C ..PLACE GRAND TOTAL IN LINE 053701 05380 950 CONTINUE 05390 IVAM = GRANDM 05400 IVAL = GRANDL 05410 ASSIGN 955 TO IRTN2 05420 GOTO 990 054301 05440 955 CONTINUE 05450 CALL CCSMVA( IASCII,1,6,HDLINX,126,6 ) 054601 05470C ..MOVE 'TOTALS' TEXT TO LINE 05480 960 CALL CCSMVA (TOTL , 1, 00, HDLINX, 1, 22) 05490 CALL CCSMVA( TOTL , 1, 06, HDLINX,14, 06 ) 055001 05510C ..CONVERT TOTAL & STORE IN LINE 05520 DO 965 I = 1,16 05530 JX = 22 + (I-1)*6 05540 IF( UTCODE(IB).EQ.$2A2A ) GO TO 965 05550 IVAM = CODSUM(IB) 05560 IVAL = CODSUL(IB) 05570 ASSIGN 962 TO IRTN2 05580 GO TO 990 055901 05600 962 CONTINUE 05610 CALL CCSMVA (IASCII, 1, 6, HDLINX, JX, 6) 05620 IB = IB + 1 05630 965 CONTINUE 056401 05650 CALL SYSPRT( L04,1,SYSPRM,0 ) 05660 CALL SYSPRT( HDLINX,1,SYSPRM,0 ) 056701 05680 CALL CCSMVA( HDLINX,1,0,HDLINX,1,132 ) 05690 GO TO IRTN 057001 05710C ..PRINT 'END OF REPORT' LINE 05720 970 CALL CCSMVA (EORMSG, 1, 21, HDLINX, 59, 21) 05730 CALL SYSPRT( L04,5,SYSPRM,0 ) 05740 CALL SYSPRT( HDLINX,1,SYSPRM,0 ) 05750 GO TO IRTN 057601 05770C ..SUM COLLECTOR'S CODES(2 WD ARITMETIC MODULO 10**4) 05780 980 COLSUM(ICOLX) = 0 05790 COLSUL(ICOLX) = 0 05800 DO 982 I2 = 1,NOCODE 05810 COLSUL(ICOLX) = COLSUL(ICOLX) + COUNT(ICOLX,I2) 05820 IF (COLSUL(ICOLX) .LT. 10000) GO TO 982 05830 COLSUM(ICOLX) = COLSUM(ICOLX) + 1 05840 COLSUL(ICOLX) = COLSUL(ICOLX)-10000 05850 982 CONTINUE 05860 GO TO IRTN 058701 05880C ..CONVERT 'IVAL' TO 'ASCII' WITH ZERO SUPPRESSION 05890 990 CONTINUE 05900 CALL HXDEC( IVAM,MTOT(2) ) 05910 CALL HXDEC( IVAL,LTOT(4) ) 059201 05930 CALL CCSADD( MTOT,4,LTOT,1,TOT14,1 ) 05940 CALL EDIT ( TOT14,6,TEMP,1,3 ) 05950 CALL CCSMVA( TEMP,2,6,IASCII,1,6 ) 059601 05970 GO TO IRTN2 059801 05990C**** ERROR SECTION FILE 1 06000 9800 CONTINUE 06010 IREQ = AND(REQ1(4),$FF) 06020 IF (IREQ.LT.11) IREQ = IREQ-1 06030 IF (IREQ.EQ.18) IREQ = 10 06040 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 06050 CALL CCSMVA( DAT1,1,8,L14,32,8 ) 06060 IERR = 1 06070 GO TO 9900 060801 06090C**** ERROR SECTION FILE 3 06100 9820 CONTINUE 06110 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 06120 IERR = 1 06130 GO TO 9900 061401 06150C**** CLOSE THE FILES AND EXIT........ 06160 9900 CONTINUE 06170 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 061801 06190 CALL CLOSFL( REQ1,ISTAT ) 06200 CALL GETUTI( UTKEY,REC1,IFOUND,IFER,2 ) 06210 CALL SYSPRT( L04,0,SYSPRM,1 ) 062201 06230 CALL PGMOUT 06240 END 06250 END/ 06260GETSW DCK/ I=13,H 06270GETSW HOL/ 06280 SUBROUTINE GETSW ( U ) 06290 1 /CCS3.0 SUBROUTINE GETSW SL-XXX 063001 06310C** CYBERCREDIT FINANCIAL SERVICES. 06320C** CYBERCREDIT FIELD SUPPORT GROUPS 06330C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 06340C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 06350C** 06360C** ************ 04/06/84 ************ PROGRAMMER : RWE 063701 06380C**** PROGRAM DESCRIPTION : RETRIEVE RPG EXTERNAL SWITCH SETTINGS 063901 06400C*** CALLING SEQUENCE : CALL GETSW( U ) 064101 06420C PARAMETERS 064301 06440C U : AN 8 WORD ARRAY, WHERE EACH WORD CORRESPONDS 06450C TO AN RPG EXTERNAL SWITCH 06460C RPG ARRAY 06470C U1 = U(1) 06480C U2 = U(2) 06490C ETC... 06500C RETURNED VALUES ARE 0 = SWITCH IS OFF, 1 = SWITCH IS ON 065101 06520 INTEGER U(1),I,J,SWITCH 065301 06540C**** 06550C**** BEGIN PROGRAM ....... 065601 06570C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 065801 06590 ASSEM $C400,$00E3,$6800,SWITCH 066001 06610 J = 2 066201 06630C*** CRACK THE SWITCHS 066401 06650 DO 100 I = 1,8 06660 U(I) = AND( SWITCH,J )/J 06670 J = J*2 06680 100 CONTINUE 06690 RETURN 06700 END 06710 END/ 06720GTSYSP DCK/ I=13,H 06730GTSYSP HOL/ 06740 SUBROUTINE GTSYSP( IPARM,IPOS ) 06750 1 /CCS3.0 SUBROUTINE GTSYSP SL-XXX 067601 06770C** CYBERCREDIT FINANCIAL SERVICES. 06780C** CYBERCREDIT FIELD SUPPORT GROUPS 06790C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 06800C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 06810C** 06820C** ************ 04/06/84 ************ PROGRAMMER : RWE 068301 06840C**** PROGRAM DESCRIPTION : GET SYSTEM PARAMETER FROM THE 06850C EXTERNAL FLAG RECORD IN THE UTIFIL. 068601 06870C*** CALLING SEQUENCE : CALL GTSYSP( IPARM,IPOS ) 068801 06890C PARAMETERS 069001 06910C IPARM : RETURNED VALUE ($0 TO $F WHICH IS 0 TO 15 DECIMAL) 06920C WHICH IS RETRIEVED FROM THE 'EXTERNAL FLAG RECORD' 06930C IN THE UTIFIL. 06940C IPOS : THE STARTING BYTE OF THE FLAG IN THE FLAG RECORD. 06950C ( SEE LAYOUT OF 'EXTERNAL FLAG RECORD' ) 069601 06970C EXAMPLE : CALL GTSYSP( IMODE,30 ) 06980C THIS WOULD RETRIEVE THE FLAG 2 FOR THE 06990C LTRSTA PROGRAM AND SET THE IMODE FLAG FOR 07000C SUBROUTINE GETGRP 07010C LTRSTA FLAGS START IN POS. 29, THERE ARE 4 FLAGS 07020C FLAG 1 = IWAY FOR SUBROUTINE PRTORF 07030C FLAG 2 = IMODE FOR SUBROUTINE GETGRP 07040C FLAG 3 = 07050C FLAG 4 = 070601 07070 INTEGER IPARM,IPOS 07080 +, SYSREC(42),SYSP(2),IGOT 070901 07100 DATA SYSP /'SYSP'/, IGOT / 0/ 071101 07120C**** 07130C**** BEGIN PROGRAM ....... 071401 07150 IF ( IGOT.NE.0 ) GO TO 100 07160 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 07170 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 07180 IGOT = 1 071901 07200 100 CONTINUE 07210 CALL CCSGET( SYSREC,IPOS,IFLG ) 072201 07230 IPARM = AND( IFLG,$F ) 07240 RETURN 07250 END 07260 END/ 07270GETUTI DCK/ I=13,H 07280GETUTI HOL/ 07290 SUBROUTINE GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 07300 1 /CCS3.0 SUBROUTINE GETUTI SL-XXX 073101 07320C** CYBERCREDIT FINANCIAL SERVICES. 07330C** CYBERCREDIT FIELD SUPPORT GROUPS 07340C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 07350C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 07360C** 07370C** ************ 04/06/84 ************ PROGRAMMER : RWE 073801 07390C**** PROGRAM DESCRIPTION : RETRIEVE RECORD BY KEY FROM UTIFIL. 074001 07410C*** CALLING SEQUENCE : CALL GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 074201 07430C PARAMETERS 074401 07450C KEYB : KEY OF UTIFIL RECORD TO BE RETRIEVED ( 2 WORDS ) 07460C REC : BUFFER TO RECIEVE THE RETRIEVED RECORD(40 WORDS ) 07470C BUFFER WILL BE BLANKS IF RECORD IS NOT FOUND. 07480C IFOUND : RETURNED VALUE DESIGNATING IF RECORD WAS FOUND. 07490C 0 = RECORD FOUND , 1 = RECORD NOT FOUND 07500C IFER : ISTAT OF FILE MANAGER CALL. (FROM UTIFIL) 07510C NOPT : PASSED. OPTION OF WHAT TO DO. 07520C 0 = RETRIEVE RECORD (LEAVE FILE OPEN) 07530C 1 = RETRIEVE RECORD (CLOSE FILE WHEN DONE) 07540C 2 = CLOSE FILE. 075501 07560 INTEGER KEYB(1),REC(1),IFOUND,IFER,NOPT 07570 +, DAT1(15),REQ1(24),R1KY(15),REC1(0042) 07580 +, USER(4),LU,NPORT,MODE 075901 07600 DATA DAT1 /'LAUTIFIL ',01,01,00/,REQ1/24*0/ 07610 DATA IOPN/0/ , IDUN/0/ 076201 07630C**** 07640C**** BEGIN PROGRAM ....... 076501 07660 IF ( NOPT.EQ.2 ) GO TO 500 07670 IF ( IOPN.EQ.1 ) GO TO 100 076801 07690C*** CHECK FOR LA LOOK-ALIKE 077001 07710 IF( IDUN.EQ.1 ) GO TO 5 07720 IDUN = 1 07730 CALL PGMIN( USER,LU,MODE,NPORT ) 07740 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 07750 IF ( ICM.EQ.0 ) GO TO 5 07760 CALL CCSMVA( DAT1,3,6,DAT1,1,16 ) 077701 07780 5 CONTINUE 07790 DO 20 I = 1,24 07800 REQ1(I) = 0 07810 20 CONTINUE 078201 07830 CALL OPENFL( REQ1,DAT1,ISTAT ) 07840 IF( ISTAT.LT.0 ) GO TO 800 07850 REQ1(23) = 1 07860 IOPN = 1 078701 07880 100 CONTINUE 07890 CALL CCSMVA( KEYB,1,4,R1KY,1,30 ) 07900 CALL READR ( REQ1,REC1,R1KY,ISTAT ) 07910 IF ( AND(ISTAT,$300).NE.0 ) GO TO 200 07920 IF ( ISTAT.LT.0 ) GO TO 800 079301 07940C*** RECORD FOUND PASS INFO BACK TO CALLER 079501 07960 120 CONTINUE 07970 IFER = ISTAT 07980 IFOUND = 0 07990 CALL CCSMVA( REC1,1,80,REC,1,80 ) 08000 IF( NOPT.EQ.1 ) GO TO 500 08010 GO TO 900 080201 08030C**** RECORD NOT FOUND RETURN BLANKS 080401 08050 200 CONTINUE 08060 IFER = AND( ISTAT,$7FFF ) 08070 IFOUND = 1 08080 CALL CCSMVA( REC1,1,0,REC,1,40 ) 08090 IF( NOPT.EQ.1 ) GO TO 500 08100 GO TO 900 081101 08120C**** CLOSE FILE AND RETURN 081301 08140 500 CONTINUE 08150 CALL CLOSFL( REQ1,ISTAT ) 08160 IOPN = 0 08170 GO TO 900 081801 08190C**** ERROR SECTION FOR FILE 082001 08210 800 CONTINUE 08220 IFOUND = 1 08230 IFER = ISTAT 08240 IF( AND(ISTAT,$8002).EQ.$8002 ) GO TO 900 08250 IREQ = AND(REQ1(4),$FF) 08260 IF(IREQ.LT.11) IREQ = IREQ-1 08270 IF(IREQ.EQ.18) IREQ = 10 08280 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 08290 GO TO 900 083001 08310 900 CONTINUE 08320 RETURN 08330 END 08340 END/ 08350PRTORF DCK/ I=13,H 08360PRTORF HOL/ 08370 SUBROUTINE PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 08380 1 /CCS3.0 SUBROUTINE PRTORF SL-XXX 083901 08400C** CYBERCREDIT FINANCIAL SERVICES. 08410C** CYBERCREDIT FIELD SUPPORT GROUPS 08420C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 08430C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 08440C** 08450C** ************ 04/06/84 ************ PROGRAMMER : RWE 084601 08470C**** PROGRAM DESCRIPTION : VALIDATE OUTPUT LOGICAL UNIT AND 08480C SET DIRECTION OF OUTPUT. 084901 08500C*** CALLING SEQUENCE : CALL PRTORF( IPF,LU,NLU,NPORT,IWAY ) 085101 08520C PARAMETERS 085301 08540C IPF : RETURNED VALUE DESIGNATING OUTPUT DIRECTION. 08550C 0 = OUTPUT TO LOCIGAL UNIT 'NLU' 08560C 1 = OUTPUT TO SYSPRT FILE 08570C LU : LOGICAL UNIT NUMBER OF REQUESTED OUTPUT DEVICE. 08580C NLU : RETURNED VALUE DESIGNATING VALIDATED LOGICAL 08590C UNIT TO OUTPUT TO. 08600C NPORT : CURRENT TERMINAL # ( FROM PGMIN ) 08610C IWAY : FLAG TO DETERMINE WHICH ACTION TO TAKE : 08620C 0 = FORCE OUTPUT TO DESIGNATED LOGICAL UNIT 08630C 1 = FORCE OUTPUT TO SYSPRT FILE 08640C 2 = NOT USED AT PRESENT TIME 08650C 3 = PROMPT OPERATOR FROM SCREEN, FOR OUTPUT DIRECTION 08660C 4 = GET 'IWAY' FLAG FROM UTIFIL 086701 08680 INTEGER IPF,PLU,NLU,NPORT,IWAY 08690 +, INP(41),CRT(4),PRINT(4),TAPE(5),MSGY(18) 08700 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 087101 08720 DATA MSG1/$180A,$0A07,'** SELECT DIRECTION OF OUTPUT ',$160A/ 08730 +, MSG2/$0D0A,' 0 = OUTPUT TO LOGICAL UNIT ',$1616/ 08740 +, MSG3/$0D0A,' 1 = OUTPUT TO SYSPRT FILE ',$1616/ 08750 +, MSG4/$0D0A,' ',$160A/ 08760 +, MSG5/$0D0A,' PLEASE ENTER SELECTION (0,1) : ',$1616/ 087701 08780 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 087901 08800 DATA CRT /'TERMINAL'/, PRINT /'PRINTER '/ 08810 +, TAPE /'TAPE DRIVE'/ 088201 08830C**** BEGIN PROGRAM ....... 088401 08850 MWAY = IWAY 08860 10 CONTINUE 08870 PLU = AND( PLU,$FF ) 08880 IF ( MWAY.EQ.1 ) GO TO 200 088901 08900 NLU = PLU 08910 IF ( NPORT.NE.00 ) NLU = 05 08920 IF ( NPORT.EQ.00 .AND. NLU.EQ.05 ) NLU = 04 08930 IF ( MWAY.EQ.3 ) GO TO 300 08940 IF ( MWAY.EQ.4 ) GO TO 400 089501 08960 100 CONTINUE 08970 IPF = 0 08980 IF ( MWAY.EQ.2 ) IPF = 0 08990 GO TO 800 090001 09010C*** OUTPUT FORCED TO SYSPRT FILE...... 090201 09030 200 CONTINUE 09040 IPF = 1 09050 GO TO 800 090601 09070C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 090801 09090 300 CONTINUE 09100 IF(NLU.EQ.05.OR.NLU.EQ.04) CALL CCSMVA( CRT,1,8,MSG2,18,12 ) 09110 IF(NLU.EQ.09.OR.NLU.EQ.12) CALL CCSMVA( PRINT,1,8,MSG2,18,12 ) 09120 IF(NLU.EQ.06.OR.NLU.EQ.16) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 09130 IF(NLU.EQ.17.OR.NLU.EQ.18) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 091401 09150 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 09160 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 09170 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 09180 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 091901 09200 310 CONTINUE 09210 CALL CCSMVA(INP,1,0,INP,1,82) 09220 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 09230 IF (ITC.EQ.4) GO TO 310 092401 09250C*** VALIDATE SELECTION.... 092601 09270 CALL CCSGET( INP,1,ICH ) 092801 09290 IF( INP(41).EQ.0 ) GO TO 320 09300 IF ( ICH.LT.$30 .OR. ICH.GT.$31 ) GO TO 310 093101 09320 320 IPF = AND( ICH,$F ) 09330 IF( IPF.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 09340 IF( IPF.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 093501 09360 CALL CCSMVA(INP,1,0,INP,1,82) 09370 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 09380 CALL CCSGET(INP,1,ICH) 09390 IF ( INP(41).EQ.0 ) GO TO 330 09400 IF ( ICH.NE.$59 ) GO TO 300 09410 330 CONTINUE 09420 GO TO 800 094301 09440C**** GET 'IWAY' WHAT TO DO FLAG FROM UTIFIL... 094501 09460 400 CONTINUE 09470 CALL GTSYSP( MWAY,73 ) 09480 IF ( MWAY.LT.0 .OR. MWAY.GT.3 ) MWAY = 0 09490 GO TO 10 095001 09510 800 RETURN 09520 END 09530 END/ 09540GETGRP DCK/ I=13,H 09550GETGRP HOL/ 09560 SUBROUTINE GETGRP( GRPBUF,IALL,IMODE ) 09570 1 /CCS3.0 SUBROUTINE GETGRP SL-XXX 095801 09590C** CYBERCREDIT FINANCIAL SERVICES. 09600C** CYBERCREDIT FIELD SUPPORT GROUPS 09610C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 09620C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 09630C** 09640C** ************ 04/06/84 ************ PROGRAMMER : RWE 096501 09660C**** PROGRAM DESCRIPTION : SELECT WHICH ACCOUNT GROUPS TO USE 096701 09680C*** CALLING SEQUENCE : CALL GETGRP( GRPBUF,IALL,IMODE ) 096901 09700C PARAMETERS 097101 09720C GRPBUF : 10 WORD ARRAY RETURNED TO PROGRAM WITH FROM 1 09730C TO 10 VALID ACCOUNT GROUPS 09740C ( FOR USE WITH FUNCTION 'ICKGRP' ) 09750C IALL : FLAG RETURNED DESIGNATING USE OF ACCOUNT GROUPS 09760C 0 = USE ALL ACCOUNT GROUPS 09770C 1 = USE ONLY ACCOUNT GROUPS IN GRPBUF ARRAY 09780C IMODE : FLAG TO DETERMINE WHICH ACTION TO TAKE : 09790C 0 = USE ALL ACCOUNT GROUPS 09800C 1 = USE ACCOUNT GROUPS 0-4 ONLY 09810C 2 = USE ACCOUNT GROUPS 5-9 ONLY 09820C 3 = PROMPT FROM SCREEN, WHICH OF (0-9) GROUPS TO USE 09830C 4 = PROMPT FROM SCREEN, EITHER ALL, OR 0-4, OR 5-9. 09840C 5 = GET 'IMODE' FLAG FROM UTIFIL 098501 09860 INTEGER GRPBUF(1),IALL,IMODE 09870 +, INP(41),MSGY(18),AGRPS(10),MINUS(10),ALL 09880 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 09890 +, MSGA(18),MSGB(18),MSGC(18),MSGD(18),MSGE(18),MSGF(20) 099001 09910 DATA MSG1/$180A,$0A0D,'** SELECT ACCOUNT GROUP OPTION',$160A/ 09920 +, MSG2/$0D0A,' 0 = ALL ACCOUNT GROUPS ',$1616/ 09930 +, MSG3/$0D0A,' 1 = ACCOUNT GROUPS 0-4 ONLY ',$1616/ 09940 +, MSG4/$0D0A,' 2 = ACCOUNT GROUPS 5-9 ONLY ',$160A/ 09950 +, MSG5/$0D0A,' PLEASE ENTER SELECTION(0,1,2) :',$1616/ 099601 09970 DATA MSGA/$180A,$0A0D,'* SELECT ACCOUNT GROUPS TO USE',$160A/ 09980 +, MSGB/$0D0A,' SEPARATE GROUPS BY COMMAS, ',$1616/ 09990 +, MSGC/$0D0A,' (I.E. 0,1,2,3, ETC...) OR ',$1616/ 10000 +, MSGD/$0D0A,' ENTER A FOR ALL GROUPS ',$160A/ 10010 +, MSGE/$0D0A,' PLEASE ENTER SELECTION -- :',$1616/ 100201 10030 DATA MSGF/$180A,'INVALID ENTRY : ',$160A/ 100401 10050 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 10060 +, AGRPS/'0,1,2,3,4,5,6,7,8,9,'/,MINUS/10*$FFFF/,ALL/'A,'/ 100701 10080C**** BEGIN PROGRAM ....... 100901 10100 MODE = IMODE 10110 IALL = 0 10120 CALL CCSMVA( MINUS,1,20,GRPBUF,1,20 ) 101301 10140 10 CONTINUE 10150 IF ( MODE.EQ.0 ) GO TO 50 10160 IF ( MODE.EQ.1 ) GO TO 100 10170 IF ( MODE.EQ.2 ) GO TO 200 10180 IF ( MODE.EQ.3 ) GO TO 300 10190 IF ( MODE.EQ.4 ) GO TO 400 10200 IF ( MODE.EQ.5 ) GO TO 500 102101 10220C**** SET AND USE ALL ACCOUNT GROUPS 102301 10240 50 CONTINUE 10250 IALL = 0 10260 CALL CCSMVA( AGRPS,1,20,GRPBUF,1,20 ) 10270 GO TO 800 102801 10290C**** SET AND USE GROUPS 0-4 ONLY 103001 10310 100 CONTINUE 10320 IALL = 1 10330 CALL CCSMVA( AGRPS,1,10,GRPBUF,1,10 ) 10340 GO TO 800 103501 10360C**** SET AND USE GROUPS 5-9 ONLY 103701 10380 200 CONTINUE 10390 IALL = 1 10400 CALL CCSMVA( AGRPS,11,10,GRPBUF,1,10 ) 10410 GO TO 800 104201 10430C**** ASK OPERATOR FROM SCREEN WHICH ACCOUNT GROUPS..... 104401 10450 300 CONTINUE 10460 CALL CCSMVA( MSG2,8,18,MSG2,4,30 ) 10470 CALL CCSMVA( MSG3,16,6,MSG3,4,30 ) 104801 10490 305 CONTINUE 10500 ASSIGN 305 TO IRTN 10510 ASSIGN 10 TO IRTN2 10520 CALL WTREAD(05,-1,MSGA ,36,0,0,0,ITC) 10530 CALL WTREAD(05,-1,MSGB ,36,0,0,0,ITC) 10540 CALL WTREAD(05,-1,MSGC ,36,0,0,0,ITC) 10550 CALL WTREAD(05,-1,MSGD ,36,0,0,0,ITC) 10560 MSGA = MSG1 105701 10580 310 CONTINUE 10590 CALL CCSMVA(INP,1,0,INP,1,82) 10600 CALL WTREAD(05,-1,MSGE ,36,-1,INP,80,ITC) 10610 IF (ITC.EQ.4) GO TO 310 10620 NCH = INP(41) 10630 NCH = (NCH+1)/2 10640 N2H = NCH*2 10650 CALL CCSPUT( $2C,N2H,INP ) 10660 IF ( INP.EQ.ALL ) GO TO 320 10670 GO TO 330 106801 10690C**** VERIFY ALL GROUPS TO BE USED... 107001 10710 320 CONTINUE 10720 MODE = 0 10730 CALL WTREAD( 05,-1,MSG2,36,0,0,0,ITC ) 10740 GO TO 425 107501 10760C**** VALIDATE INPUT FOR VALID GROUPS..... 107701 10780 330 CONTINUE 107901 10800 K = 1 10810 MELM= NCH-1 10820 IF (MELM.LE.1) GO TO 370 10830 DO 360 I=1,MELM 108401 10850 IF(INP(I).LT.INP(I+1))GO TO 360 10860 340 TEMP = INP(I) 10870 INP(I) = INP(I+1) 10880 INP(I+1) = TEMP 10890 DO 350 J=I,2,-K 10900 IF(INP(J).GT.INP(J-1))GO TO 360 10910 TEMP = INP(J) 10920 INP(J) = INP(J-1) 10930 INP(J-1) = TEMP 10940 350 CONTINUE 10950 360 CONTINUE 109601 10970C*** CHECK FOR DUPLICATE NUMBERS 109801 10990 JJ = NCH-1 11000 DO 365 I = 1,JJ 11010 IF ( INP(I).EQ.INP(I+1) ) GO TO 390 11020 365 CONTINUE 110301 11040C*** DISPLAY CHOICES AND VERIFY... 110501 11060 370 CONTINUE 11070 IF( INP(1).EQ.INP(2) ) GO TO 390 11080 DO 375 I = 1,NCH 11090 L = ( AND(INP(I),$FF00) )/256 11100 IF ( L.LT.$30 .OR. L.GT.$39 ) GO TO 390 11110 375 CONTINUE 11120 CALL CCSMVA( INP,1,N2H,MSG4,1,N2H ) 11130 CALL CCSMVA( INP,1,N2H-1,MSG3,11,20 ) 11140 CALL WTREAD( 05,-1,MSG3,36,0,0,0,ITC ) 11150 ASSIGN 380 TO IRTN2 11160 GO TO 425 111701 11180C*** SET GROUPS..... 111901 11200 380 CONTINUE 11210 IALL = 1 11220 CALL CCSMVA( MSG4,1,N2H,GRPBUF,1,N2H ) 11230 GO TO 800 112401 11250C*** ERROR IN NUMBER ENTRY ..... REPEAT PROMPT 112601 11270 390 CONTINUE 11280 MSGA = MSGB 11290 CALL CCSMVA( INP,1,N2H-1,MSGF,19,20 ) 11300 CALL WTREAD( 05,-1,MSGF,40,0,0,0,ITC ) 11310 GO TO IRTN 113201 11330C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 113401 11350 400 CONTINUE 11360 ASSIGN 400 TO IRTN 11370 ASSIGN 10 TO IRTN2 11380 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 11390 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 11400 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 11410 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 114201 11430 410 CONTINUE 11440 CALL CCSMVA(INP,1,0,INP,1,82) 11450 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 11460 IF (ITC.EQ.4) GO TO 410 114701 11480C*** VALIDATE SELECTION.... 114901 11500 CALL CCSGET( INP,1,ICH ) 115101 11520 IF( INP(41).EQ.0 ) GO TO 420 11530 IF ( ICH.LT.$30 .OR. ICH.GT.$32 ) GO TO IRTN 115401 11550 420 MODE = AND( ICH,$F ) 11560 IF( MODE.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,35,0,0,0,ITC) 11570 IF( MODE.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,35,0,0,0,ITC) 11580 IF( MODE.EQ.2 ) CALL WTREAD(05,-1,MSG4 ,35,0,0,0,ITC) 115901 11600 425 CONTINUE 11610 CALL CCSMVA(INP,1,0,INP,1,82) 11620 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 11630 CALL CCSGET(INP,1,ICH) 11640 IF ( INP(41).EQ.0 ) GO TO 430 11650 IF ( ICH.NE.$59 ) GO TO IRTN 11660 430 CONTINUE 11670 GO TO IRTN2 116801 11690C**** GET 'IMODE' WHAT TO DO FLAG FROM UTIFIL... 117001 11710 500 CONTINUE 11720 CALL GTSYSP( MODE,77 ) 11730 IF ( MODE.LT.0 .OR. MODE.GT.4 ) MODE = 0 11740 GO TO 10 117501 11760 800 RETURN 11770 END 11780 END/ 11790SYSPRT DCK/ I=13,H 11800SYSPRT HOL/ 11810 SUBROUTINE SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 11820 1 /CCS3.0 SUBROUTINE SYSPRT SL-XXX 118301 11840C** CYBERCREDIT FINANCIAL SERVICES. 11850C** CYBERCREDIT FIELD SUPPORT GROUPS 11860C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 11870C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 11880C** 11890C** ************ 04/06/84 ************ PROGRAMMER : RWE 119001 11910C**** PROGRAM DESCRIPTION : OUTPUT BUFFER TO LOGICAL UNIT OR 11920C TO A FILE 'SYSPRT'. 119301 11940C*** CALLING SEQUENCE : CALL SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 119501 11960C PARAMETERS 119701 11980C BUFFER : BUFFER CONTAINING CHARACTERS TO OUTPUT FROM. 11990C NTIMES : # OF TIMES TO OUTPUT THE BUFFER 12000C SYSPRM : 6 WORD ARRAY HOLDING PARAMETERS FOR SYSPRT 12010C SYSPRM(1) : PLN - NUMBER OF BYTES TO OUTPUT FROM BUFFER 12020C SYSPRM(2) : NLU - LOGICAL UNIT TO OUTPUT TO ( IGNORED IF 12030C OUTPUT IS TO FILE ) 12040C SYSPRM(3) : IPF - SWITCH DESIGNATING OUTPUT TO FILE OR LU 12050C 0 = LOGICAL UNIT. 1 = FILE. 2 = BOTH. 12060C SYSPRM(4) : NLINE - CURRENT LINE OR RECORD JUST OUTPUT. 12070C (INITIALIZED TO 0 BY CALLING PROGRAM) 12080C SYSPRM(5) : ISERR - ISTAT OF FILE MANAGER CALL TO FILE 12090C SYSPRM(6) : NU - NOT USED AT PRESENT TIME 12100C IOPT : WHAT TO DO FLAG. 0 = OUTPUT BUFFER TO FILE OR LU 12110C 1 = CLOSE FILE 121201 12130C**** SYSPRT PARAMETERS........ 121401 12150 INTEGER BUFFER(1),NTIMES,IOPT 12160 +, SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 121701 12180 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 12190 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 12200 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 122101 12220C**** FWRITE PARAMETERS..... 12230 INTEGER IFLAG,ITEMP(8) 122401 12250 DATA IFLAG /0/, ITEMP /8*0/ 122601 12270 INTEGER DAT1(15),REQ1(24),R1KY(15),REC1(0068) 12280 +, HEDR(18) 122901 12300 DATA HEDR/$0D0A,$0717,'ABORTED--PRINT FILE IS FULL FN='/ 12310 DATA DAT1 /'SYSPRT ',00,01,-1/,REQ1/24*0/ 12320 +, IOPN/0/ 123301 12340C**** 12350C**** BEGIN PROGRAM ....... 123601 12370 IF ( ISERR.LT.0 ) GO TO 800 12380 ISERR = 0 12390 LINE = NLINE 12400 LU = AND( NLU,$FF ) 12410 LENW = (PLN+1)/2 124201 12430 IF ( IOPT.NE.0 ) GO TO 950 12440 IF ( IPF.EQ.1 ) GO TO 400 12450 IF ( NTIMES.LE.0 ) GO TO 800 124601 12470 IF ( LU.EQ.05 .OR. LU.EQ.04 ) GO TO 20 12480 IF ( LU.EQ.09 .OR. LU.EQ.12 ) GO TO 20 12490 I = LENW 12500 GO TO 40 125101 12520 20 CONTINUE 12530 DO 30 I = LENW, 2, -1 12540 IF ( BUFFER(I).NE.$2020 ) GO TO 40 12550 30 CONTINUE 125601 12570 40 CONTINUE 12580 LENB = I * 2 125901 12600C*** WRITE BUFFER TO LOGICAL UNIT..... 126101 12620 IF ( LU.EQ.05 ) GO TO 140 12630 50 CONTINUE 126401 12650 DO 80 I = 1,NTIMES 126601 12670 ASSIGN 60 TO ICOMP 12680 CALL FWRITE( LU,BUFFER,LENB,ICOMP,IFLAG,ITEMP ) 12690 CALL DISP 12700 60 CONTINUE 127101 12720 80 CONTINUE 12730 GO TO 200 127401 12750C**** WRITE OUTPUT TO TERMINAL (MAX OF 132 BYTES)......... 127601 12770 140 CONTINUE 12780 DO 150 I = 1,NTIMES 127901 12800 ILN = LENB 12810 JLN = LENB 12820 IF ( ILN.GE.80 ) JLN = 80 128301 12840 CALL WTREAD( LU,-1,HEDR,2,0,0,0,ITC ) 12850 CALL WTREAD( LU,-1,BUFFER,JLN,0,0,0,ITC ) 128601 12870 JLN = ILN-80 12880 IF( JLN.LE.0 ) GO TO 150 128901 12900 CALL WTREAD( LU,-1,BUFFER(41),JLN,0,0,0,ITC ) 129101 12920 150 CONTINUE 129301 12940C**** INCREMENT LINE COUNT....... 129501 12960 200 CONTINUE 12970 NLINE = NLINE + NTIMES 12980 GO TO 800 129901 13000C**** WRITE BUFFER TO SYSPRT FILE.......... 130101 13020 400 CONTINUE 13030 IF ( IOPN.EQ.1 ) GO TO 420 130401 13050 DO 410 I = 1,24 13060 REQ1(I) = 0 13070 410 CONTINUE 130801 13090 CALL OPENFL( REQ1,DAT1,ISTAT ) 13100 IF( ISTAT.LT.0 ) GO TO 900 13110 IOPN = 1 131201 13130C**** OUTPUT BUFFER TO SYSPRT FILE.... 131401 13150 420 CONTINUE 13160 IF( NTIMES.LE.0 ) GO TO 800 13170 ILN = PLN 13180 IF( ILN.GT.132 ) ILN = 132 13190 CALL CCSMVA( BUFFER,1,ILN,REC1,1,132 ) 132001 13210 DO 440 I = 1,NTIMES 13220 CALL PUTS( REQ1,REC1,1,ISTAT ) 13230 IF( AND(ISTAT,$9000).EQ.$9000 ) GO TO 500 13240 IF( ISTAT.LT.0 ) GO TO 900 13250 440 CONTINUE 132601 13270 NLINE = NLINE+NTIMES 13280 GO TO 800 132901 13300C**** INFORM OPERATOR FILE IS FULL..... 133101 13320 500 CONTINUE 13330 ISERR = -1 13340 CALL CCSMVA( HEDR,1,36,REC1,1,132 ) 13350 CALL CCSMVA( DAT1,1,24,REC1,37,24 ) 13360 CALL WTREAD( 05,-1,REC1,64,0,0,0,ITC ) 13370 GO TO 950 133801 13390 800 CONTINUE 13400 RETURN 134101 13420C*** ERROR SECTION.... 134301 13440 900 CONTINUE 13450 ISERR = -1 13460 IREQ = AND(REQ1(4),$FF) 13470 IF(IREQ.LT.11) IREQ = IREQ-1 13480 IF(IREQ.EQ.18) IREQ = 10 13490 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 135001 13510C**** CLOSE FILE AND RETURN 135201 13530 950 CONTINUE 13540 CALL CLOSFL( REQ1,ISTAT ) 13550 IOPN = 0 13560 RETURN 13570 END 13580 END/ 13590ICKGRP DCK/ I=13,H 13600ICKGRP HOL/ 13610 INTEGER FUNCTION ICKGRP( GRPBUF,IALL,REC,IPOS ) 13620 1 /CCS3.0 SUBROUTINE ICKGRP SL-XXX 136301 13640C** CYBERCREDIT FINANCIAL SERVICES. 13650C** CYBERCREDIT FIELD SUPPORT GROUPS 13660C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 13670C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 13680C** 13690C** ************ 04/06/84 ************ PROGRAMMER : RWE 137001 13710C**** PROGRAM DESCRIPTION : VALIDATE RECORD FOR MATCH OF ACCT GROUP 137201 13730C*** CALLING SEQUENCE : 13740C ITF = ICKGRP( GRPBUF,IALL,REC,IPOS ) 13750C OR... IF ( ICKGRP( GRPBUF,IALL,REC,IPOS ).EQ. 1 ) GO TO 137601 13770C PARAMETERS 137801 13790C ICKGRP : RETURNED VALUE OF 0 = TRUE, OK TO USE RECORD 13800C 1 = FALSE, DON'T USE RECORD 13810C GRPBUF : 10 WORD ARRAY PASSED, CONTAINING VALID GROUPS 13820C ( BUILT BY SUBROUTINE 'GETGRP' ) 13830C IALL : PASSED FLAG DESIGNATING 13840C 0 = USE ALL ACCOUNT GROUPS ( FORCE ICKGRP TO TRUE ) 13850C 1 = LOOK FOR MATCH OF GROUP FROM RECORD, IN THE 13860C GRPBUF ARRAY 13870C REC : PASSED BUFFER OF RECORD CONTAING ACCT GROUP. 13880C IPOS : STARTING BYTE POS. IN REC OF ACCOUNT GROUP 138901 13900 INTEGER GRPBUF(1),IALL,REC(1),IPOS,TRUE,FALSE 139101 13920 DATA TRUE / 0/, FALSE / 1/ 139301 13940C**** 13950C**** BEGIN PROGRAM ....... 139601 13970 ICKGRP = TRUE 13980 IF ( IALL.EQ.0 ) GO TO 900 139901 14000 CALL CCSGET( REC,IPOS,IGRP ) 140101 14020 DO 200 I = 1,10 14030 J = I*2-1 14040 CALL CCSGET( GRPBUF,J,ICH ) 140501 14060 IF( ICH.EQ.$FF ) GO TO 800 14070 IF( ICH.EQ.IGRP ) GO TO 900 14080 200 CONTINUE 140901 14100C*** NO MATCH SET ICKGRP TO FALSE 141101 14120 800 CONTINUE 14130 ICKGRP = FALSE 14140 GO TO 900 141501 14160 900 RETURN 14170 END 14180 END/ 14190HXDEC DCK/ I=13,H 14200HXDEC HOL/ 14210 SUBROUTINE HXDEC (NUM,IOUT) 14220 * /DECK-ID E27 ITOS 2.0 SUMMARY-132 14230C CONVERT HEX TO DECIMAL ASCII 14240C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 2.0 14250C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 14260C COPYRIGHT CONTROL DATA CORPORATION 1978 14270C 14280C** FUNCTION 14290C -------- 14300CS3 HXDEC CONVERTS A HEXADECIMAL NUMBER INTO AN ASCII 14310C DECIMAL NUMBER. 14320CS5 GENERAL DESCRIPTION 14330C ------------------- 14340CS3 HXDEC BLANKS OUT THE OUTPUT BUFFER, IOUT. THE 14350C SUBROUTINE THEN TESTS THE HEX NUMBER FOR ZERO. IF 14360C THE NUMBER IS ZERO, AN ASCII ZERO IS MOVED TO THE 14370C RIGHT BYTE OF THE THIRD WORD OF IOUT. IF THE 14380C NUMBER IS NOT ZERO AND IS NEGATIVE AN ASCII MINUS 14390C SIGN IS PLACED IN THE LEFT BYTE OF THE FIRST WORD 14400C OF IOUT AND THE HEX NUMBER IS COMPLIMENTED. AT 14410C THIS POINT ANOTHER TEST FOR ZERO IS MADE. IF THE 14420C NUMBER IS ZERO, NO CONVERSION TAKES PLACE, 14430C OTHERWISE THE HEX NUMBER IS CONVERTED TO AN ASCII 14440C DECIMAL NUMBER. 14450CE ENTRY/EXIT 14460C ---------- 14470CS3 HXDEC IS ENTERED WITH THE HEX NUMBER IN NUM AND 14480C EXITS WITH THE CONVERTED NUMBER IN IOUT. 14490C 14500 BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) 14510 DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) 14520C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. 14530 N=NUM 14540 DO 8 JK=1,3 14550 8 IOUT(JK)= $3030 14560 IF(N.EQ.0) IRIGHT(3)=$30 14570 IF(N.GE.0) GO TO 50 14580C MINUS NUMBER 14590 N=-N 14600 ILEFT(1)=$2D 1461050 CONTINUE 14620 I=5 1463055 CONTINUE 14640 IF(N.EQ.0) GO TO 200 14650 N1=(N/10)*10 14660 N2=N-N1+$30 14670 I1=I/2+1 14680 IF(AND(I,1).EQ.0) GO TO 100 14690 IRIGHT(I1)=N2 14700 GO TO 110 14710100 ILEFT(I1)=N2 14720110 CONTINUE 14730 N=N/10 14740 I=I-1 14750 IF(I.GT.0) GO TO 55 14760200 CONTINUE 14770 RETURN 14780 END 14790 END/ 14800 END/ 14810*REW,7 14820*K,I7,P21,L14 14830*FTN 14840*EOF 14850*CLOSE 14860*K,I13,L14 14870*Z 14880*Z 14890__ IF(N.EQ.0) GO TO 200 14650 N1=(N/10)*10 14660 N2=N-N1+$30 14670 I1=I/2+1 14680 IF(AND(I,1).EQ.0) GO TO 100 14690 IRIGHT(I1)=N2 14700 GO TO 110 14710100 ILEFT(I1)=N2 14720110 CONTINUE 14730 N=N/10 14740 I=I-1 14750( T;  I.PGGEN CCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING PGGEN FROM B.PGGEN, CCS149 FILE 00030*OPEN,FN=B.PGGEN,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,PGGEN,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM PGGEN HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ IRIGHT(I1)=N2 14700 GO TO 110 14710100 ILEFT(I1)=N2 14720110 CONTINUE 14730 N=N/10 14740 I=I-1 14750( WSICKGRPCCS149 P999999($$TWBNJOB,WEAVE,,ICKGRP,CCS149 $$TWFTNHOL,RWE,,ICKGRP,CCS149 $$TWFBEND,WEAVE __N,FN=B.PGGEN,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,PGGEN,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM PGGEN HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ IRIGHT(I1)=N2 14700 GO TO 110 14710100 ILEFT(I1)=N2 14720110 CONTINUE 14730 N=N/10 14740 I=I-1 14750(u;C C1J.GETSW CCS149 P(*JOB,, GETSW INSTALL 08/27/84 00010*K,L14 00020*CTO, GETSW WEAVED AS OF 08/27/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BNGETSW, CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BNGETSW,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120GETSW DCK/ I=13,H 00130GETSW HOL/ 00140 SUBROUTINE GETSW ( U ) 00150 1 /CCS3.0 SUBROUTINE GETSW SL-XXX 001601 00170C** CYBERCREDIT FINANCIAL SERVICES. 00180C** CYBERCREDIT FIELD SUPPORT GROUPS 00190C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00200C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00210C** 00220C** ************ 04/06/84 ************ PROGRAMMER : RWE 002301 00240C**** PROGRAM DESCRIPTION : RETRIEVE RPG EXTERNAL SWITCH SETTINGS 002501 00260C*** CALLING SEQUENCE : CALL GETSW( U ) 002701 00280C PARAMETERS 002901 00300C U : AN 8 WORD ARRAY, WHERE EACH WORD CORRESPONDS 00310C TO AN RPG EXTERNAL SWITCH 00320C RPG ARRAY 00330C U1 = U(1) 00340C U2 = U(2) 00350C ETC... 00360C RETURNED VALUES ARE 0 = SWITCH IS OFF, 1 = SWITCH IS ON 003701 00380 INTEGER U(1),I,J,SWITCH 003901 00400C**** 00410C**** BEGIN PROGRAM ....... 004201 00430C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 004401 00450 ASSEM $C400,$00E3,$6800,SWITCH 004601 00470 J = 2 004801 00490C*** CRACK THE SWITCHS 005001 00510 DO 100 I = 1,8 00520 U(I) = AND( SWITCH,J )/J 00530 J = J*2 00540 100 CONTINUE 00550 RETURN 00560 END 00570 END/ 00580 END/ 00590*REW,7 00600*K,I7,P21,L14 00610*FTN 00620*EOF 00630*CLOSE 00640*K,I13,L14 00650*Z 00660*Z 00670__ 00430C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 004401 00450 ASSEM $C400,$00E3,$6800,SWITCH 004601 00470 J = 2 004801 00490C*** CRACK THE SWITCHS 00500(;u I.GETSW CCS149 P(*JOB,, INSTALL CORRECTIONS 08/27/84 00010*K,L14 00020*CTO, INSTALLING GETSW FROM BNGETSW, CCS149 FILE 00030*OPEN,FN=BNGETSW,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*L,GETSW 00090*Z 00100*K,I13 00110*CLOSE 00120*CTO, SUBROUTINE GETSW HAS BEEN INSTALLED 00130*CTO, 00140*CTO, 00150*CTO, INSTALL C O M P L E T E !!! 00160*Z 00170__ 00430C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 004401 00450 ASSEM $C400,$00E3,$6800,SWITCH 004601 00470 J = 2 004801 00490C*** CRACK THE SWITCHS 00500< T nBNCCSADDCCS149 x032883< PCCSADD A02 A CCS CCS 3.0 PSR'D SL-149@PHh HX  }hH 9 " :  0n@P+  d 0fhIIccZY TR NhQHQ 9 " : @PV 0A  d 09hLL44- L@P  5`2h`P@P4 `"i PCCSADDP __, INSTALL C O M P L E T E !!! 00160*Z 00170__ 00430C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 004401 00450 ASSEM $C400,$00E3,$6800,SWITCH 004601 00470 J = 2 004801 00490<} BNGETSW CCS149 x082784082784< P)GETSW CCS3.0 SUBROUTINE GETSW SL-XXX @Ph h h"p8n h 1@P H TT hPGETSW PQ8PKUP$Q8PREP!P __SADDP __, INSTALL C O M P L E T E !!! 00160*Z 00170__ 00430C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 004401 00450 ASSEM $C400,$00E3,$6800,SWITCH 004601 00470 J = 2 004801 00490<T nB.CCSDMPCCS149 x032883< P CCSDMP B20 F CCS CCS 3.0 2 WORD RRN - PSRD SL-149@P@P@P<@P@P@P@P @P @P @P@P@PpY@PEXACT @P @PSEQ INDX@POVER@P  @P@P@PTAPE0 @PT  hTR  @P (20HGENERAL DUMP PGM IN ) @P \R @P (52H ENTER FILE NAME(CR) TO BE DUMPED, (CR) TO TERMINATE) @P 5 hTTQQTQ 2TQ  @P `TT\Q d d d d f 1T@P  (T{T '\iddd@P d dT = \\TT \\@P TZ2  dhT@P 1 lh\@P  1\T!G@P (8HFILE IS ,2A2,14H AND CONTAINS ,2A2,F7.0,9H RECORDS.) @P ,̍  \R5 7@P 7(52H ENTER 0/1/2/3/4 (CR) FOR ACCESS BY RRN OR KEYS 1-4.) @P TT EQ  TQd  d DT R= x,@P x(81H ENTER Y(CR) IF AN EXACT KEY TO BE DUMPED, OTHERWISE DUMP WILL USE 1ST CLOSE KEY )@P \Q doQp  l\RB @P (43H ENTER STARTING RECORD NUMBER OR KEY VALUE )@P T UQ " ̎  !TQ T Q̵ OT rRL @P @P (41H ENTER ENDING RECORD NUMBER OR KEY VALUE )@P \Q̾ !  !\Q\Qdd \@P @ d fp 1dqdr \qTq @P k  /o  (T T Rc @P (43H1 FILE NAME TYPE RETRIEVAL KEY LIMITS)@P  J\Zf l̜hT @P ܕ 1 dh\@P 1\\T @P (4X,4A2,2X,2A2,5X,I1,10X,F7.0)@P \Zh \\@P (34X,F7.0,//) @P T o \T Zm A dh\@P  1 l̢h\@P ܜ 1\ l̓ hT @P +܌ 1 lh\@P 9 1T ɀ@P A(4X,4A2,2X,2A2,5X,I1,1X,3A2,3X,16A2)@P S̡ ,\Zp k lπh\@P d 1\@P k(34X,16A2,//) @P rT Oq  " ,T T ۝@ \\@T Zv \\@P (1X,27HRELATIVE RECORD # IN FILE =,F7.0)@P To  ,\Rz @P (1H0) @P  \\ \\    2 ,Tq  1 @P 2 rT x@P M @P T g\R @P (26HGENERAL DUMP PROGRAM OUT. ) @P TTPCCSDMPPHFLOT Q8STP Q8QINI Q8QX )Q8QEND ?FLOAT PGMIN PGMINT 9CCSMVA INPUT CCSCST sTAPE aCLOSFL OPENFL PFILERR GETFCB INTGR `REALN READR bSEEIT GETS PGMOUT PCCSDMP PREALN CONVERT ASCII TO REAL - 2 WORD INTEGER SL-***@P@P@P@P `"d hAT-@d h:\-@dT@b h/\-@d+h !(TѨ@PFhh\-@dT \۞  T\@ ȵ @Pf\\ l5l)\@\+!\șl!T\\T \@P\\@f"H@G@PHTTh\h\hhh\h h_PREALN PHFLOT 0Q8PKUPQ8PREPHDFLOT%FLOAT DFLT YDBLE Q8QD2DMCCSGET@P P1INPUT B64 F CCS CCS 3.0 SL-149@P : hhT  Tl@PHTTh\h h\hPINPUT !PQ8PKUP'Q8PREP$FREAD DISP P P3INTGR B65 F CCS CCS 3.0 SL-149@P hlh !ThT(l @P"H TTh\h\hPINTGR %PQ8QI2FQ8PKUP+Q8PREP(CCSGETP PSEEIT C19 F CCS CCS 3.0 SL-149@P@Pr W@P}(_)~@P*0 @P hTRD@P(126H0 1 2  @P 3 1 2  3 )@P\RC@P(126H OFFSET 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9@P 0 OFFSET 123456789012345678901234567890 )@P dodn" dp "l dqPhT@P4sTt*uvTqk\kuw*uw\kuw*xw dy `dz d{̽d|Ĝ@P_! hT@Pgk\kw*y}\{r*zr lހ@PT~*\*TZ d)hT@P A1T@P(65A2)@Po nHTThhh\ h\h\huPSEEIT PQ8PKUPQ8PREPQ8QINIQ8QX Q8QENDXLAT 2CCSMVA8HEXDEC@HEXASCeCCSPUTP P9TAPE C22 F CCS CCS 3.0 SL-149@P@P@P@P@P@P@P CRE@PTR%Z@P%(35H MOUNT TAPE TO BE DUMPED ON UNIT 0.,/,73H ENTER C/R/E (CR) TO CONTINUE, REWIND AND@PP CONTINUE, OR EXIT TAPE DUMPING.,/,52H IF EBCDIC TAPE FOLLOW C/R WITH E, SUCH AS RE (@P{CR).) @P~ hlhTȉ T  d\ & @P T  dTR @P(18H1 TAPE REWOUND ) @P\R@P(31H ENTER NUMBER OF FILES TO SKIP.)@P d\ ! [T R\ZTT@P(I5,21H FILES BEING SKIPPED.) @P d˜5\ \R!%@P%(24H FILE SKIPPING COMPLETE.) @P4TZ#>\\@P>(1H0,I4,14H FILES SKIPPED)@PKܗ\R&R@PR(33H ENTER NUMBER OF RECORDS TO SKIP.)@Pe dT ! 4T 4\Z.TT@P(I5,24H RECORDS BEING SKIPPED. )@Pd dÜ!T TT !2T5R6@P(26H RECORD SKIPPING COMPLETE.) @P\Z8\\@P(1H0,I4,16H RECORDS SKIPPED)@PM\Z;\\2@P(33H EOF DETECTED WHILE SKIPPING THE ,I4,9HTH RECORD,/,38H ACTION IDENTICAL TO SKIPPIN@PG 1 FILE. ) @P" d\Z>>TT d\RB;@P;(33H ENTER NUMBER OF RECORDS TO DUMP.)@PNTi  !Tx }d d!DT @PyTT !6Ad"lTZP\\@P(//,32H0 RELATIVE TAPE RECORD NUMBER =,I5) @PTܹf\ZUT+T.%@P(64H EOF OR ERROR DETECTED DURING ACCESS OF RELATIVE RECORD NUMBER,I5)@P5@P@P@PNHKTThhAhh-hh\hhhhhhahmhhAhMhb@Phh~\hhfhhhhh'h@hXhhhhhPTAPE PQ8PKUPQ8PREPQ8QINIQ8QX Q8QENDINPUT OCCSGETTAPMOTINTGR ^FREAD tDISP |LINK ~SEEIT P PXLAT C55 F CCS CCS 3.0 SL-149@P:.@P <.(+&$*)>-/,%?: @'="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@P@JKMNP[\]^`aklmoz{|}~@P@N * hhhT=< h\>;  :1 h\>;T;=Ԝ& @Pk! h !\?; \?;ȼ "ȸh ]"ȳh\;?ز@PHTThh\hhh\h\hPXLAT PQ8PKUPQ8PREPCCSGETJCCSPUTdP __NHKTThhAhh-hh\hhhhhhahmhhAhMhb@Phh~\hhfhhhhh'h@hXhhhhhPTAPE PQ8PKUPQ8PREPQ8QINIQ8QX Q8QENDINPUT OCCSGETTAPMOTINTGR ^FREAD tDISP |LINK ~SEEIT P PXLAT C55 F CCS CCS 3.0 SL-149@P:.@P <.(+&$*)>-/,%?: @'="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@P@JKMNP[\]^`aklmoz{|}~@P@N * hhhT=< h\>;  :1 h\>;T;=Ԝ& @Pk! h !\?; \?;ȼ "ȸh ]"ȳh\;?ز<U n BNCCSEACCCS149 x032883< P;CCSEAC A05 A CCS CCS 3.0 PSR'D SL-149@PX";h1 h0 Xh( @h'# "``HH" H@P+ `"i ]@PV [.<(+^&!$*);\-/,%_>?:#@'="@P0ABCDEFGHI}JKLMNOPQR@PSTUVWXYZ0123456789@Z{[lP}M]\Nk`Ka@Pz^L~no|J_'Om@P@P-PCCSE2ACCSA2E P __ <.(+&$*)>-/,%?: @'="ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@P@JKMNP[\]^`aklmoz{|}~@P@N * hhhT=< h\>;  :1 h\>;T;=Ԝ& @Pk! h !\?; \?;ȼ "ȸh ]"ȳh\;?ز<U nB.PGGEN CCS149 x032883< PPGGEN A16 A CCS CCS 3.0 SL-149@PPPGGEN PPGGEN0P PHQ8QBDS B89 F CCS CCS 3.0 SL-149@P0UTIFIL  @P0DELQMST  @P0RPTTBL  @P0-RPTPGM  @P0CCSMVAZWRITERbPWTREADCLOSFL8DELETECHAIN PGMOUTSP PHPGGEN1 B91 F CCS CCS 3.0 PSR 03/23/81 SL-149@P@PNYRPT00019@P x@P @P D@P @P@PALTEQNEGTLTGELERA@P"@P A @Pf@Pd@P@PT@P PRINT DATA NAME LIST? ENTER Y OR N @P SAVE GENERATED REPORT PROGRAM? ENTER Y OR N @P2 ENTER SORT FIELD NAME (KEY1,A,KEY2,D (CR)) MAJOR TO MINOR A(ASCENDING) OR D@P](DESCENDING) MAX OF 3 NAMES PER LINE@Pq ENTER REPEAT TO REENTER ALL SORT FIELDS OR ENTER C TO CONTINUE OR ENTER A TO ABO@PRT @P ENTER LEVEL BREAK NAMES (LVL1,LVL2,LVL3 (CR)) OR ENTER REPEAT TO REENTER ALL LEVEL @PBREAKS OR ENTER C TO CONTINUE OR EN@PTER A TO ABORT @P SELECT RECORDS. ENTER ALL OR (CR) @Pf ENTER Y IF ALL CONDITIONS MUST BE MET FOR SELECTION ENTER N IF 1 CONDITION IS SUFF@PICIENT FOR SELECTION @P ENTER OPERATION (EQ,NE,GT,LT,GE,LE,RANGE (CR)) OR ENTER REPEAT TO REENTER ALL SELE@P$CTIONS OR ENTER C TO CONTINUE OR ENTE@P8R A TO ABORT @P? ENTER DATA NAME FOR COMPARISON (NAME1 (CR)) @PW IS 2ND COMPARISON FIELD A DATA NAME? ENTER Y OR N @Pr ENTER COMPARISON VALUE (VALUE1 (CR)) OR ENTER RANGE (VALUE1,VALUE2 (CR)) OR ENTE@PR 2ND DATA NAME (NAME2 (CR) NOTE - D@PATE FIELDS MUST BE IN YEAR, MONTH, DAY ORDER, I.E. YYMMDD @P ENTER DATA NAMES FOR RPT (NAME1,NAME2 (CR)) OR MAX OF 3 NAMES PER LINE ENTER RE@PPEAT TO REENTER ALL DATA NAMES OR ENTE@PR C TO CONTINUE OR ENTER A TO ABORT @P" ENTER REPORT TITLE - 30 CHARACTERS MAX @P7 ENTER REPEAT TO REENTER REPORT TITLE OR ENTER C TO CONTINUE OR ENTER A TO ABORT @P INVALID RESPONSE REENTER @P NO PGM NAMES AVAIL CAN NOT SAVE UNTIL RPTPGM IS PURGED RPT000 IS USED @P LAST PGM NAME AVAIL. PURGE RPTPGM BEFORE ANY OTHER PROGRAM IS SAVED @P INVALID NAME XXXXXX REENTER ENTIRE LINE @P NAME EXCEEDS 6 CHARACTERS REENTER @P EXCEEDS MAX OF 3 PER LINE-1ST 3 ONLY PROCESSED @P9 NAME MUST BE FOLLOWED BY AN A OR D REENTER @PQ # OF SORT FIELDS EXCEEDS THE MAX OF 10 ENTER REPEAT OR C OR A @Pr # OF LEVEL BREAKS EXCEEDS THE MAX OF 3 ENTER REPEAT OR C OR A @P # OF OPERATION CODES EXCEEDS THE MAX OF 10 ENTER REPEAT OR C OR A @P VALUE DOES NOT CORRESPOND TO DATA NAME DESC REENTER @P VALUE EXCEEDS THE MAX OF 13 CHARACTERS REENTER @P INVALID OPERATION CODE REENTER @P VALUE 2 NOT GREATER THAN VALUE 1 REENTER @P DATA EXCEEDS PRINT POSITIONS AVAILABLE ON RPT REENTER ALL DATA NAMES @P: QUOTE ILLEGAL IN REPORT TITLE REENTER @PO 2 VALUES NOT VALID UNLESS OPERATION CODE IS RA REENTER @Pm MUST ENTER 2 VALUES FOR OPERATION CODE RA REENTER @Pb NEXT @P(0(06*V8l@PLJ.&0BBF84$.J2*<6@PRPTG,@P hȹ ȵ 1ȱ Ȭ ȧ Ȣ T118Ȗ@P0ØȏT1\10TK100 " d@PC0ӔԔ0""\3@Pn0ld0ddd0d0d dlT00 T@P^_ld0dd\30`̋  " 1T1@P̍l̘ldT1\12100d\1 d0dT8@P l l 0h dd0d00 2 !Ќ l@P1\1\Q10 ;\1 0d00dd0 d d@PE d1T  T0 1dddd3T1{3 -@Pp TT110 ld0!1T@P̪ ̣ l\1\110k l l\1̉   \@P\3930K$ dTS0\ dTI\@P 1 l\̳ l0 llT{1T3b3@PT0 d0 l 0h@P8@P18\1\101\ 0 d8l l0\ l l @Pch dd0l 2DԌ ! l\1\1r10 <@PT1 0d00dd0 dd dT  T@P0 1dddd3Ti{3-0 T;\@P10m ld!Ṱ ̦ l\1T3@P10D$l̦ d d!dTT0 @P:0l0l*l \3\3bT d @Pel h0@P s@PsT3\3 ld +0d)1\)sl 9l\@PT 1f10d \31\1\9@P\0̎ l 0d 0h̥-̠(̛#̖@P̑0ÔTt\330 1>\;T@P 10f01)\1\?10d00dd00d00T90@P J0dddT3{00-  \\33f@P u*f0+f,έT 3\3WÔ  8f-\@P T1 r100 d002 d003 d001d00  d  d@P $ d dT, -  2 93 " lT3) 9\@P3 \3̺ l 1$ l0(T 1\1O18@P !̰ d̕ l̡, l d\10 0 1 93 # d\) @P L l 1 l lT33 0" l1 \1 T @P1 w107 !ܜ !0$ ḻ T)10), l\@P )10), l1T)), d1\)), d, d d@P d d̏!T )\) ! 4T T v1@P @P @P l̉$ l(\1\1m10T ^30 " l01@P *  r " r0$ d  T )1)0~T 1))u@P T@P Td00dd00d00 " lT D1300dddT3 U{08-@P 0 T 1T 33 ̍0h   1@P @P0 30 002 ̱f.0̯f/̯f0 0l@P @P1 \1\101\\S\1 d0dd0 d0 dTX @P l l h0 dldd0d00 2 IF(ICMP.XX.0) GO TO X00@PJCALL QCST(A,WRKMST,K+XXXX,XXXX,WRKMST,K+XXXX,XXXX,ICMP) @PfCALL QCST(A,WRKMST,K+XXXX,XXXX,IVLXX,1,XXXX,ICMP) @P 200 CALL CCSBLK(EXTREC,132) @PGO TO 300 @PCALL CCSMVA(WRKMST,K+XXXX,XXXX,EXTREC,XXXX,XXX) @PDATA IVLXX/'XXXXXXXXXXXXX '/@PqIF(ICMP.GE.0 .AND. JCMP.LE.0) GO TO 200 @P PROGRAM RPTEXX@Po INTEGER A,N,T @P INTEGER ID(4),LU,ISTAT,EFG,FDEL @P% INTEGER REQBFD(24),IDATDM(15),WRKMST(9000) @P> INTEGER REQBFE(24),IDATEX(15),EXTREC(68) @PV INTEGER IVL01(7),IVL02(7),IVL03(7),IVL04(7) @P INTEGER IVL05(7),IVL06(7),IVL07(7),IVL08(7) @P INTEGER IVL09(7),IVL10(7)  @P INTEGER IVL11(7),IVL12(7),IVL13(7),IVL14(7) @P INTEGER IVL15(7),IVL16(7),IVL17(7),IVL18(7) @P INTEGER IVL19(7),IVL20(7),I(8)  @P C @P EXTERNAL FMRDEL @PC @P DATA REQBFD /24*0/ ,REQBFE /24*0/ @P+ DATA IDATDM /'MMMMMMMMCCS20 ' ,0, 9,0 / @PG DATA IDATEX /'MMMMMMMMCCS20 ' ,0,1,0/ @Pb DATA EFG /0 / @Py DATA A,N,T/ $41,$4E,$54 / @PlC @Pm CALL PGMIN(ID,LU,MODE,NPORT)@P~ ASSEM $C000,FMRDEL,$6400,+FDEL@P CALL OPENFL(REQBFD,IDATDM,ISTAT)@P REQBFD(23) = 1@P IF(ISTAT.GE.0) GO TO 50 @P CALL FILERR(IDATDM,3,ISTAT,LU)@P GO TO 850 @P 50 CALL OPENFL(REQBFE,IDATEX,ISTAT)@P IF(ISTAT.GE.0) GO TO 100@P CALL FILERR(IDATEX,3,ISTAT,LU)@P GO TO 850 @PC @P 100 CALL GETS(REQBFD,WRKMST,I,ISTAT)@P& IF(AND(ISTAT,$8100).EQ.$8100) GO TO 850 @P= IF(AND(ISTAT,$100).EQ.$100) EFG = 1 @PR IF(ISTAT.GE.0) GO TO 115@Pa CALL FILERR(IDATDM,14,ISTAT,LU) @Pt GO TO 850 @P|C @P} 115 DO 300 M = 1,9 @P J = 1000*M-999@P K = 2*J-1 @P IF(WRKMST(J).EQ.$2020.OR.WRKMST(J).EQ.FDEL) GO TO 300 @P CALL PUTS(REQBFE,EXTREC,1,ISTAT)@P IF(ISTAT.GE.0) GO TO 300@P CALL FILERR(IDATEX,11,ISTAT,LU) @P GO TO 850 @P 300 CONTINUE@P IF(EFG.EQ.1) GO TO 850@P CALL CCSBLK(WRKMST,18000) @P GO TO 100 @P" 850 CALL CLOSFL(REQBFD,ISTAT) @P2 CALL CLOSFL(REQBFE,ISTAT) @PB 900 CALL PGMOUT @PK END @PP*JOB, @PS*K,P2 @PV*FTN@PX MON@PZ*LIBEDT @P^*K,I08,P08@Pc*P,F,2@Pf*K,I08@Pi*N,RPTEXX,,,B @Pp*Z@PhThhhT1 "T hT h\@P\Pș Ph\Sȏ Ph\Vȅ Ph\ Pl@P\ Pl\o Pl\ Pl\% Pl "p@P?4dHd l\>̿ Pl\V̵ Pl\̫ PlT@Pj̠ Pl\̖ Pl\̌ Pl\̂ Pl\ @P Pl\  Pl\ Pl\ Pl\6+@P\:G\+ Pl\G̿ Pl\b̵ Pl\y@P̫ Pl "p4dd0)  dld0!c Ad@P0 , RT1Ti1 1hH\) q h=\ q Pl@P A( & d\1\1̱ h\) q h\ q Pl@P l̚ "lܚ@P r̿ "p4d & dG l\l̤ Pl\m̚ PlT ~@P ̏ Pl\ Pl\ Pl\ Pl\@P  Pl "p sdẊ lT @P x1̈ \1\ l:\1f1\f\f@P  l l̴l\>l( @ l@P lT R>ldBdH\> dl l\>@P lκ 6̺ !̜l̼l\> ll̬l\@P $>l̮l̰l\>l( @Ȕ  ̏@P Ol lT >?lkdBdH\> udVll@P z\>?lEκ 7̺ "l̻l\> l(l@P ̫l\>?ḽl̯l\>?l0( ?0Ȕ @P ̣l lT T>?ldBdH\> d̙l@P l\>?l !̄ll\>ll̴l\>@P&?ll̷l\>?l@P +?@P Z?@P ?@P ?@P ?@P +?@P ;?@P? "l AdX@P K@P0KȔ  \]ln@P ]@P]T  dml^ ld l0!b\1T3 {08 @P"1T  4\ 54$5 d3T w31\1\1\@P\1\1\d1\ ̡l l  d\@P PlT^ Pl\ Pl\ Pl\@P  Pl\ Pl\ ̺ Pl\̰ Pl\"@P4̦ Pl\2̜ Pl\B̒ Pl\K̈ Pl "p4dbd@P_i d\X PlTZ Pl\^ Pl\c@P Pl\f Pl\1i\i̽ Pl\p̳ Pl "@Ppd0?\v4l̤l@Pd:\s140dDḷlli  2X d"^  d@Pnjdd6lTZs4ldIdJd0Kd0M d*@P Xl0 H d!Cll\s4̛l̽lT^_l $  d@P15\T4\3^\^14\14ܺ v@P`dld6d:Ty4dDdIdJ0dK8d<@Pd=d>\140 7d l!/̽l̿l\y14@PlT0(^00_dE̢lll\4\^14]܄ľl\|@P4ddd1Tp49ld06\|4l@P ll\140ld<0d=0d>\v43d @P7 d"̼llll 0dTs04\4$  d@P1b\ 4Ԍ dddT14l0d6d:\m94@P\ 14d0IdJl̗ Yl̾ l\p4̳@Pl̰ l ̈l\14dc, l̬l̓ l\m4 @PA dM\ 14̠l̢ ll3̽$ l !28d6@PԌ d:Ttm4A l\1 4dI dJ:l@P9Yll l\140dD0dE0dF@P@\@P\wd̩l0d<0d=0d>\v4d 2l "W@P̆ dd dd60d:Ty14llldIl@PdKlll 0 d\14ld0l ; d!@Pv̸l̪l\y14̦dDT^_dE̠ld0J̼d< 0 l\4@P1\^4"0 ;Qdd6d:T4̊l̋d0 =̋d>@P3\4ld\4\14܇̪ +el l\@P^4l̪ d 19 l!5̤ld8d9Ԅld@P<flKl\y140 dD0/dI0dJ0(dK@P@P@P8@P0 A hh l0 !5d6T$m4\148 dIT@P^_dJ h1\4 hCܓ hl\p4 @P0 dN0dO* 4ḏl\y4dDdIdJdKd<@P0 ,d=0d> Yl̇ld<d=d>T4MdDQlpl@P W yl]d6d8`d9\14d0D]d0E l= d6\p@P 4dN9dO h$d6d<Vd=\v148 @P u h!q hh hl0)d70d:T Fs@P 4dDdIdJdKF 2 h !,l8d7@P d:\s140dD0dIT0^00_dJ #dqܒ 0h @P .l" X hQ hG{h lhd6 d7@P Y6 wlT y4mdD# VdD OdE  SdF@P d0I?d0J`d0KFd0<Cd0=@d0>\4 N h @P h0 !Dd069d07 d0:\y4dDT ^ _dE@P d00I_d0Jd0@P(d0H PPGGN2PPBINASCASCBINPUTS 4CCSBLK@CCSPUTQCCSMVAREADR CCSGET P PAPGSEDT B97 F CCS CCS 3.0 SL-149@PCAREPEAT    l @P' l lHTTh\h h h hPPGSEDT/PQ8PKUP5Q8PREP2P PZPGSJL B98 F CCS CCS 3.0 SL-149@P@PT hh h?TT@P/h h=\\@PCHTTh\h\h\h\h\hPPGSJL FPQ8PKUPLQ8PREPICCSBLKCCSGET!CCSPUT&P PjPGSJR B99 F CCS CCS 3.0 SL-149@P00@P hj 1 h hh h!TT@P= hh h=\\ؿ@PSHTTh\h\h\h\h\hPPGSJR VPQ8PKUP\Q8PREPYCCSGET-CCSPUT2P PH}PGSLST C01 F CCS CCS 3.0 SL-149@P@P(@P@Pvw D@P ")@P @PPGGEN REPORT GENERATOR DATA NAME LIST @P @P @P STARTING DATA EDIT DEC SUB S@PTK\K ddd3T{3̗Ԝ̐ "- Ք@Pi "ܹT^_dC dd df B1T@PTl lJn B1l ln B1l  l@Pn B1lTl lnܫ 71l lGnܜ 71@Pl\ d0d0d0d0 d0 d0 d0 dT=@PTB\\\\\\ d d d @P@f 1 Ml 1l lT l l 1Qd%@Pi@Pi@Pi@PiT8@Pbp@P1p\;@P]u@PuHlPPGSLSTxPAMONTO.ADAYTO8AYERTO3BINASCsREADR CCSMVAQCCSGETCCSPUTGETS RFWRITEDISP CCSBLKFILERRjP __n B1lTl lnܫ 71l lGnܜ 71@Pl\ d0d0d0d0 d0 d0 d0 dT=@PTB\\\\\\ d d d @P@f 1 Ml 1l lT l l 1Qd%@Pi@Pi@Pi(~;~ L5J.GTSYSPCCS149 P(*JOB,, GTSYSP INSTALL 08/27/84 00010*K,L14 00020*CTO, GTSYSP WEAVED AS OF 08/27/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO BNGTSYSP, CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=BNGTSYSP,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120GTSYSP DCK/ I=13,H 00130GTSYSP HOL/ 00140 SUBROUTINE GTSYSP( IPARM,IPOS ) 00150 1 /CCS3.0 SUBROUTINE GTSYSP SL-XXX 001601 00170C** CYBERCREDIT FINANCIAL SERVICES. 00180C** CYBERCREDIT FIELD SUPPORT GROUPS 00190C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00200C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00210C** 00220C** ************ 04/06/84 ************ PROGRAMMER : RWE 002301 00240C**** PROGRAM DESCRIPTION : GET SYSTEM PARAMETER FROM THE 00250C EXTERNAL FLAG RECORD IN THE UTIFIL. 002601 00270C*** CALLING SEQUENCE : CALL GTSYSP( IPARM,IPOS ) 002801 00290C PARAMETERS 003001 00310C IPARM : RETURNED VALUE ($0 TO $F WHICH IS 0 TO 15 DECIMAL) 00320C WHICH IS RETRIEVED FROM THE 'EXTERNAL FLAG RECORD' 00330C IN THE UTIFIL. 00340C IPOS : THE STARTING BYTE OF THE FLAG IN THE FLAG RECORD. 00350C ( SEE LAYOUT OF 'EXTERNAL FLAG RECORD' ) 003601 00370C EXAMPLE : CALL GTSYSP( IMODE,30 ) 00380C THIS WOULD RETRIEVE THE FLAG 2 FOR THE 00390C LTRSTA PROGRAM AND SET THE IMODE FLAG FOR 00400C SUBROUTINE GETGRP 00410C LTRSTA FLAGS START IN POS. 29, THERE ARE 4 FLAGS 00420C FLAG 1 = IWAY FOR SUBROUTINE PRTORF 00430C FLAG 2 = IMODE FOR SUBROUTINE GETGRP 00440C FLAG 3 = 00450C FLAG 4 = 004601 00470 INTEGER IPARM,IPOS 00480 +, SYSREC(42),SYSP(2),IGOT 004901 00500 DATA SYSP /'SYSP'/, IGOT / 0/ 005101 00520C**** 00530C**** BEGIN PROGRAM ....... 005401 00550 IF ( IGOT.NE.0 ) GO TO 100 00560 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 00570 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 00580 IGOT = 1 005901 00600 100 CONTINUE 00610 CALL CCSGET( SYSREC,IPOS,IFLG ) 006201 00630 IPARM = AND( IFLG,$F ) 00640 RETURN 00650 END 00660 END/ 00670 END/ 00680*REW,7 00690*K,I7,P21,L14 00700*FTN 00710*EOF 00720*CLOSE 00730*K,I13,L14 00740*Z 00750*Z 00760__ 00520C**** 00530C**** BEGIN PROGRAM ....... 005401 00550 IF ( IGOT.NE.0 ) GO TO 100 00560 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 00570 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 00580 IGOT = 1 005901 00600 100 CONTINUE 00610 CALL CCSGET( SYSREC,IPOS,IFLG ) 006201 00630 IPARM = AND( IFLG,$F ) 00640 RETURN 00650 END 00660 END/ 00670 END/ 00680*REW,7 00690*K,I7,P21,L14 00700*FTN 00710*EOF 00720*CLOSE 00730*K,I13,L14 00740*Z 00750<>^Y 4@gB.COLECTCCS149 x999999050283< PCOLECT A12 A CCS CCS 3.0 SL-149@PPCOLECTPFCOLECP PQ8QBDS B18 F CCS CCS 3.0 SL-149@P0DELQMST CCS20  @P0SCRNFILECCS20  @P0TRANFL CCS20  @P0-DLYASSN CCS20  @P0@P8p@P8,@P8@P0  @P0  P PPACTEDT B02 F CCS CCS 3.0 SL-149@P hhT h h hT0 h 1\0@P. h h\0HTThhhh\hhhhPACTEDT>PQ8PKUPDQ8PREPAEDIT CCSMVAP P)CHSCRN B25 F CCS CCS 3.0 PSrPD SL-149@P@PR@PT @PN<@PDL@P4@,@P6UH'@P_@P9@PADDACT CCS20  @PSREQDL CCS20  @P%UPHSTCM CCS20  @PJ9999999999@P:0Nl1E(@PI @PVT1O 95 2H   \3O  T@P3333\33dd h fر 1 9T@PK̼7 \10%K0K !p 3T3K :T0K dO l̕ @PT3OKI \%O3KIT0Tl "T3\3TWQQ @P 93 !T0l d03O\Q ̴ l lT !̪ ! , l@P-G !A0DdM=RdN 8 dP\1PSS GlT3O3;EL@P0XL 0#lTS3P3TO 1'T04@Pv T30Of\1fTJ0TL g3\f30OQ"h\ǀ@P3M03M\O33MMh\38OM@PMH 5@P3\E01T800Od6 T`30E5l @P_TP3309L\33 h<\4 dP f0 1T18K@PK !0#L 0p T30K !T0K \3198@P5 l dOTOK0IT ldI!;Q찖9  쨖: 2 j̡:@P`hT3M@PiM ; 2~̌;h\38E@P}P  0d dd0ud0N     \@P3OM3MM lT3O3N l  l00dp4U,d 0d4p<@P 0ȌlTT3I33MJ@P@PTo0m@P@P0 4Te T^ 6 3T'H$TThhhhh@PhQhc\ hYhv hS hh'.PCHSCRNPQ8PKUP Q8PREPCCSGETCCSMVAcOPENFL PUTS CLOSFL&FILERR !:T@P@P U ! d lfn ,3l\I3U3J l@P@P d} l lT3B}KITT3KHPDAAASCPOPENFLCCSMVA,READR CCSCSTGETACFGETS  CCSBLK9ACTEDT=WTREADADISPLY[ICHENTgEACTSQvEATRNG|PCPROCPFILERRCLANEXCLOSFLP P,DISPLY B43 F CCS CCS 3.0 PSRD .VERFY INP. SL-149@P_@P99999999990000000000@P (@P @P  @PENTER ITEM,CHANGE OR NEXT FUNCTION OR ACTION,RESULT,LETTER REQUEST,COMMENTENTER NEXT F@P/UNCTION OR ACTION,RESULT,LETTER REQUEST,@PCCOMMENTINVALID REQUEST, PLEASE REENTER@PVJK;@Pa dB " Y<!9 =d0 d00d l)hTr\00KK0 @P " h 13TI333J@Ph  2h0՜ 2%h3T3 ܔܓ\@PҀh\@P3d]\33h\@P3 d^"! ,{ y @sKJp0dO8dMT@PO13MM^ ! \3OM1M^ "κ 1? #̓@PJ lY_\ dPd]Q dK3Tv3K l ul@PuT0T0 PllΑl dd Odd $8dM@Pl   T3OM10M ̝h\@P3OMM̔l՜ llM\ h hT@P@P T\3δ d^ l d 2 d ld] @P3\1 l@P@P@P@P d0MTI33M30J l1@Ph,@P, $ ld d00d0̒Vh̎Vh ̊UhT@PM@PP\V l@PV@PV L$]l3\10̏ lTv3\I33M30J0J \333 l@P d^T^`` #0l l̼9\1^`  lD dM\^M@P3ll l̛!\^` }3 %1T^0ܻ@P@P@P d\K  l1T\3KIT@P@P0 ' T & \E & \E & & 3dH@PX@PHTThhh\hhhh6PDISPLYPQ8PKUPQ8PREPREADR WTREADCCSMVAICCSCSTGETACFfCCSBLKhACTEDTzEDIT CCSTIMCCSGETCCSPUTFILERRPCLANEXGETCHFP PEACTSQ B48 F CCS CCS 3.0 PSRD 02/28/1 SL-149@P@Pm@P@P50617@P9:832@P 4;@P NA@P0uh   0h0 hlT0! hDf 1@P@Rd'Sd(0d$T1 Ƚ mȹ 0h h\ ȫ T3;%@P0k 1h\ ș Iȕ h1ؑ\   d& \@P $ ̷l0dM 1֜ 0%l\13M)3MT@P3$%300 %0l%  0   Tf@P3E30 YlT 3TTK3  3\30 d\ @P/\\333G0l0F &00E  0#l h8;\ @PBu l 0l0TGh%\ "l3Tḑ$0lo0 7̙ 4 @Pm 6T @PvܙT133T330L L %\0m\ ̚0 0 _T@P1 & \0T1     \@P00l\1 \\1 \1 99 6 93 &T@Pq d d00  l 2l 21 0d&\3 ̝ @P"̘  lT  _ l\1   T333 l;0\@P3M00Gl3\30̪F &E  #0l du\ 39u@PxT3 %T1%\ ̥  ̢ Tx00&d0\ 8 @P  T03) !0 0\ dM $\3T@P3@33M)M$ y00% y \330T0̰ wT@P3)  d0f0 1 00d00d0Gl0F %E @P$ 0#l0dTNGdu\l3TVl$0Ôlo 8̵ 5 !@PO3\0\E0 d3\l0 lTu0  0\El̤d ǜ"̯@PzlT30l d0 f0 1\)3300&0 \31 \@P33T100lT0dKT3!v00K dQ l@P%@PZ@P}@P@P@P@P0H   ܦT @P@P@P0d0H6PEACTSQPCCSBLKCCSGETCCSMVAfAVMVACCCSPUTDISPLYICCSAD/ICALJL8PIKAMTCCSCST~IDATVRzJULCAL|SAVTRNPUTACFP P,EATRNG B49 F CCS CCS 3.0 PSrPD SL-149@Pm@P@PFGHJK@PLMNOP@P QRSTU@PVWX@PNA@P0uh   0hT0!T000d$\d0%T3;$%@PF 6 ȴhh   ֔0   TE@P3q3 YhT0\3\3000 d0GlF %̛@PE ̖ #l0 h0\3T0Gh%\"lT3d$l@Po 7 4  6T2@P\3T3T3330L L $0\0\00 0 |T@P3o10\  0\3T3\ * 7 #@P0 $0\  d d0  l 2l 21 ̨d&T 9\@P[     \ ̽l\  AT338@P l0GlF &E  $d d\3@PT0 2\ \̸ T300  TT@P̺0 ̔ \  < 0l\0 $l@PT~33)0$ 0w%0 w0  39\33\0 @P2u\33000 d0GlF &E  #8l @P]d\3T0Gl\lT3d$l0o 8 5  !5@PT0\E0 d3\l0 lT00\El̘l#̦d@PT30d l0Df0 ܯ 1Rd'Sd( lfܜ 1Ty@P0\33)3& 1\3\3330lTdK;T!v@P0 K dQ l@P+@PP@PU@P0H   ܘT@P\ @Pf @P0 d0HPEATRNG'PCCSBLK.DISPLYAVMVAC@CCSMVACCSPUTICCSADgICALJLoPIKAMTCCSCSTCCSGETIDATVRJULCALSAVTRNPUTACFP PTFCOLEC B51 F CCS CCS 3.0 SL-149@P@P@P1@P**A $@P@P@P ^s@P C,@P#!E @P'A@Pc&@P* B,%N,@P/OLPM@PZ@Pd@Pa#@P "@P@PLTR1LTR2@P@PeACTVERTBCCS20  @PtCOSIGNERCCS20  @PDAQUE CCS20  @PUTIFIL CCS20  @PT1IT3rKK (3T3KITT)0  1\T3  d@Pp d0T3301\0K "T33K0Ť ̾ ̷ @P"dd0ȑdT\Z3<K̠ !#T33ZK̖$ ̏ !T@P3AZK d 0fY 1 d lT<K0IT00dR00dS̲d̳d@Pl d0 (d ľhT 0U %̻ Al@PTVܯ 1T1/00KK0 } v !o0T  d\@P0d\00do\10\3K֬ל UЬ O !H d d0ܔ @P f 13\K̩ ̣ ̝ ! lל  @Pn 13TAK@P@P d@P"@P" l lTX3KIT^ 0dE dF d0GTE0l d  ;@PMl0 0l d f0 1T10eK0K !!3T3fK !\@PxK d0T  1 l l l\e0KI\VdfWdg d@Pd l nܬ 1\K̳ !)T33fK0̩ ̢ ̜ !@Pdd dT0K d lT(0KIT. lT3cZK8 dp@PK &\K0I\\3K 1&\3KI\ d\3KK  3  l\K@P3$KI3\\-0K &\-K0I\Ta  +  $@PO- & 0\(\ " "1 T0K  l d@Pz Tm1K lK  !d V U @Pެߜ ddT33lT30vK 08G @PF E 0nH 0d0d dQ̜  d@PTp0K0K % d%d 4 lx laT "5 @P&  d` " lT3`q1` d f0 1 dTtK l@P0Qd̮ !pT3|f0K̤ [̝ !b l $ dT}̐ T@P1|q`1`LL $̴ \ 1 T06 ̎ \3  @P3\ܑ 1T3430T0K0\K\,s l lTt8KIT@P@PT@P3\33 d d d@P@PTZ30K00K     2 lT0d &T@Pc$@P@P3\330T%ˬ̜  ƬΜ \0\,00 !=H*d@P@\0Td  4\0"! 1b&w@Pk0\T\#0T0̼H'l0\2 1   , d@PfAfB d l < d6l3l " ln @P " edd  l l f 1TKtKK "@PT330f\1fT33fK0 d ܤ 49T@PT 0\ 3TxEp ? ;T\1T010K̫ 1% @PBd̢ $ l~0\ \ \0E 3T0K̊ $ lfQd;TK@PmJ@Pb @PoT@Pc@Ps d  l5lj@Pd@Pe@Pf@PT\3@Pd@Pg @P  6l lW@P@P@P@P $0U  6T0%Tl ldfVdg !d @P l d1S l@Ph`@PT3.0̦  l ld@Pis@P\b3Tl@Pj{@Pl@PT[@P@P@P0p TZZ3K d00QK * d ?@P@P̲ !%2BdCd $2dM3\3M03M ,l\B3MB0M l l@P3llllll 3# l l d0lHmPFCOLECOPAMONTO1ADAYTO6AYERTO;PGMIN OPENFLFILERRCLANEXDISPLYCCSGETrCCSMVAREADR CCSTIMWRITER8CLOSFLjPCCSPUT,ICCSADICALJL?GETS XGETACFNMSRCHCCSCST{ICHEKQ ICHENTEDAAASCrCHSCRNCCSBLKUPDRECEATRNGpPPCPROCEACTSQP P`GETCHF B57 F CCS CCS 3.0 SL-149@P hdl 2 h@PhT@Ph !h ( h` n - nn@P=!@ HHTT h h h h h h\ h h hPGETCHFAPQ8PKUPIQ8PREPFICCSADP PPICHEKQ B62 F CCS CCS 3.0 SL-149@PALL @P  7nH 0.U  0V  h h ( h @P0  h @P9 1 hȾ H TTh hPICHEKQDPQ8PKUPJQ8PREPGP PkICHENT B63 F CCS CCS 3.0 SL-149@P DADCDFNARLCSEADSP1P2P3NQOASS@P h9 @P0  > h0T80  h)h׈h 1 ȼ ȹ  ȶ @PKȳ Ȱ  h Ȫ   hȡ HTThPICHENTaPQ8PKUPgQ8PREPdP P[NMSRCH B83 F CCS CCS 3.0 SL-149@P@P@P?0#<@P @PB@P END OF SEARCH@P@P dgfhl0h h " h  hTq0T13q h@P0Fpf0e 1 h "ȽhTI3330JT3Zf00KK0  "@PqCPYIND B34 F CCS CCS 3.0 PSrPD SL-149@P@P7"@P:  @PC@PG' @POd & @PT@P@P3@P2@P@P/@P  @P  @PINDEX FILE COPY (MAX 2000 BYTES)@P FILE NAME TO COPY FROM @P VOLUME NAME @P FILE NAME TO COPY TO @P OWNER NAME @P XXXXXXXX FILE COULD NOT BE LOCATED@P XXXXXXXX FILE NOT INDEX FILE@P FILE DESCRIPTION NOT THE SAME @PTT456hgT47879T:\47;7:9T:@P:\:\47=7:9\:>:\:\47?7:9\: @:\@P:\47A7:9\: :\:\47=7:9\: >:\:@P\47?7:9\: @:TBBC (TDB4 T/@P B '\ B4\/ B՜ '\ DB4T2@P+B̽ '\EB4\/2eB̭ '\ EB4e ) j @PV) dFd ) 1d1TiGTBBH 3I@P  *TJB4 ldK dL!D , dM h6̣(3d N@P ,\Oh"T{ h\1G1T/GB̦ '\ PB@P4[@P3ܹ Q\:Q:T_47R79>\ :Q:\47R7@P9-\:Q:\47S79\ :Q:\47S79 \4787@P09TB\/B@P:@P:@P%:@P:TTPCPYINDPQ8STP =FMRDEL[PGMIN UWTREADCCSBLKmCCSMVAOPENFLFILERRCLEAR GETFCB'GETS qWRITERCLOSFL4PGMOUT;PCPYIND__+B̽ '\EB4\/2eB̭ '\ EB4e ) j @PV) dFd ) 1d1TiGTBBH 3I@P  *TJB4 ldK dL!D , dM h6̣(3d N@P ,\Oh"T{ h\1G1T/GB̦ '\ PB<KX* -n/B.DMPFILCCS149 x032883< PeDMPFIL B45 F CCS CCS 3.0 . - PSRD 03/83 SL-149@P@P@P@PȀ@P"N @P(& @P@P @P@Pn@P@P000000000000@P~ @P0000000001@P@PY @Pp@P DUMP FILE TO TAPE @P' INPUT FILE NAME @P2 VOLUME NAME @P; *****OPERATOR-MOUNT TAPE FOR XXXXXXXX ON UNIT 0 WITH RING READY (Y/N) @Pb FILE COULD NOT BE LOCATED @Pq RECORD EXCEEDS 2000 CHARACTERS @P THIS IS A SUPERVISOR COMMAND ONLY @P *****OPERATOR-REWIND TAPE ON UNIT 0 @P RECORDS WRITTEN TO TAPE@Pd `dTz TpTp\'p y@P ȶ Tp~\p\2pȞ \p~T~@P2Ȕ .ȑ/T~h&h$T  '\~@P] dd̜"9pPEDIT PQ8PKUPQ8PREPCCSGETNCCSPUTZP __] dd̜"9pJ \!H\ H  l\@PHF\\J \H\ H  l\HF\\J Ti@PH\H l\HF\!HT\ d d  d@P)d $ d $ ddTID   6  d@PT!fT ̾dܹܺ\ l̺ h T@P@P l" ̗n\ Z̏l d̒ h\̈l\@P̯ d\̦l l\̝ d  h\  l@P h\  l\" ܳܲT\ l̚  @P ̦ diܞtܙ 2' l $ d' a`Hd@P 0d  $ l(Hld   ' )̳ Tz@P [  ̨ \  ̞ \!!\"  \܎@P 1 l , d $ d"PTH d" 9 &@P dH!lll dTHFTl̽ dT Z@P #H # l\HF\ܜ 1\H \!H l\HF \\J@P  \!H !l\ H$ \HF\T J \H >l\@P 2%H$%\HF\\J \H\!H$! ]dT H FT @P ]\J T !H\&H$& zl\HF\,@+H(H%TT@P h$\hhhhhhhhhhhhhWPLTPRNT PQ8PKUP Q8PREP PGMIN (CCSBLK "CCSCST=CCSMVA aFWRITE TDISP \LTRDTECCSGETP __̯ d\̦l l\̝ d  h\  l@P h\  l\" ܳܲT\ l̚  @P ̦ diܞtܙ 2' l $ d' a`Hd@P 0d  $ l(Hld   ' )̳ Tz@P [  ̨ \  ̞ \!!\"  \܎<X nB.LTRBLDCCS149 x032883< PLTRBLD B75 F CCS CCS 3.0 .LA PSR 07/83 SL-149@P@P@P@P@P(@P)3Kd 0@PPQ<"@P0,/@PU@P@P 2@P  @P @P2000*'&@P @P F@P"@P@PE******************************************************************************** @Pp  @P  @P @P  @P  @P  @P @P>  @Pi @P} @P  @P @P @P@P)@P=@PLTRDESC @PFLALTRDSC  @PULARPTTBL  @PdLALTRFIL  @PsLAUTIFIL  @PA*A, ,@P @P@**1 @PD=F @PHDR1HDR2HDR3@PEND LTR1@PLTR296@P9M@P99*@P$@P** @P @P2@P@PN@P @P1@PV@P@PEXPECTED "*A," - FOUND " ". @PFOUND AN ILLEGAL BLANK IN PARAMETER " ". @PEXPECTED LETTER NUMBER - FOUND A "COMMA". @P&DUPLICATE KEY - LETTER NUMBER XX ALEADY PRESENT @P>EXPECTED "END" FOUND " ". @PLFORMAT MISSING "=" SIGN @PXFIELD DESCRIPTION EXCEEDS LIMIT OF 9. @PkEXPECTED "F" - FOUND " ". @PxEXPECTED NUMBER WITH RANGE OF 01-99 FOUND " ". @PEXCEEDED PARAMETER LIMIT ON PARAMETER # . @PLINE NUMBER IN FIELD DESCRIPTION EXCEEDS 24.@PCOLUMN NUMBER PLUS FIELD LENGTH EXCEEDS 54. @PILLEGAL CHARACTER - FOUND " ".@PILLEGAL USE OF PARAM 5. TYPE FIELD DOES NOT = A.@PUNABLE TO LOCATE FIELD NAME " " IN RPTTBL @PUNABLE TO LOCATE LINE CONTROL OR CONTROL INVALID. @P*NUMBER OF LETTERS EXCEED 50 @P82@P:NUMBER OF LINES EXCEED 24 @PGMAX. LINE NUMBER FIELD EXCEEDS LETTER SIZE. @P]UNABLE TO LOCATE LTRX IN THE UTIFIL @Pp LETTER FILE BUILD @PPAGE@PAS OF:@P**2 @PT Y @P00 @P @P"TȪ  dTsȟ Tss\UU\d@PMd\FTF (TF\>U '\UT@Pxh\Td d f 1\d '\d\.s̻@P '\s dT̨ޜ̡ '\ ddd @Pddddddddd TT<\@P dTT\\\\p\@P $p4d,ddp4d,dlp4d,dld 0h@P O 0Ȉd 0h 0Ȉd dT/ T @P z1\ dTT T\\\@P T l\\\̨ %@P @P \d\ l l\\ lT d@P  G@P \\lT q dT T d\ \@P ) l\\\̆ !̇lT \>\@P T> fl\\\ d\ d hT  9@P 4 1  BHlT 1\T @P \ dT T  ;\=T I\@P d\ l\\d\x\x@P  l\\\ d\Tڤ F (Tb@P +  dddT  B 2̝lT @P V hdT T T d\k\k@P l\\̿ \d\ l\@P \ d d T z d # )1\̞l\L@P ܥ dT _T gT S d\ l̲l@P \  94̶ 1E̲ ̫ ̤ ̝ ̖ @P -W̐ ̉ T i\\̬ ̧ @P X̖ ̝ ̌ ̕  ̌    "@P  \l dT  dd T   @P  \ 1\T>ڤ 14T 'U@P T >d\\\ dT @P T T = d d d-\  lT@P /  Td\$ll ll l d \  l@P Z\  d 7"\ \l\,Ȍd l\ @P U @P Z @P d @P  @P "T  @P < @P   2  2   ; ;@P  ̽  ̺ l̶ r  @P  @P ̺  dT / @P  @P ̓ ̠   6̒  2 3  @P      @Ph@Pv@P@P@P@P -@P @P7T 7"p4d\l" : '0WV lܺ " "@Pb d T   "l\ d̼d  @P "̱ " l\ \ ̑d @P " "d l̼d 7"̒ l\  lܤ̃ @Pl\ TjO@P !@P 5@P̏   d  l d T  (@P@P d!@P (#@P#  2 l l\  @P ;@P;@P;T<"p4d\,d  l\  ܽ l\@Pf@P k@P/k@Pk2w"\l\$l̐ lT  ܌ l\@P@P @P̽  d \  d 7" @P @P l\@P l@P u@P @P @P @P @P @P@P&@P8@P:@PT  0l\\ lR@P @P^@Pc@P\\F@P @P\\\3@P h@P\\'@P @P\T@P @P @P @P\̮ 0l\\̝ l@P P-@P-d dT T @P C@PR@PC@PC  2 @P J@PJ v 2 @P X@PXTl\Xql\\@P Oq@Pq d\ lT  2\L  v@P @P\m  ddd\\Wd d@P\v\v "\2 md\r\ @P>\>l\:\:̏  2d<\@P\9̘l\9l\ \  " N@PC l 5l\\Gkd\\ K@Pnd\4  9" 4" 2  @Pۜ  \dd dl   @P   l ̒l ̌ l\$ l@Pl   d \  2 0" d @Pl\  ,$ l\  l\ ̼ l@PE\  [ l e  &̒l 6@Pp"\ dl l 2p \x @Pl׌l\\b d\\O: l l@Pvd\k\k8 " Tڤ@P 2$\d\Xd\&\&l\@P\ܵ\2\\Fl\\\@PG\\\p\p 4d@Pr,ddp4d,dlp4d,dld 0d 0Ȍd 0l 0@Pd d\c \W 2\I@Pd\l\l\\/\'\\@Pl\=\=fl  "T\? @Pd\*5l\ \ @P 5@P5 d d 2r d"tοm "tηdnnd "r@P`k "oΠlnn̓l l"S 2l̶ 2̱ l̺$@P h\{E Ylh\m@PY\el\YY\QY l 2 l@P\.Y,  2'\s\.Y U@PU 2 \Y\YT.Y 2'\@P Y r\0h 9~h\YOh\@PK\%D\hv fQhl\]!\]@Pvu 2Ohai hU\\T\ \.@PTTPLTRBLDPQ8STP FMRDEL|PGMIN #CCSCST CCSMVA OPENFLYFILERR UTHEADxCLEAR GETS |CCSBLKYFWRITE:DISP BLTRDTE PCCSGET CCSPUTREADR ICCSAD@PwA.@P})B'i"=6@P 3@P0s2jJpPNl(@P @P @P: @P@P  @P  @P*  @P31  @P^ @Pr @Pv  @P @P  @P @P  @P @P3  @P^ @Pr  @P @P  @P @P  @P @P/  @PZ @Pn  @P @P  @P @P  @P @P+  @PV @Pj  @P @P @P @P"  @PM @Pa  @P @P  @P @P  @P @P   @P I @P ]  @P @P  @P @P  @P  @P   @P E @P Y  @P @P  @P @P  @P  @P @P /@P C@P d  @P @P  @P LACOSIGN LADLQMST LALTRFIL  @P LATRNSFL @P COSIGNERDELQMST LTRFIL TRNSFL @P A*@B@P  ,,@P (@P +1 0 @P -D$@P 5F=@P 3EXT @P 6END 9@P :N @P <012@P ?@P BY 00@P D@P G@P F@P H@P K@P N@P LTRF@P @P SALC@P @P @P @P 1234567890123456 @P  DO YOU WISH TO PRINT ALL OF THE LETTERS REQUESTED BY THE COLLECTORS? (Y/N): @P LINE THE * TO THE TOP OF PAGE AND SEVENTH CHARACTER POSITION@P  DO YOU WISH TO HAVE ANOTHER ALIGNMENT LINE PRINTED?  (Y/N) :@P 7 ENTER ACCOUNT NUMBER OF THE NEXT LETTER TO BE PRINTED - (16 DIGITS MAX). @P _ UNABLE TO LOCATE ACCOUNT IN THE DELQMST FILE @P UNABLE TO LOCATE ACCOUNT IN THE TRNSFL FILE @P UNABLE TO LOCATE COLLECTOR TTTT IN UTIFIL. @P LETTER TO BE SENT TO ACCOUNT NUMBER XXXXXXXXXXXXXXXX HAS NOT BEEN PRINTED @P UNABLE TO LOCATE LETTER NUMBER TO BE SENT TO ACCT# . @P UNABLE TO LOCATE ACCOUNT XXXXXXXXXXXXXXXX IN THE COSIGNER FILE @P01 UNABLE TO LOCATE LTRF RECORD IN THE UTIFIL @PGRE: C/O @PKP@P` @Pb@PT I JTQ_eaT fQghȞ T g i\ g i\ g @Pi\ g iTbj\ckTM`LabTUdcM  a ld +md@P ,ThKO " d / d 0 d 1T 4 oo "\ L o@P7 "\  o d 2 "\  o d  " d Ed d Od d T@PbKT3fK\ fg\ pqp\K\rT_ @ s @ rt@P B  : T uvv "u \ w0xw\yz dz@P\ yuv " \0{KTK\r\_ @ r @rt̪@P .̥ T`r 7d \_ @ 7rtT_ @ x @rtt Td@P i Ad d T L o B cT L oo 2 - "@P9T i i|| \ }f <f| \ ~f f|  4\ @Pdi i\_ @ ta J T i\ f d \ L  o̥ @P̞ "\ }f <f|̧ \ ~f f|̛ TUd  T @Pi i\ w w d &T< w whh I\ wwh RT @Puvu Fv "\ w w\ {K +d3T3K ,l\@P3fK\K\3K\ i i\ rK\KA\ ~f fT@P;  \ f f|| T f fT 4 oo 2   ?@Pf  "\ f f\ i i\ rK d Fd Gd Ld Nd Kd@P l d HT{ dT Lf 5f|̟ * l\ L :|̏  @Pld >\ L H l̾ lܷ 1̵l 3 !l !hTV  o@Po ?   2  "TN ii\rK $d @PhJ\\ P 2h@\\ _T n Ph2\\x }x dh(\\y y\@P=  hT;\ \  o̚  ̕ ̐ "@P]\ i _i\ _K\ T  Ô  4 34 @P1Y\ \ P\ _\ n\ }x\y  yT%@P -\ PTC \ _\x }x\y y\ @P\ n +d3T3K ,l\3 (K\K\ kT / Tu k{k@P d\KK d\\\\Gw{wTyy =f|\ f| \@P4 \K d T\v 8 !0 !, l  d\ dg@P_g d\ |  1 3 l l l\ P $|̨ @P' 1T P  d *T  * ||  l 1 lx ̱ d@P\ Pv̦ dl =\ P | ܓ\ P ۄ lLl@Pl =\ P |̸   d ) d\\ P\ |̡ l@P ld *T P ) * ) l\v *댎 lT3KTCK\@P6 8\K\K Ô  \Iw 8w 8 l\ \\ K\@PaK\ _ 8\KT n || \K\ n 8\ K\@PK\ }x 8x̻ d\T y\y\K\KT)3KT/  >d L @Pd d ' dd M $p d $ dd\ L 6|̜  @P4 d 9!f T L  ̶ܹd %ܱܲ\ L l̼ @P l\ M % \ % lΜ"̜n\ LД  q̉l l̗ d\T M@P8 % \ %̋l L\ L̰ d\ Ļd ; l\ L̝ d '  $ @Pc l\ * \ *  *l l l\  \ l l\v \@Pք l\ ;f $  ܝܜT L l ̏ M d %S@P L[ 2 l $ d  `Hdd D@P $p dHld nd  -  . Z   @PT / ̛ ̗ T "\  {T5 \@P: !mT T  % % \   \ q qM\q\  @Pe\  dTo ||  1 d Al\ .f @P  d d\\ \\ %  % 2 l $p l $@P d Cd 'T>K 1" ,d Addl  @Pl  lTK̔ lT0 \ 8\Kܦ 1\3K\K @Pd \ f l 8 d 1*  d\ dgg d lTq@P< ||  1Ԍ l\x\y\K̸ @Pgl\ | TTwTK\w w|̶ \@P\a 3 d\\Tw\w\K\K\Dy ,d@P\K@P@P @Pl@P +d3\3Kl\3fK\K@P@Pl\3fK`@PS@P@P d # l  lT o_ dF@PG@PZ@P l # l  l\ o_ l0@P2@Pl@P 7l # l  l\ o_ l@P;)@P:)@P)@P) Ol #̸ l̵  l\ o_ l@P?@P?@P?@P?@P? l@PB@PyB@PBT 4o\ Lo\ o\ o\oouvf\(oKTTPLTRPRTPQ8STP _ADAYTO AMONTOAYERTO%PGMINTPGMIN CCSCST;CCSMVAGTSYSPPRTORFGETGRPSYSPRTOPENFL)CCSBLKuPWTREADGETUTIREADR GETS )ICKGRPCCSGETLTRDTEBEDIT yIDATVR!FILERRCLOSFLCPGMOUT]PLTRPRT PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP P7GETUTI CCS3.0 SUBROUTINE GETUTI SL-XXX @P@Pk@Pn@PsP(@P{@PLAUTIFIL @Pi@P|g  9  hTbfhgTkblm Tnop h@P f 1Trȼ !G d'h\s)tT8)rȧ Ȣ !@P-Ȟl l\8vv =@Prl l\8x )Tr di! lly{dz #@P l  lTzrfHTTh\hh\h\h\hFPGETUTI"PQ8PKUP(Q8PREP%PGMIN CCSCSTCCSMVAOPENFLREADR CLOSFLFILERRP PPRTORF CCS3.0 SUBROUTINE PRTORF SL-XXX @P@P $@PRP@PI@PJ ** SELECT DIRECTION OF OUTPUT  0 = OUTPUT TO LOGICAL UNIT  1 = OUTPUT @PuTO SYSPRT FILE  @P  PLEASE ENTER SELECTION (0,1) : @P8 IS THIS CORRECT ? (Y/N) : @P+TERMINALPRINTER TAPE DRIVE@P*h)l' '"l""  l   l   l  l@P l  T+\  \/\  \3\@P  \3\TJ\\\n\@P8\\ T*  1!@Pc !d \\ \nT\@P8\  T 3 " lHTT@Ph%h\h\h\h\hPPRTORFPQ8PKUPQ8PREPCCSMVAWTREADCCSGETVGTSYSPP PGETGRP CCS3.0 SUBROUTINE GETGRP SL-XXX @P@P @P'$@P*RP@P.,@P7(@P;#M@PR ** SELECT ACCOUNT GROUP OPTION 0 = ALL ACCOUNT GROUPS  1 = ACCOUNT@P} GROUPS 0-4 ONLY  2 = ACCOUNT GRO@PUPS 5-9 ONLY  PLEASE ENTER SELECTION(0,1,2) :@P * SELECT ACCOUNT GROUPS TO USE SEPARATE GROUPS BY COMMAS,  (I.E. 0,1,@P2,3, ETC...) OR  ENTER A FOR A@PLL GROUPS  PLEASE ENTER SELECTION  -- :@P INVALID ENTRY :  @P+ IS THIS CORRECT ? (Y/N) : 0,1,2,3,4,5,6,7,8,9,A,@P>1h l/TG   ' .ȿ Ⱥ  l \=@Pi@Pq l\= l\=\d !d"\v#$v"hJhT@P'()\'()\'()\'()RdTC@P*\'('+)) *d, Ald-T.-Q  d@P\'d() d/ d0 1R d1!: !1h-T-@@PF2n\21d4 ! !h\-@F2n\ܿ24@PG̓ d5 l8ξ Pܲ̏ H l,!Ω7Hd6 9!6@Pr !2ܔT--- h\FvT'v()d& d@Pp\--d h\F8\'9)e@P^@Pd%Jl\'R()\'d()\'v()\'()@P\*\'('+)) T:*  2:3 ";d@P T'd<) \'v<) \'<)@P;@P;Ty*\'+('+)\:̵ \̵ \@Pc^@P^T= "l̮ 2n l@Pnp@P{p@Pp@PpHTThhhhh\hh\hPGETGRPtPHFLOT Q8PKUPzQ8PREPwCCSMVA ONLY IF NO DATA IS TO @P 7BE USED @P < THERE IS NO RECORD IN THE MASTER FILE FOR THE NUMBER ENTERED RE-ENTER ACCOUNT NUMBE@P gR OR <CR> ONLY OR EX TO EXIT ROUTINE @P z THERE IS NO RECORD IN THE COSIGNER FILE FOR THE NUMBER ENTERED THE SCREEN WILL BE P@P RINTED WITH THE FIELD DESIGNATORS @P T"&'(TQ++ (TQ +&\`3+ '\3 +&\xB+ @P '\B +&T&),-*\&) )8 *8a T8db  @P lTKb+̮6 ̧7  ̡ 1\Q +&\&)  *\&@P G) )8 *`d!T8! !\&) )8 *̩d \&)  )8 * @P rBd T \8  \`c++   1&T 3 +&@P T &) < )8 *8a  9̞ \.  Tc  !Kb @P  ^lT Kb+̵6 ̮7  ̨ 1\Q +&\\&) *@P T .  1/\xc++ ʜ  1T Q +&&@P T &) z *T S.  \c !K@P  9@P 9T`+\+\x+@P C@P C@P C@P : C@P CTTPPRTSCNPQ8STP FPGMIN OPENFL FILERR WTREAD ICCSAD READR CCSMVA )CCSBLK wPRNTIT CCSCST CLOSFL :PGMOUT DPPRTSCN P PRNTIT C07 F CCS CCS 3.0 SL-149@Pd* @PgP@C>AD@P/ ( ) [ ] @P< > @PW0360@P99999999990000000000000000* @P@P @P\@Pj @P.@Pt9 lTjdhT``TlTa  h hĘ@P>h\``\ط@P hȳfخ 81h\``\\d'dS d/h\`@P`\ 1\ke df l  h0 l-iH d0 $j@Pd2dd_ dc"! ,n D [fA@@P*_Tk kc 1^ *\_ c ! ! \_@PUc̷ !f $T_k2v툶hT_k2@P{jTh\h^k2^^ h\@P_k2R@PΑ d)\ l^ ] l_ l@P\\k2\ A2d^ +T_+\+]gk^g l̻ l̴@P ḽ lTh\k2\@P@P l (d1 dc d/̿l9jfܳ l (ld'dS4d`T@P-``Ta TyllKl\``\ 1\ll l@PXcl\``\ܥ 1 l̶nܛ 81}l\``\\l@P\``\ lAd_T_l\``\\ @PdY dZ d[\\n\\\o\\Y\p\\Y]\q\\Yr@P\s\d`T+``T3@P@P3H0TThHhZhnhy\h-\h\h\hh\ h h h h @Phh hxUPPRNTITPQ8PKUPQ8PREPAMONTOAYERTOADAYTOCCSBLK:FWRITEDISP CCSGETCCSCST,CCSMVAEDIT uCCSTIM~HEXDECP __\\k2\ A2d^ +T_+\+]gk^g l̻ l̴@P ḽ lTh\k2\@P@P l (d1 dc d/̿l9jfܳ l (ld'dS4d`T@P-``Ta TyllKl\``\ 1\ll l@PXcl\``\ܥ 1 l̶nܛ 81}l\``\\l@P\``\ lAd_T_l\``\\ @PdY dZ d[\\n\\\o\\Y\p\\Y]\q\\Yr@P\s\d`T+``T3@P@P3H0TThHhZhnhy\h-\h\h\hh\ h h h h <u Wh.JB.QLOAD CCS149 x032883< PQLOAD C11 F CCS CCS 3.0 .LA - PSRD SL-149@P@Ph@Pl ,@Ps @Pz(@P|@P @Pmu0 0@P@PX@P  @P @PYDLYASSN @P#LADLYASN  @P]@P@P ENTER DATE (MMDDYY) OR CR FOR SYSTEM DATE @P READY (CR)@P$ @P'@PS00@PT@P^@PTefgT#hij TYi#i  d&Ȼ  lT #kȵ@P (T#lkeTZeTT@P(A2,2X,20HQUEUE LOADING REPORT,//)@PT\mUmndTeopom]]  T @P!\mm\mUmTUdq !TWdrT2sT 22kk@P3tu /T#vke d lDdw dx" $z@P^dy $|d{2 "  hT2}5} huT2}5@P}~~  d d6h&hT@P d6h\@PS~ 6h\@P 1 1& X % $TZN% dhT@P@P 1Tʀ @P(1H1,2X,20A2) @P\ZP% lh\@P (1\$\@P(1H ,2X,20A2,10X,20HQUEUE LOADING REPORT,35X,6HPAGE: ,I2) @P1\ZR%K )ḽh\@P>ܧ <1\\ \ \@PK(1H ,2X,20A2,13X,7HAS OF: ,A2,1H/,A2,1H/,A2,/)@PbTRT%i;@Pi(1H ,48X,29HNEXT CONTACT DATE AGE BY DAYS,/,10X,5HQUEUE,15X,2H-0,9X,1H0,9X,1H1,9X,1H2,@P9X,1H3,8X,2H+3,9X,6HTOTALS,/) @P dX\ZW%T5\6 d6h\@P 1T@P(1H ,9X,2A2,12X,6(3A2,4X),4X,3A2) @P@P@P 5 f$TcZ]e\\$\\ \ \π-@P(1H ,A2,28X,20HQUEUE LOADING REPORT,16X,6HPAGE: ,I2,/,32X,7HAS OF: ,A2,1H/,A2,1H/,A2,/@P) @P\R_e#@P#(1H ,24X,29HNEXT CONTACT DATE AGE BY DAYS)@P8\Rae>&@P>(1H ,4X,5HQUEUE,7X,2H-0,6X,1H0,6X,1H1,6X,1H2,6X,1H3,5X,2H+3,5X,6HTOTALS,/)@Pc dXTZdeT5\6 d6h\@Pz 1T@P(1H ,4X,2A2,4X,6(3A2,1X),3X,3A2,/)@P 1ndTeoo]]  l d f& 1 y d@PTx2}5}T u p@P@P lT2d{>hT"@Pd !Hqdr &$l %,ld 7 4 d@P  " l " lޚ-5 n]44 ldx#@PY2@P2̙ &̔  dTR d d6h -hT@PS `6d$lm dۀ6hT@PrS~~ ɀ6hT@P 1ܲ 1& /TgZ% d6hTm@P 1T@P(1H ,/,10X,6HTOTALS,10X,6(3A2,4X),4X,3A2) @P*\Ze lҀ6h\@P 1\@P(1H ,4X,6HTOTALS,2X,6(3A2,1X),3X,3A2,//)@P@P@PF@PT kTTPQLOAD PQ8STP Q8QINIQ8QX Q8QENDPGMIN CCSCSTpCCSMVAOPENFLFILERR@UTHEADWTREADIDATVRICALJLICCSADPCCSBLK'GETS +HEXDECPCLOSFLPGMOUTPQLOAD __rS~~ ɀ6hT@P 1ܲ 1& /TgZ% d6hTm@P 1T@P(1H ,/,10X,6HTOTALS,10X,6(3A2,4X),4X,3A2) @P*\Ze lҀ6h\@P 1\@P(1H ,4X,6HTOTALS,2X,6(3A2,1X),3X,3A2,//)@P@P<= @ ;dzB.UPD400CCS149 x032883< PUPD400 A20 A CCS CCS 3.0 SL-149@PPUPD400PFUPD4XP P2Q8QBDS C32 F CCS CCS 3.0 SL-149@P8@P8@P0000000000000000000000000000000@P8 @P8@P0 TRAN ACCOUNT  @P0 @P0 @P0 CODE NUMBER NEW DATA OLD DATA  @P0 ACTION @P0 @P0;  @P0f @P0z  @P8@P8 @P8@P0 <-- HDR1 FROM UTILITY FILE GOES HERE -->  @P0 @P0 @P0<-- HDR2 FROM UTILITY FILE GOES HERE --> DAILY MASTER FILE NON-FINANCIAL UPD@P0%ATE REPORT PAGE @P09 @P0<<-- HDR3 FROM UTILITY FILE GOES HERE --> <-DATE->  @P0g @P0{ @P0ADDACT  @P0|COSIGNER  @P0DELQMST  @P0UP4INPUT  @P0UP4PRINT  @P0UUTIFIL  @P8@P0HDR1@P8B@P8@P8@P8@P0 0000000001@P0000000000000@P0000000000000@P8@P8 @P8!@P8"@P8#@P8$@P8%@P8&@P8' @P8( @P8) @P8* @P8+@P8,@P8-@P8.#@P8/(@P80P@P81@P0000000000000@P0  @P0G @P0[  @P0 @P0  @P0 @P0  @P0 @P0  @P0C @P0W  @P0 @P0  @P0 @P0  @P0 @P0  @P0? @P0S  @P0~ @P0  @P0 @P0  @P0 @P0  @P0; @P0O  @P0z @P0  @P0 @P0  @P0 @P0@P0d@P0@P0@P0@P0@P8@P8@P8@P8@P8 P P2MFUPD4X B55 F CCS CCS 3.0 SL-149@P@P@P0@P N@Pl@P@P @P@P @P$@P(@P,@P0 @P4@P8@P< @P@@PD@PH@PL@PP@PT@PX@P\2@P`P@Pdd@Phi @Pls@Ppw @Pt@Px@P|@P@P@P@P@P @P@P @P@P@P@P@P@P6@PJ@PO @PY@P] @Pg@P@P@P@P@P@P@P@P@P@P@P<@P@PN@P@PTTT0 TTT1 1\!1\" h:0 $(5d , h0/@P" ̜ ! ! - :ȼ 'ȹ 4ȵ T#3T !33  8T;@PM@PO ,hd8 ,hd9 ,hd: ,h T  \!\ @P3z! 3 \;̗ E3T3390 0 3\33%3 @P'T3%30%\33 -3 -T0T3 00  (T30) TT? @PT3389TB 33! 0 TJ;3T0 13Y\,3 \T0 8\"\@P3 !30  \0;A\ 3T33903\339 90 0 0  T@P3&9389\ 33! 00 \;\30d 0 (T3|, 0THPFUPD4XHPUP4INIUP4LABUP4NXTUP4TOTUP4ENDCCCSGETUP4FMLCCSADDUP4PRTUP4GTMqCCSCSTCCSMVA$CCSPUTPUTS PFILERR=CHNGNFUPDRECUP4GTCP P2UP4INI C33 F CCS CCS 3.0 SL-149@P@P T1dd0dT33 ^!00 "d h h"p8@P4n (h 10 3T00  (T30" T0 3 \0 .@P3_\"3 \0 00d\30U  &\U30" \3\ &\33" ;\\d|@P ̽ 3&\|"3 \\30 ̰ &\30" \ dT3-0 ̞ ̙0 ̔@P &\33U* \ B,0vhT3-$/@P0!/0 1H1PUP4INIPAMONTOADAYTOAYERTOPGMIN EDIT OPENFLDFILERRMUP4ENDSREADR CCSMVAP P2UP4LAB C34 F CCS CCS 3.0 SL-149@Px@P0{ . h P( hT7  T3" hT3 0z00 1\@P \3" h3T lHPUP4LABPUP4NXTTAPMOTCCSMVACLOSFLP P2LUP4NXT C35 F CCS CCS 3.0 SL-149@PP@P@P1h T30 0 1'0 T30+ T dT1@P.T0Th  l @P0< THPUP4NXTHPSTATIT2GETS FILERRUP4END"FREAD (DISP 0CCSE2AAP P2fUP4TOT C36 F CCS CCS 3.0 SL-149@P * TOTALS *  @P+ @P? @PD ACCOUNTS NUMBER  @Po @P @P UPDATED  @P @P @P REJECTED  @P @P @P0 5 Bl dT31&%3!%\3&%!0% h h D(߀hT@P7  D(hT@PF 1 1 h D(hT@PZص 1HPUP4TOTbPCCSMVACCSGET5CCSPUTBUP4PRTXP P2GUP4END C37 F CCS CCS 3.0 SL-149@P? T0 0o 0\d 0 0\ 0 0\ 0Ȩ 8\ @P+  3\  3T#THPUP4ENDCPCLOSFLTAPMOT;PGMOUT?P P2@UP4GTM C38 F CCS CCS 3.0 SL-149@PT33#- 0-T30 00  0  (T33* T @P+   d lHPUP4GTM<PCCSMVAREADR FILERRUP4END$P P2@UP4GTC C39 F CCS CCS 3.0 SL-149@PT33#- 0-Td30 00  0  (T33|* T @P+   d lHPUP4GTC<PCCSMVAREADR FILERRUP4END$P P2UP4PRT C40 F CCS CCS 3.0 SL-149@P @P8@P@P \hdh~hhhh 2 l3T !33   d8@P05d09 hT8 T8ؿ 10 T113T;\1@P3`\\<131\T30" 0 (T3) 0T0 &̞ l \@P310\3\10\3\!0 &3\) 0\̥ \1318\\@P0  ̺ &\30) \T1H TThhh4PUP4PRTPQ8PKUPQ8PREPCCSADD*CCSGETAYERTOBCCSCSTECCSMVAP PR9BASE C12 F CCS CCS 3.0 SL-149@PHPR9BASEP PR9FLDL C13 F CCS CCS 3.0 SL-149@PHPR9FLDLP __@P  h\4@P4 \5H2TThbhmhhhh\hZheh\hVhjh\h@PQheh\hIhJhRh\hhhh\ha'PCHNGNF('\ mTFVFYACFCCS149 P032883( SUBROUTINE VFYACF(BUF) 00010 1 /ROUTINE TO VERIFY ACTIVITY BLOCK LENGTH 000202 00030C REVISED 08/05/82 00040C THIS ROUTINE VERIFIES THE LENGTH PORTION OF THE ON-LINE ACTIVITY 00050C BLOCK. IF THE LENGTH EXCEEDS 360 OR CONTAINS AN INVALID CHAR, 00060C THEN THE BLOCK IS BLANKED OUT. 000701 00080 INTEGER BUF(1) 000902 00100C SKIP TEST IF BLOCK IS BLANK 00110 IF(BUF(154).EQ.$2020.AND.BUF(155).EQ.$2020) GO TO 15 001201 00130C VERIFY THAT ALL CHAR OF LENGTH ARE NUMERICS. 00140 DO 10 I = 1,4 00150 CALL CCSGET(BUF(154),I,J) 00160 IF(J.LT.$30.OR.J.GT.$39) GO TO 20 00170 IF(I.EQ.1.AND.J.NE.$30) GO TO 20 00180 10 CONTINUE 001901 00200C VERIFY LENGTH DOES NOT EXCEED MAX OF 360 00210 I = AND(BUF(154),$F) * 100 + ICCSAD(BUF(155)) 00220 IF (I.GT.360) GO TO 20 00230 15 RETURN 002401 00250C ERROR - CLEAR BLOCK & CONTINUE 00260 20 CALL CCSBLK(BUF(154),360) 00270 RETURN 00280 END 00290__ THIS ROUTINE VERIFIES THE LENGTH PORTION OF THE ON-LINE ACTIVITY 00050C BLOCK. IF THE LENGTH EXCEEDS 360 OR CONTAINS AN INVALID CHAR, 00060C THEN THE BLOCK IS BLANKED OUT. 000701 00080 INTEGER BUF(1) 000902 00100C SKIP TEST IF BLOCK IS BLANK 00110 IF(BUF(154).EQ.$2020.AND.BUF(155).EQ.$2020) GO TO 15 001201 00130C VERIFY THAT ALL CHAR OF LENGTH ARE NUMERICS. 00140 DO 10 I = 1,4 00150 CALL CCSGET(BUF(154),I,J) 00160 IF(J.LT.$30.OR.J.GT.$39) GO TO 20 00170 IF(I.EQ.1.AND.J.NE.$30) GO TO 20 00180 10 CONTINUE 001901 00200C VERIFY LENGTH DOES NOT EXCEED MAX OF 360 00210 I = AND(BUF(154),$F) * 100 + ICCSAD(BUF(155)) 00220 IF (I.GT.360) GO TO 20 00230 15 RETURN 002401 00250( '  I.UPDATECCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING UPDATE FROM B.UPDATE, CCS149 FILE 00030*OPEN,FN=B.UPDATE,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,UPDATE,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM UPDATE HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00200C VERIFY LENGTH DOES NOT EXCEED MAX OF 360 00210 I = AND(BUF(154),$F) * 100 + ICCSAD(BUF(155)) 00220 IF (I.GT.360) GO TO 20 00230 15 RETURN 002401 00250( C c?J.CHEKIDCCS149 P(*JOB,,TWB.JOB CHEKID INSTALL 08/23/84 00010*K,L14 00020*CTO, CHEKID WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.CHEKID , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.CHEKID,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CHEKID DCK/ I,H 00130 INS/ 23 00140C**** PRINT OUT DAY,DATE,TIME,ID 00150 CALL STIME 00160STIME DCK/ I=13,H 00170STIME HOL/ 00180 SUBROUTINE STIME 00190 1 /CCS 3.0 TIME CHECK SUBROUTINE 00200C 00210C 00220 INTEGER ID(4),LU(1),MODE(1),PORT(1) 00230 INTEGER DY(5,7),MO(5),TU(5),WE(5),TH(5),FR(5),SA(5),SU(5) 00240 EQUIVALENCE (DY(1,1),MO(1)),(DY(1,2),TU(1)),(DY(1,3),WE(1)) 00250 EQUIVALENCE (DY(1,4),TH(1)),(DY(1,5),FR(1)) 00260 EQUIVALENCE (DY(1,6),SA(1)),(DY(1,7),SU(1)) 00270 DATA MO/'MONDAY '/,TU/'TUESDAY '/,WE/'WEDNESDAY '/ 00280 DATA TH/'THURSDAY '/,FR/'FRIDAY '/,SA/'SATURDAY '/ 00290 DATA SU/'SUNDAY '/ 00300C 00310 EXTERNAL AYERTO,AMONTO,ADAYTO,HORTO,MINTO,SECON 00320 EXTERNAL YERTO,MONTO,DAYTO 00330 IYR=AND(AYERTO,$FFFF) 00340 IMN=AND(AMONTO,$FFFF) 00350 IDY=AND(ADAYTO,$FFFF) 00360 IHR=AND(HORTO,$FFFF) 00370 IMI=AND(MINTO,$FFFF) 00380 ISC=AND(SECON,$FFFF) 00390 INYR=AND(YERTO,$FFFF) 00400 INMO=AND(MONTO,$FFFF) 00410 INDY=AND(DAYTO,$FFFF) 00420C 00430 CALL PGMIN(ID,LU,MODE,PORT) 00440C 00450 CALL YMD1(INYR,INMO,INDY,DYCT,IDYYR,IWK) 00460C 00470 WRITE(5,100)(DY(M,IWK),M=1,5),IMN,IDY,IYR,IHR,IMI,ISC, 00480 + (ID(I),I=1,4) 00490 100 FORMAT(/,5A2,X,A2,'/',A2,'/',A2,2X,I2,':',I2,':',I2,3X,'ID=',4A2) 00500C 00510C 00520 RETURN 00530 END 00540 END/ 00550YMD1 DCK/ I=13,H 00560YMD1 HOL/ 00570 SUBROUTINE YMD1(IYR,IMO,IDYMO,DYCT,IDYYR,IDYWK) 00580C-----INPUTS IYR - YEAR ( 1 TO 99 ) 00590C IMO - MONTH( 1 TO 12 ) 00600C IDYMO - DAY OF MONTH ( 1 TO 31 ) 00610C-----OUTPUTS DYCT - DAY OF CENTURY (FROM JAN 1, 1901) 00620C IDYYR - DAY OF YEAR ( 1 TO 366 ) 00630C IDYWK - DAY OF WEEK ( 1 TO 7, MON IS 1 ) 00640C 00650 LEAPYR = 2 00660 IF ((IYR/4*4).EQ.IYR) LEAPYR = 1 00670 IMT = IMO*275 00680 IMT = IMT/9 00690 IDYYR = IMT+IDYMO-30 00700 IF (IMO.GT.2) IDYYR = IDYYR-LEAPYR 00710 YR=IYR-1 00720 DYYR=IDYYR 00730 TDYCT=YR*1461 00740 DYCT = TDYCT/4+DYYR 00750 DYCT2= DYCT 00760 DNUM=05*1000 00770 DMINUS=7*343 00780 IL = 0 00790 5 IF(DYCT2.LT.DNUM )GO TO 6 00800 IL = IL+1 00810 DYCT2=DYCT2-DMINUS 00820 GO TO 5 00830 6 CONTINUE 00840 IDYCT=DYCT2 00850 DYCT = IL * DMINUS + IDYCT 00860 IDYWK = IDYCT-IDYCT/7*7+1 00870 RETURN 00880 END 00890 END/ 00900 END/ 00910*REW,7 00920*K,I7,P21,L14 00930*FTN 00940*EOF 00950*CLOSE 00960*K,I13,L14 00970*Z 00980*Z 00990__ DYCT = TDYCT/4+DYYR 00750( CQ  I.CCSDMPCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING CCSDMP FROM B.CCSDMP, CCS149 FILE 00030*OPEN,FN=B.CCSDMP,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,CCSDMP,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM CCSDMP HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00950*CLOSE 00960*K,I13,L14 00970*Z 00980*Z 00990__ DYCT = TDYCT/4+DYYR 00750(YZ nWSCCSDMPCCS149 P032883($$TWB.JOB,WEAVE,,CCSDMP,CCS149 00010$$U.CCSDMP,CCS149 00020$$TWFTNHOL,RWE,,REALN,RWE 00030INPUT DCK/ I,H 00040INTGR DCK/ I,H 00050SEEIT DCK/ I,H 00060TAPE DCK/ I,H 00070XLAT DCK/ I,H 00080$$TWFBEND,WEAVE 00090_ __ 00190__ 00950*CLOSE 00960*K,I13,L14 00970*Z 00980*Z 00990__ DYCT = TDYCT/4+DYYR 00750( $  I.TRENDFCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING TRENDF FROM B.TRENDF, CCS149 FILE 00030*OPEN,FN=B.TRENDF,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,TRENDF,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM TRENDF HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00950*CLOSE 00960*K,I13,L14 00970*Z 00980*Z 00990__ DYCT = TDYCT/4+DYYR 00750(` myU.DAAASCCCS149 P032883(DAAASC DCK/ I,H 00010 DEL/ 2 00020 1 /B31 F CCS CCS3.0 PSR'D 00030 DEL/ 60 00040C ****************************************************** PSR ??? 00050 KEY(9) = BLANKS 00060C ****************************************************** PSR ??? 00070_ __, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00950*CLOSE 00960*K,I13,L14 00970*Z 00980*Z 00990__ DYCT = TDYCT/4+DYYR 00750<b lBNVFYACFCCS149 x032883< PLVFYACF ROUTINE TO VERIFY ACTIVITY BLOCK LENGTH @P @Pdh$( hT 9! !   1Th @P.(ՈhӘ2@P6TH TThh hPVFYACF=PQ8PKUPCQ8PREP@CCSGETICCSAD)CCSBLK7P __ __, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00950*CLOSE 00960*K,I13,L14 00970*Z 00980*Z 00990(b lU.USEMTNCCS149 P032883(USEMTN DCK/ I,H 00010 DEL/ 2 00020 1 /C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL-149 00030 DEL/ 18 00040 DATA ADATA /'LAACTIVE',8*$2020,1,1,1/ 00050 INS/ 21 00060C**** SET FILENAME ACCORDING TO OWNER ID. 00070 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00080 IF ( ICM.NE.0 )CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00090 DEL/ 30 00100 100 ICLR=$1820 00110 WRITE(LU,4000)ICLR 00120 4000 FORMAT(A2) 00130 DEL/ 41 00140 250 CONTINUE 00150_ __, INSTALL C O M P L E T E !!! 00180*Z 00190__ 00950*CLOSE 00960*K,I13,L14 00970*Z 00980*Z 00990__ DYCT = TDYCT/4+DYYR 00750(V J.SKEDINCCS149 P (*L,CCSADD *B 'CCSADD' ' A02 A CCS CCS 3.0' *L,CCSDVD *B 'CCSDVD' ' A02 A CCS CCS 3.0' *L,CCSE2A *B 'CCSEAC' ' A05 A CCS CCS 3.0' *L,CCSMTP *B 'CCSMTP' ' A02 A CCS CCS 3.0' *L,CCSSBT *B 'CCSSBT' ' A02 A CCS CCS 3.0' *L,EDIT *B 'EDIT' ' B50 F CCS CCS 3.0' *L,FILERR *B 'FILERR' ' B52 F CCS CCS 3.1' *L,FTNDT1 *B 'FTNDT1' ' F CCS CCS 3.0 1500 WD TBL' *L,GETGRP *B 'GETGRP' ' CCS3.0' *L,GETSW *B 'GETSW' ' CCS3.0' *L,GETUTI *B 'GETUTI' ' CCS3.0' *L,GTSYSP *B 'GTSYSP' ' CCS3.0' *L,ICKGRP *B 'ICKGRP' ' CCS3.0' *L,LTPRNT *B 'LTPRNT' ' B74 F CCS CCS 3.0' *L,PRTORF *B 'PRTORF' ' CCS3.0' *L,QCST *B 'QCST' ' C56 F CCS CCS 3.1 .PSRD 03/83' *L,SYSPRT *B 'SYSPRT' ' CCS3.0' *L,UTHEAD *B 'UTHEAD' ' C52 F CCS CCS 3.0 .LA' *L,VFYACF *B 'VFYACF' ' ROUTINE TO VERIFY ACTIVITY BLOCK LENGTH' $$INJCL,,, *B 'ACTADD' ' B01 F CCS CCS 3.0 .LA - PSRD' $$INJCL,,,ACTADD *B 'R9BASE' ' C12 F CCS CCS 3.0' *B 'R9FLDL' ' C13 F CCS CCS 3.0' *B 'ACTMTN' ' B03 F CCS CCS 3.0tMLA' *B 'AVMCON' ' B12 F CCS CCS 3.0mCLA' *B 'AVMCKD' ' B10 F CCS CCS 3.0' *B 'AVMCKV' ' B11 F CCS CCS 3.0' *B 'AVMSRT' ' B14 F CCS CCS 3.0' *B 'AVMBIT' ' A01 A CCS CCS 3.0' *B 'CCSDMP' ' B20 F CCS CCS 3.0 2 WORD RRN - PSRD SL' *B 'REALN' ' CONVERT ASCII TO REAL - 2 WORD INTEGER SL' *B 'INPUT' ' B64 F CCS CCS 3.0' *B 'INTGR' ' B65 F CCS CCS 3.0' *B 'SEEIT' ' C19 F CCS CCS 3.0' *B 'TAPE' ' C22 F CCS CCS 3.0' *B 'XLAT' ' C55 F CCS CCS 3.0' *B 'CCSSPC' ' B22 F CCS CCS 3.0 .LA' *B 'CHEKID' ' B23 F CCS CCS 3.0' *B 'STIME' ' CCS 3.0 TIME CHECK SUBROUTINE' *B 'YMD1' *B 'CHUPD2' ' B26 F CCS CCS 3.0 .LA - PSRD 08-83 SL' *B 'CMPACC' ' TREND-COMPRESS ACCAGE OR CLEAR' *B 'COLCHG' ' CCS3.0 COLLECTOR CHANGES REPORT' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' *B 'COLECT' ' A12 A CCS CCS 3.0' *B 'Q8QBDS' ' B18 F CCS CCS 3.0' *B 'ACTEDT' ' B02 F CCS CCS 3.0' *B 'CHSCRN' ' B25 F CCS CCS 3.0' *B 'CLANEX' ' B27 F CCS CCS 3.0' *B 'DAAASC' ' B31 F CCS CCS3.0' *B 'DISPLY' ' B43 F CCS CCS 3.0 PSRD .VERFY INP. SL' *B 'EACTSQ' ' B48 F CCS CCS 3.0' *B 'EATRNG' ' B49 F CCS CCS 3.0' *B 'FCOLEC' ' B51 F CCS CCS 3.0' *B 'GETCHF' ' B57 F CCS CCS 3.0' *B 'ICHEKQ' ' B62 F CCS CCS 3.0' *B 'ICHENT' ' B63 F CCS CCS 3.0' *B 'NMSRCH' ' B83 F CCS CCS 3.0' *B 'PCPROC' ' B86 F CCS CCS 3.0' *B 'PIKAMT' ' C04 F CCS CCS 3.0' *B 'SAVTRN' ' C18 F CCS CCS 3.0' *B 'R9BASE' ' C12 F CCS CCS 3.0' *B 'R9FLDL' ' C13 F CCS CCS 3.0' *B 'COLSTS' ' CCS3.0 COLLECTOR STATISTICS REPORT SL-' *B 'GETSW' ' CCS3.0' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' *B 'HXDEC' ' DECK-ID E27 ITOS 2.0' *B 'CPYIND' ' B34 F CCS CCS 3.0' *B 'DALIST' ' CCS3.0 DAILY ASSIGNMENT LIST' *B 'GETSW' ' CCS3.0' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' *B 'INTGR' ' B65 F CCS CCS 3.0' *B 'R9FLDL' ' C13 F CCS CCS 3.0' *B 'R9BASE' ' C12 F CCS CCS 3.0' *B 'DECMTN' ' B39 F CCS CCS 3.0' *B 'ADDDT1' ' B04 F CCS CCS 3.0' *B 'ALVDT1' ' B06 F CCS CCS 3.0' *B 'APMDT1' ' B07 F CCS CCS 3.0' *B 'AREDT1' ' B08 F CCS CCS 3.0' *B 'BLKDT1' ' B19 F CCS CCS 3.0' *B 'DEBDT1' ' B38 F CCS CCS 3.0' *B 'DELDT1' ' B40 F CCS CCS 3.0' *B 'DPTDT1' ' B46 F CCS CCS 3.0' *B 'DSPDT1' ' B47 F CCS CCS 3.0' *B 'GPMDT1' ' B59 F CCS CCS 3.0' *B 'GTPDT1' ' B60 F CCS CCS 3.0' *B 'GTSDT1' ' B61 F CCS CCS 3.0' *B 'LDTDT1' ' B70 F CCS CCS 3.0' *B 'NUMDT1' ' B84 F CCS CCS 3.0' *B 'PMEDT1' ' C05 F CCS CCS 3.0' *B 'PRTDT1' ' C08 F CCS CCS 3.0' *B 'RESDT1' ' C15 F CCS CCS 3.0' *B 'RTVDT1' ' C17 F CCS CCS 3.0' *B 'DHUPDT' ' B42 F CCS CCS 3.0 .LA - PSRD 07-83 SL' *B 'DMPFIL' ' B45 F CCS CCS 3.0 . - PSRD 03/83' *B 'FIXINA' ' FIX INACCT FILE (NYGSBC) 10/81. LKL07 01/8' *B 'HXDEC' ' DECK-ID E27 ITOS 2.0' *B 'LODFIL' ' B73 F CCS CCS 3.0 REPORT DUP RECORD SL-' *B 'LTRBLD' ' B75 F CCS CCS 3.0 .LA PSR 07/83' *B 'LTRPRT' ' B77 F CCS CCS 3.0' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' *B 'LTRSTA' ' B78 F CCS 3.0 .LA/LETTER STATS 05/84 SL' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' *B 'BHXDEC' ' HEX TO DECIMAL W/LEADING BLANKS' *B 'MHUPDT' ' B79 F CCS CCS 3.0 .LA - PSRD 07-83 SL' *B 'NEWS' ' B81 F CCS CCS 3.0' *B 'NMCHNG' ' B82 F CCS CCS 3.0 .LA PSR(05/83) SL' *B 'PGGEN' ' A16 A CCS CCS 3.0' *B 'Q8QBDS' ' B89 F CCS CCS 3.0' *B 'PGGEN0' ' B90 F CCS CCS 3.0 POST 3.0 PSR 12/28/2 SL' *B 'PGGEN1' ' B91 F CCS CCS 3.0' *B 'PGGEN3' ' B92 F CCS CCS 3.0 POST 3.0 PSR 12/28/2 SL' *B 'PGGN2E' ' B93 F CCS CCS 3.0 SPECIAL 12/29/82 SL' *B 'PGGN2P' ' B94 F CCS CCS 3.0' *B 'PGSEDT' ' B97 F CCS CCS 3.0' *B 'PGSJL' ' B98 F CCS CCS 3.0' *B 'PGSJR' ' B99 F CCS CCS 3.0' *B 'PGSLST' ' C01 F CCS CCS 3.0' *B 'PHDEL1' ' C02 F CCS CCS 3.0dELA' *B 'PHDEL2' ' C03 F CCS CCS 3.0dELA' *B 'PRETSR' ' C06 F CCS CCS 3.0 .LA' *B 'PROVE' ' CHECK FILE MANAGER DATA STRUCTURES' *B 'PRINIT' ' INITIALIZE PROVE' *B 'PRCHEK' ' MAIN CHECKOUT ROUTINE' *B 'REMOVE' ' SIMULATE FILE SPACE DELETE' *B 'TWCMPR' ' COMPARE TWO 31-BIT INTEGERS' *B 'CHKFDD' ' PROCESS ENTIRE FDD' *B 'CHKFDB' ' PROCESS A FDD SECTOR' *B 'CHKDEF' ' VALIDATE SINGLE FDD ENTRIES' *B 'DATTIM' ' DATEtT TIME AREA TRANSFER' *B 'FDWMTH' ' DECK-ID F36 ITOS 1.1' *B 'MMREAD' ' MASS MEMORY READ FUNCTION' *B 'NDWMTH' ' DECK-ID A36 ITOS 1.1' *B 'QUIET' ' INDICATORS FOR ENVIRONMENT' *B 'VPC' ' VALIDATE TWO PRINTABLE CHARACTERS' *B 'WTRD' ' WTREAD INTERFACE' *B 'MEMORY' *B 'ISHIFT' *B 'ZERO' ' ZERO WORDS' *B 'PRTSCN' ' C10 F CCS CCS 3.0' *B 'PRNTIT' ' C07 F CCS CCS 3.0' *B 'QLOAD' ' C11 F CCS CCS 3.0 .LA - PSRD' *B 'REBILD' ' REBUILD INDEX FILE (NYGSBC)' *B 'GTREBI' ' RETREIVE PARAMETERS FROM ONE INPUT LINE.' *B 'SCAN' ' SCAN STRING TO SEPERATOR' *B 'MIN0' *B 'HXDEC' ' DECK-ID E27 ITOS 2.0' *B 'CNV2W' ' 32 BIT TO 31 BIT INTEGER CONVERSION PSR 1' *B 'ZERO' *B 'FMERR' ' FM FILE ERROR REPORTER W/WO PAUSE' *B 'RSWCHG' ' XXX F CCS CCS3.0 .LA LKL07' *B 'SRREQ' ' XXX F CCS CCS 3.0 .LA PSR 02/83 SL' *B 'SUMACL' ' C20 F CCS CCS 3.0 .LA - PSRD' *B 'SUMHD' ' C21 F CCS CCS 3.0' *B 'SWITCH' ' S12 F RPG CCS 3.0' *B 'TIMUSE' ' CCS3.0 TIME USAGE REPORT' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' *B 'TIMDIF' *B 'MOD' *B 'TRENDF' ' C25 F CCS CCS 3.0 .LA - PSRD RWE 10/82 SL' *B 'TRENDP' ' CCS3.0 TREND ANALYSIS REPORT' *B 'GETSW' ' CCS3.0' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' *B 'ICHKZB' ' CHECK FIELD FOR ZERO OR BLANK (RWE) SL-' *B 'TRNPLY' ' C28 F CCS CCS 3.0 .LA - LKL07' *B 'R9BASE' ' C12 F CCS CCS 3.0' *B 'R9FLDL' ' C13 F CCS CCS 3.0' *B 'UPD400' ' A20 A CCS CCS 3.0' *B 'Q8QBDS' ' C32 F CCS CCS 3.0' *B 'FUPD4X' ' B55 F CCS CCS 3.0' *B 'UP4INI' ' C33 F CCS CCS 3.0' *B 'UP4LAB' ' C34 F CCS CCS 3.0' *B 'UP4NXT' ' C35 F CCS CCS 3.0' *B 'UP4TOT' ' C36 F CCS CCS 3.0' *B 'UP4END' ' C37 F CCS CCS 3.0' *B 'UP4GTM' ' C38 F CCS CCS 3.0' *B 'UP4GTC' ' C39 F CCS CCS 3.0' *B 'UP4PRT' ' C40 F CCS CCS 3.0' *B 'UP4FML' ' C41 F CCS CCS 3.0' *B 'CHNGNF' ' B24 F CCS CCS 3.0' *B 'R9BASE' ' C12 F CCS CCS 3.0' *B 'R9FLDL' ' C13 F CCS CCS 3.0' *B 'UPD500' ' QSS000 CCS 3.0 UPD500' *B 'UPDATE' ' A21 A CCS CCS 3.0' *B 'R9BASE' ' C12 F CCS CCS 3.0' *B 'R9FLDL' ' C13 F CCS CCS 3.0' *B 'ADDIT' ' B05 F CCS CCS 3.0' *B 'CHNGNF' ' B24 F CCS CCS 3.0' *B 'CONUPD' ' B32 F CCS CCS 3.0' *B 'COSUPD' ' B33 F CCS CCS 3.0' *B 'FORMLN' ' B53 F CCS CCS 3.0' *B 'FUPDAT' ' B56 F CCS CCS 3.0' *B 'GETMAS' ' B58 F CCS 3.0' *B 'LABHAN' ' B67 F CCS CCS 3.0' *B 'NXTRAN' ' B85 F CCS CCS 3.0' *B 'PRTLIN' ' C09 F CCS CCS 3.0' *B 'REACIT' ' C14 F CCS CCS 3.0' *B 'RSWIT' ' C16 F CCS CCS 3.0' *B 'TOTALP' ' C23 F CCS CCS 3.0' *B 'UNCUPD' ' C31 F CCS CCS 3.0' *B 'Q8QBDS' ' C46 F CCS CCS 3.0' *B 'UPDEND' ' C47 F CCS CCS 3.0' *B 'UPDIT' ' C48 F CCS CCS 3.0' *B 'UPINIT' ' C49 F CCS CCS 3.0' *B 'USEMTN' ' C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL' *B 'UTFMTN' ' F51 F CCS CCS 3.1 LKL07 02-84' *B 'WRTOFE' ' C54 F CCS CCS 3.0 PSR(08-22-84)' *B 'INTGR' ' B65 F CCS CCS 3.0' *B 'DAYS' ' CALCULATE DAYS DIFFERENCE FOR TWO DATES (R' *B 'YMD1' *B 'HXDEC' ' DECK-ID E27 ITOS 2.0' *B 'WRTOFP' ' CCS3.0 ELIGIBLE/ACTUAL WRITEOFF RPT SL-' *B 'GTSYSP' ' CCS3.0' *B 'GETUTI' ' CCS3.0' *B 'PRTORF' ' CCS3.0' *B 'GETGRP' ' CCS3.0' *B 'SYSPRT' ' CCS3.0' *B 'ICKGRP' ' CCS3.0' _         __ (l^ k U.GETMASCCS149 P032883(GETMAS DCK/ I,H 00010 DEL/ 2 00020 1 /B58 F CCS 3.0 09-22-81 SL-149 00030 INS/ 32 00040 INTEGER IWAIT(38) 00050 DATA IWAIT/$0D0A,'UPDATE WAITING ACCT. NO.',25*$2020/ 00060 INTEGER N46,N76 00070 DATA N46/46/,N76/76/ 00080 INTEGER N29,N21 00090 DATA N29/29/,N21/21/ 00100 DEL/ 53 00110 IF (AND(ISTAT,BUSY).NE.0) GO TO 126 00120 INS/ 57 00130C OUTPUT WAITING ACCT. NO. & NAME MSG IF NOT ALREADY OUTPUT 00140 126 CALL CCSCST (INPBUF, N4, N16, IWAIT, N29, N16, ICOMP) 00150 IF (ICOMP .EQ. 0) GO TO 110 00160C (MOVE ACCT. NO. & NAME TO MSG) 00170 CALL CCSMVA (INPBUF, N4, N16, IWAIT, N29, N16) 00180 CALL CCSMVA (INPBUF,N21, N30, IWAIT, N46, N30) 00190 CALL WTREAD (TLU, -1, IWAIT, N76, -1, 0, 0, ITC) 00200 GO TO 110 00210_  __ INTEGER N46,N76 00070 DATA N46/46/,N76/76/ 00080 INTEGER N29,N21 00090 DATA N29/29/,N21/21/ 00100 DEL/ 53 00110 IF (AND(ISTAT,BUSY).NE.0) GO TO 126 00120 INS/ 57 00130C OUTPUT WAITING ACCT. NO. & NAME MSG IF NOT ALREADY OUTPUT 00140 126 CALL CCSCST (INPBUF, N4, N16, IWAIT, N29, N16, ICOMP) 00150 IF (ICOMP .EQ. 0) GO TO 110 00160C (MOVE ACCT. NO. & NAME TO MSG) 00170 CALL CCSMVA (INPBUF, N4, N16, IWAIT, N29, N16) 00180 CALL CCSMVA (INPBUF,N21, N30, IWAIT, N46, N30) 00190 CALL WTREAD (TLU, -1, IWAIT, N76, -1, 0, 0, ITC) 00200 GO TO 110 00210_ (F >U.WRTOFECCS149 P032883(WRTOFE DCK/ I,H 00010 DEL/ 2 00020 1 /C54 F CCS CCS 3.0 PSR(08-22-84) SL-149 00030 DEL/ 18,19 00040 INTEGER DATE(3),NDAYS,DDAYS,EOF,FDEL,FMRDEL 00050 INTEGER IBUF(6),IDUSER(4),MDLDT(3),MSTDT(3),MLEN(11) 00060 DEL/ 24,25 00070 INTEGER DELQBF(24),DELQRC(10000),DDATA(15) 00080 INTEGER WOEFBF(24),WOEFRC(60),WDATA(15),WEFREC(874) 00090 DEL/ 37,38 00100 INTEGER DDAT(4) 00110 DATA DDATA/'LADLQMST',8*$2020,0,10,0/,SUB/0/,IFG/0/,NUMPUT/0/ 00120 DATA WDATA/'LAWOEF ',8*$2020,0,1,0/,DDAT/'DELQMST '/ 00130 DEL/ 83 00140 CALL CCSCST(WDATA,1,2,IDUSER,1,8,ICM) 00150 IF(ICM.EQ.0) GO TO 5 00160 CALL CCSMVA(WDATA,3,6,WDATA,1,8) 00170 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00180 5 CONTINUE 00190 ASSIGN 1000 TO CREATE 00200 ASSIGN 1500 TO COUNT 00210 DEL/ 99,100 00220 CALL WTREAD(LUNIT,-1,DSP1,18,-1,IBUF,10,ITC) 00230 IF(IBUF(6).NE.1) GO TO 120 00240 DEL/ 107,129 00250 220 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00260 IF(WFG1.NE.$32)CALL WTREAD(LUNIT,-1,DSP2,30,-1,IBUF,10,ITC) 00270 IF(WFG1.EQ.$32)CALL WTREAD(LUNIT,-1,DSP4,40,-1,IBUF,10,ITC) 002801 00290 IF(ITC.NE.2) GO TO 220 00300 IF(IBUF(6).NE.6) GO TO 220 00310 CALL CCSMVA(IBUF,1,6,ASOFDT,1,8) 00320 IF(IDATVR(ASOFDT,1).LT.0) GO TO 220 00330 IF(WFG1.EQ.$32) GO TO 300 00340 DEL/ 132,139 00350 260 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00360 CALL WTREAD(LUNIT,-1,DSP3,42,-1,IBUF,10,ITC) 00370 IF(ITC.NE.2) GO TO 260 00380 NCH = IBUF(6) 00390 IF(NCH.LT.1 .OR. NCH.GT.3) GO TO 260 004001 00410C CHECK FOR NUMERICS 00420 DO 280 II=1,NCH 00430 DEL/ 146,151 00440 290 CALL INTGR(IBUF,NCH,NDAYS) 00450 DEL/ 160,162 00460 320 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00470 CALL WTREAD(LUNIT,-1,DSP5,20,-1,IBUF,10,ITC) 00480 IF(ITC.NE.2) GO TO 300 00490 IF(IBUF(6).NE.1)GO TO 300 00500 DEL/ 168,171 00510 340 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00520 CALL WTREAD(LUNIT,-1,DSP6,34,-1,IBUF,10,ITC) 00530 IF(ITC.NE.2) GO TO 340 00540 DEL/ 210 00550 420 CONTINUE 00560 DEL/ 229 00570 450 CONTINUE 00580 DEL/ 240,249 005901 00600 500 CALL DAYS(DELQRC(JW+1),875,ASOFDT,1,ADAYS,0) 00610 CALL CCSGET( ADAYS,1,ICM ) 00620 CALL INTGR(ADAYS(2),4,DDAYS) 00630 IF( ICM.EQ.$2D ) DDAYS = -1 00640 DEL/ 253 00650 540 IF(DDAYS.LT.NDAYS) GO TO 580 00660 DEL/ 258 00670 DEL/ 264 00680 DEL/ 269 00690 DEL/ 286 00700 700 CONTINUE 00710 DEL/ 305 00720 730 CONTINUE 00730 DEL/ 316,331 00740 CALL DAYS(DELQRC(JW+1),857,ASOFDT,1,ADAYS,0) 00750 CALL CCSGET( ADAYS,1,ICM ) 00760 IF(ICM.NE.$2D) GO TO 780 007701 00780 DEL/ 340 00790 DEL/ 345,346 00800 780 ASSIGN 800 TO RETURN 00810 DEL/ 379,382 00820C IF BUFFER IS FULL. 008301 00840 1060 CONTINUE 00850 NUMPUT = NUMPUT + 1 00860 IWW = NUMPUT * 58 - 57 008701 00880 CALL CCSMVA(WOEFRC,1,115,WEFREC(IWW),1,115) 00890 IF(NUMPUT.LT.15) GO TO 1070 009001 00910 1065 CALL PUTS(WOEFBF,WEFREC,NUMPUT,ISTAT) 00920 IF(ISTAT.GE.0) GO TO 1068 00930 CALL FILERR(WDATA,11,ISTAT,LUNIT) 00940 GO TO 9500 009501 00960 1068 NUMPUT = 0 00970 IF(IFG.EQ.1) GO TO 9000 00980 DEL/ 410,429 00990 9000 CONTINUE 01000 IFG = 1 01010 IF(NUMPUT.NE.0) GO TO 1065 01020_  __ (b lWSCHEKIDCCS149 P032883($$TWB.JOB,WEAVE,,CHEKID,CCS149 00010$$U.CHEKID,CCS149 00020$$TWFTNHOL,RWE,,STIME,RWE 00030$$TWFTNHOL,RWE,,YMD1,RWE 00040$$TWFBEND,WEAVE 00050_ 00060 00070 00080 00090 00100 00110 00120 00130 00140 00150 00160 00170 00180__ __ <M %h"1B.CHEKIDCCS149 x032883< P$CHEKID B23 F CCS CCS 3.0 SL-149@P@P L@PMNUPRO @PTT  TT TTPCHEKIDPQ8STP #STIME PGMIN PGMOUTSYSMSGCHAIN PCHEKID PSTIME CCS 3.0 TIME CHECK SUBROUTINE @P+@PMONDAY TUESDAY WEDNESDAY @PTHURSDAY FRIDAY SATURDAY @P%SUNDAY @P:hhhhhhhhhTT@Pe123467Tz h (hT@P}غ 1\,\-\*\.\/\0 hȨh\@Pآ 1T@P(/,5A2,X,A2,1H/,A2,1H/,A2,2X,I2,1H:,I2,1H:,I2,3X,3HID=,4A2) @PHwPSTIME PQ8QINImQ8QX {Q8QENDAYERTO;AMONTO?ADAYTOCHORTO GMINTO KSECON OYERTO SMONTO WDAYTO [PGMIN _YMD1 eP PYMD1 @P@P @P @P@PW@P hVBœS  hO(hp8hڌI lH D#DlB> h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l@PHTTh\h\h\hh\h\hnPYMD1 PHFLOT 5Q8PKUPQ8PREPFLOAT @P __ PYMD1 @P@P @P @P@PW@P hVBœS  hO(hp8hڌI lH D#DlB> h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l(_w myU.CHEKIDCCS149 P032883(CHEKID DCK/ I,H 00010 INS/ 23 00020C**** PRINT OUT DAY,DATE,TIME,ID 00030 CALL STIME 00040_ 00050 00060 00070 00080 00090 00100 00110 00120 00130 00140__@P@PW@P hVBœS  hO(hp8hڌI lH D#DlB> h@T-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l ( C  I.CHEKIDCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING CHEKID FROM B.CHEKID, CCS149 FILE 00030*OPEN,FN=B.CHEKID,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,CHEKID,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM CHEKID HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__-@s9h9\-@s T @PB\@ \\ۮt t@ (h \-@s (h\-@s h\Ӹ t>ج\˸ @Pm @Pv\@ \\t\\tp4,d l (V{ Vi$J.TSLOG CCS149 P032883(*JOB,, TSLOG INSTALL 01/18/83 00010*K,L14 00020*CTO, TSLOG WEAVED AS OF 01/18/83 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.TSLOG 00050*K,L2 00060*OPEN,FN=CCSITO.C,OW=CCS20 ,LU=20,R 00070*OPEN,FN=B.TSLOG,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120TSLOG DCK/ I,H 00130 INS/ 342 00140 LDA* TCODE 00150 INA -4 00160 SAN 1 00170 JMP* LOG010 00180 INS/ 361 00190 LDA* TCODE 00200 INA -4 00210 SAN 1 00220 JMP* LOG020 00230 INS/ 492 00240 LDA TCODE 00250 INA -4 00260 SAN 1 00270 JMP* SYSNX5 00280 DEL/ 516 00290SYS140 JMP* SYS200 00300 DEL/ 1197,1200 00310* *** 4 CARDS DELETED HERE 00320 DEL/ 1578 00330MESG01 ALF $,CDC CYBER-18 C C S SYSTEM - VER 3.0-6.56$ 00340IOLUNT DCK/ I,H 00350FMCALL DCK/ I,H 00360 END/ 00370*REW,7 00380*K,I7,P21,L14 00390*ASSEM 00400*EOF 00410*CLOSE 00420*K,I13,L14 00430*Z 00440*Z 00450_   __ (; I.GTSYSPCCS149 P(*JOB,, INSTALL CORRECTIONS 08/27/84 00010*K,L14 00020*CTO, INSTALLING GTSYSP FROM BNGTSYSP, CCS149 FILE 00030*OPEN,FN=BNGTSYSP,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*L,GTSYSP 00090*Z 00100*K,I13 00110*CLOSE 00120*CTO, SUBROUTINE GTSYSP HAS BEEN INSTALLED 00130*CTO, 00140*CTO, 00150*CTO, INSTALL C O M P L E T E !!! 00160*Z 00170__ ( t. |U.FCOLECCCS149 P032883(FCOLEC DCK/ I,H 00010 INS/ 78 000201 00030C*** TRAINEE DOES NOT NEED TO LOCK RECORDS BECAUSE WERE NOT UPDATING 00040 IDATDM(15)=0 000501 00060_ __, SUBROUTINE GTSYSP HAS BEEN INSTALLED 00130*CTO, 00140*CTO, 00150*CTO, INSTALL C O M P L E T E !!! 00160*Z 00170__ (#n #jWSUPDATECCS149 P032883($$TWB.JOB,WEAVE,,UPDATE,CCS149 00010UPDATE DCK/ I,H 00020$$TWABINS,WEAVE 00030R9BASE DCK/ I,H 00040R9FLDL DCK/ I,H 00050$$U.UPDMAC,CCS149 00060ADDIT DCK/ I,H 00070$$U.CHNGNF,CCS149 00080$$U.CONUPD,CCS149 00090COSUPD DCK/ I,H 00100FORMLN DCK/ I,H 00110FUPDAT DCK/ I,H 00120$$U.GETMAS,CCS149 00130LABHAN DCK/ I,H 00140NXTRAN DCK/ I,H 00150PRTLIN DCK/ I,H 00160$$U.REACIT,CCS149 00170RSWIT DCK/ I,H 00180TOTALP DCK/ I,H 00190UNCUPD DCK/ I,H 00200UPDBLK DCK/ I,H 00210UPDEND DCK/ I,H 00220UPDIT DCK/ I,H 00230UPINIT DCK/ I,H 00240$$TWFBEND,WEAVE 00250_ __LN DCK/ I,H 00110FUPDAT DCK/ I,H 00120$$U.GETMAS,CCS149 00130LABHAN DCK/ I,H 00140NXTRAN DCK/ I,H 00150PRTLIN DCK/ I,H 00160$$U.REACIT,CCS149 00170RSWIT DCK/ I,H 00180TOTALP DCK/ I,H 00190UNCUPD DCK/ I,H 00200UPDBLK DCK/ I,H 00210UPDEND DCK/ I,H 00220UPDIT DCK/ I,H 00230UPINIT DCK/ I,H 00240$$TWFBEND,WEAVE 00250(!n !jWSCOLECTCCS149 P032883($$TWB.JOB,WEAVE,,COLECT,CCS149 00010COLECT DCK/ I,H 00020$$TWABINS,WEAVE 00030COLMAC DCK/ I,H 00040BLKDAT DCK/ I,H 00050ACTEDT DCK/ I,H 00060$$U.CHSCRN,CCS149 00070CLANEX DCK/ I,H 00080$$U.DAAASC,CCS149 00090$$U.DISPLY,CCS149 00100$$U.EACTSQ,CCS149 00110$$U.EATRNG,CCS149 00120$$U.FCOLEC,CCS149 00130GETCHF DCK/ I,H 00140ICHEKQ DCK/ I,H 00150ICHENT DCK/ I,H 00160NMSRCH DCK/ I,H 00170$$TWFBINS,WEAVE 00180COLMAC DCK/ I,H 00190PCPROC DCK/ I,H 00200PIKAMT DCK/ I,H 00210SAVTRN DCK/ I,H 00220R9BASE DCK/ I,H 00230R9FLDL DCK/ I,H 00240$$TWFBEND,WEAVE 00250_ __DAAASC,CCS149 00090$$U.DISPLY,CCS149 00100$$U.EACTSQ,CCS149 00110$$U.EATRNG,CCS149 00120$$U.FCOLEC,CCS149 00130GETCHF DCK/ I,H 00140ICHEKQ DCK/ I,H 00150ICHENT DCK/ I,H 00160NMSRCH DCK/ I,H 00170$$TWFBINS,WEAVE 00180COLMAC DCK/ I,H 00190PCPROC DCK/ I,H 00200PIKAMT DCK/ I,H 00210SAVTRN DCK/ I,H 00220R9BASE DCK/ I,H 00230R9FLDL DCK/ I,H 00240$$TWFBEND,WEAVE 00250( R foeU.TRENDFCCS149 P032883(TRENDF DCK/ I,H 00010 DEL/ 2 00020 1 /C25 F CCS CCS 3.0 .LA - PSRD RWE 10/82 SL-XXX 00030 INS/ 33 000401 00050C**** TRENDF - MODIFIED TO USE RECORD BLOCKING. 00060C DON'T DO DELETE FROM ACCAGE. JUST FLAG RECORD SO IT 00070C CAN BE REMOVED BY DSORT. 00080C FIXED TO CLEAR AND CREATE RSWFIL IF BUILDING ACCAGE. 00090C AND ALSO WHEN OUTPUTTING TO RSWFIL DURING UPDATE OF 00100C ACCAGE TO MOVE CURRENT TO PREVIOUS ON RSWFIL RECORD. 00110 DEL/ 39,40 00120 INTEGER DELREQ(24),DELQRC(15004),DDATA(15),DELKEY(8) 00130 INTEGER DT(3),RDT(7),LRDT(4),READA,READD,EOFA,EOFD 00140 DEL/ 44 00150 INTEGER RSWB(2),RSW9(2,3),ACCRC1(1),RSWREC(620),RSWF 00160 EQUIVALENCE (DELQRC(1005),ACCRC1(1)) 00170 DEL/ 48 00180 DATA DELREQ/24*0/,DELQRC/15004*$2020/,DELKEY/8*$2020/ 00190 DATA RSWB/'RSW '/,RSW9/'998 999 997 '/,IFIRST/0/,RSWF/0/ 00200 DATA IOF/0/,IEND/0/,NUMPUT/0/,NUMHI/15/,LNDLQB/15000/ 00210 DEL/ 51,52 00220 DATA DT/3*$2020/,RDT/7*$2020/,LRDT/4*$2020/ 00230 DEL/ 83,85 00240C************************************************************** ???*A046 00250 DATA ACDATA/'LAACCAGE',8*$2020,1,1,-1/ 00260 DATA DDATA /'LADLQMST',8*$2020,1,1,0/ 00270 DATA RDATA /'LARSWFIL',8*$2020,0,1,0/ 00280 INTEGER DDAT(4) 00290 DATA DDAT/'DELQMST '/ 00300 INS/ 86 00310C************************************************************** ???*A043 00320 INTEGER DTMSG(32),DTINP(2) 00330 DATA DTMSG/$0A0D,'THE DATE ENTERED IS . IS THIS THE CORRECT 00340 1DATE? Y OR N',$0A0D/ 00350C************************************************************** ???*A043 00360 DEL/ 93,95 00370 CALL CCSCST(RDATA,1,2,IDUSER,1,8,ICM) 00380 IF(ICM.EQ.0) GO TO 5 00390 CALL CCSMVA(RDATA,3,6,RDATA,1,8) 00400 CALL CCSMVA(ACDATA,3,6,ACDATA,1,8) 00410 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00420 5 CONTINUE 00430 DEL/ 99 00440 INS/ 131 004501 00460C*** BLANK OUT RSW FLAG ON HEADER IN CASE NO INACTIVE RECORDS FOUND ! 00470 CALL CCSMVA(ACCREC,1,0,ACCREC,50,3) 00480 DEL/ 147,148 00490 160 CALL CCSMVA(RDT,1,0,RDT,1,14) 00500 CALL WTREAD(LUNIT,-1,MSG2,122,-1,RDT,12,ITC) 00510 INS/ 150 00520C************************************************************** ???*A043 00530C DATE CHECKING 00540 IF(RDT(1).EQ.$2020) CALL CCSMVA(DT,1,6,DTMSG,23,6) 00550 IF(RDT(1).NE.$2020) CALL CCSMVA(RDT,1,6,DTMSG,23,6) 00560C ASK IF IT IS THE CORRECT DATE 00570 165 DTINP(1) = $2020 00580 CALL WTREAD(LUNIT,-1,DTMSG,64,-1,DTINP,2,ITC) 00590C CHECK FOR AN 'N' AND IF SO GO REDO PROMPT FOR DATE 00600 IF(DTINP(1).EQ.$4E4F.OR.DTINP(1).EQ.$4E20) GO TO 160 00610C CHECK FOR 'Y' AND IF NOT GO REDO PROMPT FOR Y OR N 00620 IF(DTINP(1).EQ.YES(1).OR.DTINP(1).EQ.$5920) GO TO 167 00630C DATE WAS VERIFIED-CONTINUE 00640C************************************************************** ???*A043 00650 167 CONTINUE 00660 DEL/ 154 00670 IF(RDT(7).NE.6) GO TO 160 00680 DEL/ 189,190 00690 220 CONTINUE 00700 CALL CLOSFL(ACCREQ,ISTAT) 00710 NUMACC = (LNDLQB-1005)/42 00720 NUMDLQ = LNDLQB/1000 00730 ACDATA(13) = 0 00740 ACDATA(14) = NUMACC 00750 IF (INIT.NE.0) GO TO 225 00760 DDATA(13) = 0 00770 DDATA(14) = NUMDLQ 00780 ACDATA(13) = 1 00790 ACDATA(14) = 1 00800 CALL CLEAR(RSWREQ,RDATA,ISTAT) 00810 IF(ISTAT.GE.0) GO TO 225 00820 CALL FILERR(RDATA,01,ISTAT,LUNIT) 00830 GO TO 950 00840 225 CONTINUE 00850 DO 226 I = 1,24 00860 ACCREQ(I) = 0 00870 226 RSWREQ(I) = 0 00880 CALL OPENFL(ACCREQ,ACDATA,ISTAT) 00890 IF (ISTAT.GE.0) GO TO 228 00900 CALL FILERR(ACDATA,3,ISTAT,LUNIT) 00910 GO TO 950 00920 228 CONTINUE 00930 DEL/ 206,223 00940 240 CONTINUE 00950 CALL GETS(ACCREQ,ACCRC1,ACCKEY,ISTAT) 00960 IF(AND(ISTAT,$100).EQ.$100) IOF = 1 00970 IF(IOF.EQ.1) GO TO 250 00980 IF(ISTAT.GE.0) GO TO 250 00990 CALL FILERR(ACDATA,14,ISTAT,LUNIT) 01000 GO TO 950 01010 250 CONTINUE 01020 NUMRED = ACCREQ(15) 01030 IF (NUMRED.LE.0) GO TO 400 01040 DO 400 IL = 1,NUMRED 01050 IPT = IL*41-40 01060 IF (IFIRST.EQ.0) GO TO 395 01070 IF (ACCRC1(IPT).EQ.FDEL) GO TO 400 01080 CALL CCSMVA(ACCRC1(IPT),1,16,DELKEY,1,16) 01090 CALL READR(DELREQ,DELQRC,DELKEY,ISTAT) 01100 IF(AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 390 01110 DEL/ 228,229 01120 300 CONTINUE 01130 CALL CCSGET(DELQRC,306,MSTC) 01140 DO 305 I1 = 1,4 01150 CALL CCSGET(RSWB,I1,ICH) 01160 IF (ICH.NE.MSTC) GO TO 305 01170 GO TO 310 01180 305 CONTINUE 01190 310 IF (I1.LT.4) GO TO 315 01200 IF (UPDAT1.EQ.0.AND.UPDAT2.EQ.0) GO TO 340 01210 315 CONTINUE 01220 DEL/ 233 01230 CALL CCSMVA(ACCRC1(IPT),APOS(I),ALEN(I), 01240 + ACCRC1(IPT),APOS(I+4),ALEN(I)) 01250 DEL/ 238 01260 CALL CCSMVA(DELQRC,DPOS(I),DLEN(I), 01270 + ACCRC1(IPT),DPOS(I+6),DLEN(I)) 01280 DEL/ 242,281 01290 IF (I1.GE.4) GO TO 380 01300 CALL CCSCST(ACCRC1(IPT),35,3,RSWB,1,3,ICM) 01310 IF (ICM.EQ.0) GO TO 390 01320 NUMPUT = NUMPUT+1 01330 RSWF = 1 01340 IP1 = NUMPUT*41-40 01350 CALL CCSMVA(ACCRC1(IPT),1,82,RSWREC(IP1),1,82) 01360 CALL CCSMVA(RSW9(1,I1),1,3,RSWREC(IP1),35,3) 01370 CALL CCSMVA(RSWB,1,3,ACCRC1(IPT),35,3) 01380 IF (NUMPUT.LT.NUMHI) GO TO 375 01390 370 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 01400 IF(ISTAT.GE.0) GO TO 375 01410 CALL FILERR(RDATA,11,ISTAT,LUNIT) 01420 GO TO 950 01430 375 CONTINUE 01440 NUMPUT = 0 01450 IF (IEND.EQ.1) GO TO 420 01460 GO TO 400 01470 380 CONTINUE 01480 ASSIGN 385 TO IRTN 01490 GO TO 700 01500 385 CALL CCSMVA(DAYS,1,3,ACCRC1(IPT),35,3) 01510 GO TO 400 01520 390 CONTINUE 01530 CALL CCSMVA(RSWB,1,3,ACCRC1(IPT),35,3) 01540 RSWF = 1 01550 395 IFIRST = 1 01560 400 CONTINUE 01570 CALL UPDREC(ACCREQ,ACCRC1,ISTAT) 01580 IF (ISTAT.GE.0) GO TO 410 01590 CALL FILERR(ACDATA,15,ISTAT,LUNIT) 01600 GO TO 950 01610 410 CONTINUE 01620 IF (IOF.NE.1) GO TO 240 01630 IEND = 1 01640 IF (NUMPUT.GT.0) GO TO 370 01650 420 CONTINUE 01660 IF (RSWF.NE.1) GO TO 950 016701 01680C*** UPDATE HEADER RECORD TO REFLECT INACTIVE RECORDS ENCOUNTERED. 016901 01700 ACCKEY(1) = 0 01710 ACCKEY(2) = 1 017201 01730 CALL READR(ACCREQ,ACCRC1,ACCKEY,ISTAT) 01740 IF (ISTAT.GE.0) GO TO 430 01750 CALL FILERR(ACDATA,13,ISTAT,LUNIT) 01760 GO TO 950 01770 430 CONTINUE 01780 CALL CCSMVA(RSWB,1,3,ACCRC1,50,3) 01790 CALL UPDREC(ACCREQ,ACCRC1,ISTAT) 01800 IF (ISTAT.GE.0) GO TO 950 01810 CALL FILERR(ACDATA,15,ISTAT,LUNIT) 01820 GO TO 950 01830 DEL/ 287,310 01840 500 CONTINUE 01850 CALL GETS(DELREQ,DELQRC,DELKEY,ISTAT) 01860 IF(AND(ISTAT,$100).EQ.$100) IOF = 1 01870 IF (IOF.EQ.1) GO TO 530 01880 IF (ISTAT.GE.0) GO TO 530 01890 CALL FILERR(DDATA,14,ISTAT,LUNIT) 01900 GO TO 950 01910 530 CONTINUE 01920 NUMRED = DELREQ(15) 01930 IF (NUMRED.EQ.0) GO TO 590 01940 DO 590 IL = 1,NUMRED 01950 IPT = IL*1000-999 01960 IF(DELQRC(IPT).EQ.FDEL) GO TO 590 01970 CALL CCSBLK(ACCREC,82) 01980 DEL/ 315,319 01990 CALL CCSMVA(DELQRC(IPT),DPOS(K),DLEN(K), 02000 + ACCREC,DPOS(K+6),DLEN(K)) 02010 540 CONTINUE 02020 CALL CCSMVA(DELQRC(IPT),875,6,DELQDT,1,6) 02030 CALL CCSMVA(DELQRC(IPT),1,16,ACCREC,1,16) 020401 02050 CALL CCSGET(DELQRC(IPT),306,MSTC) 02060 DO 545 I1 = 1,4 02070 CALL CCSGET(RSWB,I1,ICH) 02080 IF (ICH.NE.MSTC) GO TO 545 02090 GO TO 547 02100 545 CONTINUE 02110 547 IF (I1.LT.4) GO TO 570 02120 DEL/ 334,356 02130 570 CONTINUE 02140 NUMPUT = NUMPUT+1 02150 IP1 = NUMPUT*41-40 02160 CALL CCSMVA(RSW9(1,I1),1,3,ACCREC,35,3) 02170 CALL CCSMVA(ACCREC,1,82,RSWREC(IP1),1,82) 02180 IF (NUMPUT.LT.NUMHI) GO TO 590 02190 575 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 02200 IF (ISTAT.GE.0) GO TO 580 02210 CALL FILERR(RDATA,11,ISTAT,LUNIT) 02220 GO TO 950 02230 580 CONTINUE 02240 NUMPUT = 0 02250 IF (IEND.EQ.1) GO TO 600 02260 590 CONTINUE 02270 IF (IOF.NE.1) GO TO 500 02280 IEND = 1 02290 IF (NUMPUT.GT.0) GO TO 575 02300 600 CONTINUE 02310 GO TO 950 02320_ __ CALL CCSMVA(ACCREC,1,82,RSWREC(IP1),1,82) 02180 IF (NUMPUT.LT.NUMHI) GO TO 590 02190 575 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 02200 IF (ISTAT.GE.0) GO TO 580 02210 CALL FILERR(RDATA,11,ISTAT,LUNIT) 02220 GO TO 950 02230 580 CONTINUE 02240 NUMPUT = 0 02250<I !h.B.CMPACCCCS149 x032883< P^CMPACC TREND-COMPRESS ACCAGE OR CLEAR SL-XXX @P@P@P@P @PR @P2#@PLAUTIFIL @PgLAACCAGE @PLARSWFIL @PNO TRND@PRSW @PLA @P COMPRESSING ACCAGE FILE @PX@P@PhTT T\gg\@PTȼ (TT+TȧnȢiȝ '\@PB\+Ȉ STvg '\g\ '\@Pm d fu 1 ds\vg '\gT+Tv++@P 2WT"gTTvg̤ '\gTv+X@P̔ޜN̎ '\g  lT+  d ,+@P  l \+ Tv+ &\gD  lT0@Pv !9 8 ds du d n 1Tvg 'TgT@PDv+¤ ̽ 1\g\v@P(Z@PFZ@PZTTPCMPACCPQ8STP ]FMRDELPGMIN CCSCSTCCSMVAOPENFL5FILERR=READR *CLOSFLCLEAR TCCSBLKWRITERWTREADGETS PDELRECCOMFILDPGMOUT[PCMPACC__Tȼ (TT+TȧnȢiȝ '\@PB\+Ȉ STvg '\g\ '\@Pm d fu 1 ds\vg '\gT+Tv++@P 2WT"gTTvg̤ '\gTv+X@P̔ޜN̎ '\g  lT+  d ,+@P  l \+ Tv+ &\gD  lT0@Pv !9 8 ds du d n 1Tvg 'TgT@PDv+¤ ̽ 1\g\v@P(Z@PFZ@PZTTPCMPACCPQ8STP ]FMRDELPGMIN CCSCSTCCSMVAOPENFL5FILERR=READR *CLOSFLCLEAR TCCSBLKWRITERWTREADGETS PDELRECCOMFILDPGMOUT[PCMPACC( D  I.CMPACCCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING CMPACC FROM B.CMPACC, CCS149 FILE 00030*OPEN,FN=B.CMPACC,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,CMPACC,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM CMPACC HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__PQ8STP ]FMRDELPGMIN CCSCSTCCSMVAOPENFL5FILERR=READR *CLOSFLCLEAR TCCSBLKWRITERWTREADGETS PDELRECCOMFILDPGMOUT[PCMPACC NUMPUT = 0 02250(a ~qU.DISPLYCCS149 PZ032883(DISPLY DCK/ I,H 00010 DEL/ 2 00020 1 /B43 F CCS CCS 3.0 PSRD .VERFY INP. SL-149 00030 DEL/ 60 00040C ****************************************************** ???*A009 00050 DATA EDTLEN / 0, 8, 0, 11, 12, 0, 11, 4, 0, 0 / 00060C ****************************************************** ???*A009 00070 DEL/ 361 00080 IF(K.LT.$20 .OR. K.GT.$7D) CALL CCSPUT(BLANKS,I,IOBUF) 00090_ __, INSTALL C O M P L E T E !!! 00180*Z 00190__PQ8STP ]FMRDELPGMIN CCSCSTCCSMVAOPENFL5FILERR=READR *CLOSFLCLEAR TCCSBLKWRITERWTREADGETS PDELRECCOMFILDPGMOUT[PCMPACC NUMPUT = 0 02250( L  I.DECMTNCCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING DECMTN FROM B.DECMTN, CCS149 FILE 00030*OPEN,FN=B.DECMTN,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,DECMTN,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM DECMTN HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__PQ8STP ]FMRDELPGMIN CCSCSTCCSMVAOPENFL5FILERR=READR *CLOSFLCLEAR TCCSBLKWRITERWTREADGETS PDELRECCOMFILDPGMOUT[PCMPACC NUMPUT = 0 02250(V ' $$J.USEMTNCCS149 P(*JOB,,TWB.JOB USEMTN INSTALL 08/23/84 00010*K,L14 00020*CTO, USEMTN WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.USEMTN , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.USEMTN,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120USEMTN DCK/ I,H 00130 DEL/ 2 00140 1 /C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL-149 00150 DEL/ 18 00160 DATA ADATA /'LAACTIVE',8*$2020,1,1,1/ 00170 INS/ 21 00180C**** SET FILENAME ACCORDING TO OWNER ID. 00190 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00200 IF ( ICM.NE.0 )CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00210 DEL/ 30 00220 100 ICLR=$1820 00230 WRITE(LU,4000)ICLR 00240 4000 FORMAT(A2) 00250 DEL/ 41 00260 250 CONTINUE 00270 END/ 00280*REW,7 00290*K,I7,P21,L14 00300*FTN 00310*EOF 00320*CLOSE 00330*K,I13,L14 00340*Z 00350*Z 00360__Y 00120USEMTN DCK/ I,H 00130 DEL/ 2 00140 1 /C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL-149 00150 DEL/ 18 00160 DATA ADATA /'LAACTIVE',8*$2020,1,1,1/ 00170 INS/ 21 00180C**** SET FILENAME ACCORDING TO OWNER ID. 00190 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00200 IF ( ICM.NE.0 )CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00210 DEL/ 30 00220 100 ICLR=$1820 00230 WRITE(LU,4000)ICLR 00240 4000 FORMAT(A2) 00250( c l\WSUSEMTNCCS149 P032883($$TWB.JOB,WEAVE,,USEMTN,CCS149 00010$$U.USEMTN,CCS149 00020$$TWFBEND,WEAVE 00030_ __ DEL/ 2 00140 1 /C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL-149 00150 DEL/ 18 00160 DATA ADATA /'LAACTIVE',8*$2020,1,1,1/ 00170 INS/ 21 00180C**** SET FILENAME ACCORDING TO OWNER ID. 00190 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00200 IF ( ICM.NE.0 )CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00210 DEL/ 30 00220 100 ICLR=$1820 00230 WRITE(LU,4000)ICLR 00240 4000 FORMAT(A2) 00250<B, $g*B.USEMTNCCS149 x032883< PUSEMTN C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL-149@P}@Pe@Ph@Pl @Pp0@PsYE *END  @P|@P@P3@P5 RESPOND WITH "YES" IF ANY DELETES,ELSE (CR) @PLAACTIVE  @PM ENTER COLLECTOR ID TO DELETE OR "END" @P}T/bcdTe/fg ThifTj (Thjb@PhTZbTkT@P(A2)@P\RbT3jȪȢ '\njb\Zb hȖh\@Pؐ 1\Tbp5qp/er/sktld0\bpMup/vrx@P wTd3d4T/jjym 1 1$Tzjb@P4TZ(bT3\4TT3vv{{ Tj 1\|jb@P_TjT@Pf(1H1,5X,15HUSERS OF COLECT,/,3X,2HID,3X,4HPORT,3X,4HTIME/)@P@P(20X,15HUSERS OF COLECT,/,10X,2HID,5X,4HPORT,5X,4HTIME) @P@P(2X,2A2,3X,I4,4X,A2,1H:,A2) @P@P(9X,2A2,5X,I4,6X,A2,1H:,A2) @P@P(5X,5HUSER ,A2,A2,10H NOT FOUND)@PTPUSEMTNPQ8STP Q8QINI5Q8QX ;Q8QEND@PGMIN ~CCSCSTCCCSMVAOPENFLFILERR.GETS WTREADREADR DELRECQCLOSFL`PPGMOUTdPUSEMTN___TjT@Pf(1H1,5X,15HUSERS OF COLECT,/,3X,2HID,3X,4HPORT,3X,4HTIME/)@P@P(20X,15HUSERS OF COLECT,/,10X,2HID,5X,4HPORT,5X,4HTIME) @P@P(2X,2A2,3X,I4,4X,A2,1H:,A2) @P@P(9X,2A2,5X,I4,6X,A2,1H:,A2) @P@P(5X,5HUSER ,A2,A2,10H NOT FOUND)@PTPUSEMTN(rQ jW U.LODFILCCS149 P032883(LODFIL DCK/ I,H 00010 DEL/ 2 00020 1 /B73 F CCS CCS 3.0 REPORT DUP RECORD SL-149 00030 INS/ 39 00040 INTEGER MSGA(15) 00050 DATA MSGA/$0D0C,'DUPLICATE RECORD CONTENTS ',$0D0A/ 00060 INS/ 106 00070 IF(AND(ISTAT,$8010).EQ.$8010) GO TO 202 00080 INS/ 107 00090 202 CONTINUE 00100 IWLEN=(BYTLEN+1)/2 00110 IF(IWLEN.GT.65 ) IWLEN=65 00120 IBLEN = IWLEN*2 00130 ISAV = OREC(IWLEN) 00140 OREC(IWLEN) = MSG2(1) 00150 CALL WTREAD(09,-1,MSGA,30,0,0,0,ITC) 00160 MSGA(1) = MSG2(1) 00170 CALL WTREAD(09,-1,OREC,IBLEN,0,0,0,ITC) 00180 OREC(IWLEN) = ISAV 00190 GO TO 170 00200__D)@PTPUSEMTN 4000 FORMAT(A2) 00250( WD  I.WRTOFECCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING WRTOFE FROM B.WRTOFE, CCS149 FILE 00030*OPEN,FN=B.WRTOFE,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,WRTOFE,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM WRTOFE HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ GO TO 170 00200__D)@PTPUSEMTN 4000 FORMAT(A2) 00250( &LETFCMPACCCCS149 P( PROGRAM CMPACC 00010 1 / TREND-COMPRESS ACCAGE OR CLEAR SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 09/20/83 ************ PROGRAMMER : RWE 000901 001001 00110C*** CMPACC - CHECKS THE UTIFIL FOR THE 'TRND' KEY IF IT IS NOT 00120C FOUND, IT ASSUMES THAT TREND IS BEING RUN. 00130C ** IF IT IS FOUND AND THE RECORD EQUALS 'NO ' THEN 00140C IT CLEARS ACCAGE & RSWFIL FILES, OTHERWISE IT ASSUMES 00150C TREND ANALYSIS IS BEING RUN. 00160C ** WHEN TREND IS BEING RUN CMPACC READS ACCAGE AND DELETES 00170C ANY RECORDS WITH 'RSW' IN POSITION 35. CMPACC ALSO 00180C CHECKS FOR DELETED RECORDS WHILE READING ACCAGE. 00190C ** IF ANY RECORDS WERE DELETED OR ANY DELETED RECORDS 00200C WERE FOUND DURING THE READ IT THEN COMPRESS'S ACCAGE. 002102 00220 EXTERNAL FMRDEL 002301 00240 INTEGER UDATA(15),UREQ(24),UREC(45),UKEY(15) 00250 INTEGER ADATA(15),AREQ(24),NO(2),TRNDKY(2),CMPRS(14) 00260 INTEGER RDATA(15),RREQ(24),RSW(2),DELETE,FIRST 00270 INTEGER FMRDEL,FDEL,ID(4),LA(4) 002801 00290 DATA UDATA/'LAUTIFIL ',1,1,0/,UREQ/24*0/ 00300 DATA ADATA/'LAACCAGE ',1,1,1/,AREQ/24*0/ 00310 DATA RDATA/'LARSWFIL ',0,1,0/,RREQ/24*0/ 00320 DATA NO/'NO '/,TRNDKY/'TRND'/,RSW/'RSW '/,LA/'LA '/ 00330 DATA CMPRS/$D0A,$1716,'COMPRESSING ACCAGE FILE '/ 00340 DATA UKEY/15*0/,FIRST/0/ 003502 00360C**** BEGIN ************************************** 003701 00380 ASSEM $C000,FMRDEL,$6800,FDEL 003901 00400 CALL PGMIN(ID,LU,MO,NP) 004101 00420C*** IF USERID NOT LA CHANGE TO CCS FILES ! 00430 CALL CCSCST(ID,1,8,LA,1,8,ICM) 00440 IF (ICM.EQ.0) GO TO 100 00450 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00460 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00470 CALL CCSMVA(RDATA,3,6,RDATA,1,8) 004801 00490 100 CALL OPENFL(UREQ,UDATA,ISTAT) 00500 IF (ISTAT.GE.0)GO TO 120 00510 CALL FILERR(UDATA,3,ISTAT,LU) 00520 GO TO 920 00530 120 CONTINUE 00540 CALL READR(UREQ,UREC,TRNDKY,ISTAT) 00550 CALL CLOSFL(UREQ,ISTA1) 00560 IF(AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 300 00570 IF(ISTAT.GE.0) GO TO 140 00580 CALL FILERR(UDATA,13,ISTAT,LU) 00590 GO TO 920 00600 140 CALL CCSCST(UREC,5,3,NO,1,3,ICM) 00610 IF (ICM.NE.0) GO TO 300 006201 00630C******* TREND ANALYSIS IS NOT BEING RUN CLEAR - ACCAGE & RSWFIL. 006401 00650 CALL CLEAR(AREQ,ADATA,ISTAT) 00660 IF(ISTAT.GE.0) GO TO 160 00670 CALL FILERR(ADATA,1,ISTAT,LU) 00680 GO TO 920 00690 160 CALL CLEAR(RREQ,RDATA,ISTAT) 00700 IF (ISTAT.GE.0) GO TO 180 00710 CALL FILERR(RDATA,1,ISTAT,LU) 00720 GO TO 920 007301 00740 180 CONTINUE 00750 DO 185 I = 1,24 00760 185 AREQ(I) = 0 00770 ADATA(13) = 1 00780 CALL OPENFL(AREQ,ADATA,ISTAT) 00790 IF (ISTAT.GE.0) GO TO 190 00800 CALL FILERR(ADATA,3,ISTAT,LU) 00810 GO TO 900 008201 00830 190 CALL CCSBLK(UREC,82) 00840 CALL WRITER(AREQ,UREC,UREC,ISTAT) 00850 IF (ISTAT.GE.0) GO TO 900 00860 CALL FILERR(ADATA,11,ISTAT,LU) 00870 GO TO 900 00880. 008901 00900C*** READ ACCAGE CHECKING FOR 'RSW' OR DELETED RECORDS 009101 00920 300 CONTINUE 00930 CALL WTREAD(LU,-1,CMPRS,28,0,0,0,ITC) 009401 00950 310 CALL OPENFL(AREQ,ADATA,ISTAT) 00960 IF (ISTAT.GE.0) GO TO 320 00970 CALL FILERR(ADATA,3,ISTAT,LU) 00980 GO TO 900 00990 320 CALL GETS(AREQ,UREC,UKEY,ISTAT) 01000 IF(AND(ISTAT,$100).EQ.$100) GO TO 500 01010 IF(ISTAT.GE.0) GO TO 340 01020 CALL FILERR(ADATA,14,ISTAT,LU) 01030 GO TO 900 01040 340 CONTINUE 01050 IF (FIRST.EQ.1) GO TO 350 01060 FIRST = 1 01070 CALL CCSCST(UREC,50,3,RSW,1,3,ICM) 01080 IF (ICM.EQ.0) GO TO 350 01090 DELETE = 1 01100 GO TO 500 01110 350 CONTINUE 01120 IF(UREC(1).EQ.FDEL) DELETE = 1 01130 IF(UREC(1).EQ.FDEL) GO TO 320 01140 CALL CCSCST(UREC,35,3,RSW,1,3,ICM) 01150 IF(ICM.NE.0) GO TO 320 01160 360 CONTINUE 01170 CALL DELREC(AREQ,UREC,ISTAT) 01180 IF(ISTAT.GE.0) GO TO 370 01190 CALL FILERR(ADATA,16,ISTAT,LU) 01200 GO TO 900 01210 370 DELETE = 1 01220 GO TO 320 01230. 012401 01250C****** COMPRESS ACCAGE IF ANY DELETES 012601 01270 500 CONTINUE 01280 CALL CLOSFL(AREQ,ISTAT) 01290 IF(ISTAT.GE.0) GO TO 520 013001 01310 GO TO 900 013201 01330 520 CONTINUE 01340 IF (DELETE.NE.1) GO TO 920 013501 01360 ADATA(13) = -1 01370 ADATA(15) = 0 013801 01390 DO 530 I = 1,24 01400 530 AREQ(I) = 0 01410 CALL OPENFL(AREQ,ADATA,ISTAT) 01420 IF (ISTAT.GE.0) GO TO 540 01430 CALL FILERR(ADATA,3,ISTAT,LU) 01440 GO TO 900 014501 01460 540 CALL COMFIL(AREQ,UREC,ISTAT) 01470 IF(AND(ISTAT,$100).EQ.$100) GO TO 900 01480 IF(ISTAT.GE.0) GO TO 540 01490 CALL FILERR(ADATA,17,ISTAT,LU) 01500 GO TO 900 015102 01520 900 CALL CLOSFL(AREQ,ISTAT) 01530 920 CALL PGMOUT 01540 END 01550__ 01310 GO TO 900 013201 01330 520 CONTINUE 01340 IF (DELETE.NE.1) GO TO 920 013501 01360 ADATA(13) = -1 01370 ADATA(15) = 0 013801 01390 DO 530 I = 1,24 01400 530 AREQ(I) = 0 01410 CALL OPENFL(AREQ,ADATA,ISTAT) 01420 IF (ISTAT.GE.0) GO TO 540 01430 CALL FILERR(ADATA,3,ISTAT,LU) 01440 GO TO 900 014501 01460 540 CALL COMFIL(AREQ,UREC,ISTAT) 01470 IF(AND(ISTAT,$100).EQ.$100) GO TO 900 01480 IF(ISTAT.GE.0) GO TO 540 01490 CALL FILERR(ADATA,17,ISTAT,LU) 01500( ln kWSWRTOFECCS149 P032883($$TWB.JOB,WEAVE,,WRTOFE,CCS149 00010$$U.WRTOFE,CCS149 00020INTGR DCK/ I,H 00030$$TWFTNHOL,RWE,,DAYS,RWE 00040$$TWFTNHOL,RWE,,YMD1,RWE 00050$$TWFTNHOL,RWE,,HXDEC,RWE 00060$$TWFBEND,WEAVE 00070_ __ 01390 DO 530 I = 1,24 01400 530 AREQ(I) = 0 01410 CALL OPENFL(AREQ,ADATA,ISTAT) 01420 IF (ISTAT.GE.0) GO TO 540 01430 CALL FILERR(ADATA,3,ISTAT,LU) 01440 GO TO 900 014501 01460 540 CALL COMFIL(AREQ,UREC,ISTAT) 01470 IF(AND(ISTAT,$100).EQ.$100) GO TO 900 01480 IF(ISTAT.GE.0) GO TO 540 01490 CALL FILERR(ADATA,17,ISTAT,LU) 01500<I} ?p.B.FIXINACCS149 x999999122883< P.FIXINA FIX INACCT FILE (NYGSBC) 10/81. LKL07 01/84 @P@P,@P,@P,@P,@P,2@P,u0PY@P, 0@P,@P,@P,RSW@P,@P,DELQMST @P+@P,b@P,LA @P,@P+LADLQMST  @P,zLAINACCT  @P, X -  @P,h1h.T,,,,T,,,,, T,,+,\,z,,,z ,@P,hT,,T+) hT,b,z,ȩ " h f,a؟ 1 d,T,b,z,ȑ "@P-%\++,Ȉ " d+T+,T++/,,,.<, d,@P-P l "./ d, d,+".,,,d, . .@P-{hT@P-,, d,,,  1q , d,,,5 n,+=hT@P-,+=h ̷ hT,@P-,@P-,+=hT,,@P-р+=h\,,@P-ɀ+=h ̖h\@P-,,@P-,,,hT@P-,d, +̭+=h\+),@P-,, +h\+),@P.,,,V, T,b+>,, d,, !, ;T+, # l, @P.-@P-/./@P./T+,,,E@P-.6@P-&.6@P.6\,z,,,?@P,.<@P.< d,,h T-@P.F,,,hT@P.O,,  ,,h,$,,ʈ%lT,,,,, 1\,,,,,@P.zT+,\,b,TTPFIXINAPQ8STP .FMRDEL,FMEOFC,PGMIN ,CCSCST,CCSMVA-PGMINT,UTHEAD-CLEAR -OPENFL-LOKFIL-4GETS -8CCSGET-CCSBLK-PCCSPUT.DIDATVR-PUTS . UPDREC.FILERR.0HXDEC .MWTREAD.cCLOSFL.{PGMOUT.PFIXINA PwHXDEC DECK-ID E27 ITOS 2.0 SUMMARY-132@P@P00@P @P >h hn9 1  00l- (dh -&l# h 1p8(h@P4 0hA hȨ  @m @PKȻ@mp8hȭ h !@HHTTh\ h h hPHXDEC cPQ8PKUPkQ8PREPhP __.zT+,\,b,TT( DL `J.CMPACCCCS149 P(*JOB,,TWB.JOB CMPACC INSTALL 08/23/84 00010*K,L14 00020*CTO, CMPACC WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.CMPACC , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.CMPACC,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120CMPACC DCK/ I=13,H 00130CMPACC HOL/ 00140 PROGRAM CMPACC 00150 1 / TREND-COMPRESS ACCAGE OR CLEAR SL-XXX 001601 00170C** CYBERCREDIT FINANCIAL SERVICES. 00180C** CYBERCREDIT FIELD SUPPORT GROUPS 00190C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00200C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00210C** 00220C** ************ 09/20/83 ************ PROGRAMMER : RWE 002301 002401 00250C*** CMPACC - CHECKS THE UTIFIL FOR THE 'TRND' KEY IF IT IS NOT 00260C FOUND, IT ASSUMES THAT TREND IS BEING RUN. 00270C ** IF IT IS FOUND AND THE RECORD EQUALS 'NO ' THEN 00280C IT CLEARS ACCAGE & RSWFIL FILES, OTHERWISE IT ASSUMES 00290C TREND ANALYSIS IS BEING RUN. 00300C ** WHEN TREND IS BEING RUN CMPACC READS ACCAGE AND DELETES 00310C ANY RECORDS WITH 'RSW' IN POSITION 35. CMPACC ALSO 00320C CHECKS FOR DELETED RECORDS WHILE READING ACCAGE. 00330C ** IF ANY RECORDS WERE DELETED OR ANY DELETED RECORDS 00340C WERE FOUND DURING THE READ IT THEN COMPRESS'S ACCAGE. 003502 00360 EXTERNAL FMRDEL 003701 00380 INTEGER UDATA(15),UREQ(24),UREC(45),UKEY(15) 00390 INTEGER ADATA(15),AREQ(24),NO(2),TRNDKY(2),CMPRS(14) 00400 INTEGER RDATA(15),RREQ(24),RSW(2),DELETE,FIRST 00410 INTEGER FMRDEL,FDEL,ID(4),LA(4) 004201 00430 DATA UDATA/'LAUTIFIL ',1,1,0/,UREQ/24*0/ 00440 DATA ADATA/'LAACCAGE ',1,1,1/,AREQ/24*0/ 00450 DATA RDATA/'LARSWFIL ',0,1,0/,RREQ/24*0/ 00460 DATA NO/'NO '/,TRNDKY/'TRND'/,RSW/'RSW '/,LA/'LA '/ 00470 DATA CMPRS/$D0A,$1716,'COMPRESSING ACCAGE FILE '/ 00480 DATA UKEY/15*0/,FIRST/0/ 004902 00500C**** BEGIN ************************************** 005101 00520 ASSEM $C000,FMRDEL,$6800,FDEL 005301 00540 CALL PGMIN(ID,LU,MO,NP) 005501 00560C*** IF USERID NOT LA CHANGE TO CCS FILES ! 00570 CALL CCSCST(ID,1,8,LA,1,8,ICM) 00580 IF (ICM.EQ.0) GO TO 100 00590 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00600 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00610 CALL CCSMVA(RDATA,3,6,RDATA,1,8) 006201 00630 100 CALL OPENFL(UREQ,UDATA,ISTAT) 00640 IF (ISTAT.GE.0)GO TO 120 00650 CALL FILERR(UDATA,3,ISTAT,LU) 00660 GO TO 920 00670 120 CONTINUE 00680 CALL READR(UREQ,UREC,TRNDKY,ISTAT) 00690 CALL CLOSFL(UREQ,ISTA1) 00700 IF(AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 300 00710 IF(ISTAT.GE.0) GO TO 140 00720 CALL FILERR(UDATA,13,ISTAT,LU) 00730 GO TO 920 00740 140 CALL CCSCST(UREC,5,3,NO,1,3,ICM) 00750 IF (ICM.NE.0) GO TO 300 007601 00770C******* TREND ANALYSIS IS NOT BEING RUN CLEAR - ACCAGE & RSWFIL. 007801 00790 CALL CLEAR(AREQ,ADATA,ISTAT) 00800 IF(ISTAT.GE.0) GO TO 160 00810 CALL FILERR(ADATA,1,ISTAT,LU) 00820 GO TO 920 00830 160 CALL CLEAR(RREQ,RDATA,ISTAT) 00840 IF (ISTAT.GE.0) GO TO 180 00850 CALL FILERR(RDATA,1,ISTAT,LU) 00860 GO TO 920 008701 00880 180 CONTINUE 00890 DO 185 I = 1,24 00900 185 AREQ(I) = 0 00910 ADATA(13) = 1 00920 CALL OPENFL(AREQ,ADATA,ISTAT) 00930 IF (ISTAT.GE.0) GO TO 190 00940 CALL FILERR(ADATA,3,ISTAT,LU) 00950 GO TO 900 009601 00970 190 CALL CCSBLK(UREC,82) 00980 CALL WRITER(AREQ,UREC,UREC,ISTAT) 00990 IF (ISTAT.GE.0) GO TO 900 01000 CALL FILERR(ADATA,11,ISTAT,LU) 01010 GO TO 900 01020. 010301 01040C*** READ ACCAGE CHECKING FOR 'RSW' OR DELETED RECORDS 010501 01060 300 CONTINUE 01070 CALL WTREAD(LU,-1,CMPRS,28,0,0,0,ITC) 010801 01090 310 CALL OPENFL(AREQ,ADATA,ISTAT) 01100 IF (ISTAT.GE.0) GO TO 320 01110 CALL FILERR(ADATA,3,ISTAT,LU) 01120 GO TO 900 01130 320 CALL GETS(AREQ,UREC,UKEY,ISTAT) 01140 IF(AND(ISTAT,$100).EQ.$100) GO TO 500 01150 IF(ISTAT.GE.0) GO TO 340 01160 CALL FILERR(ADATA,14,ISTAT,LU) 01170 GO TO 900 01180 340 CONTINUE 01190 IF (FIRST.EQ.1) GO TO 350 01200 FIRST = 1 01210 CALL CCSCST(UREC,50,3,RSW,1,3,ICM) 01220 IF (ICM.EQ.0) GO TO 350 01230 DELETE = 1 01240 GO TO 500 01250 350 CONTINUE 01260 IF(UREC(1).EQ.FDEL) DELETE = 1 01270 IF(UREC(1).EQ.FDEL) GO TO 320 01280 CALL CCSCST(UREC,35,3,RSW,1,3,ICM) 01290 IF(ICM.NE.0) GO TO 320 01300 360 CONTINUE 01310 CALL DELREC(AREQ,UREC,ISTAT) 01320 IF(ISTAT.GE.0) GO TO 370 01330 CALL FILERR(ADATA,16,ISTAT,LU) 01340 GO TO 900 01350 370 DELETE = 1 01360 GO TO 320 01370. 013801 01390C****** COMPRESS ACCAGE IF ANY DELETES 014001 01410 500 CONTINUE 01420 CALL CLOSFL(AREQ,ISTAT) 01430 IF(ISTAT.GE.0) GO TO 520 014401 01450 GO TO 900 014601 01470 520 CONTINUE 01480 IF (DELETE.NE.1) GO TO 920 014901 01500 ADATA(13) = -1 01510 ADATA(15) = 0 015201 01530 DO 530 I = 1,24 01540 530 AREQ(I) = 0 01550 CALL OPENFL(AREQ,ADATA,ISTAT) 01560 IF (ISTAT.GE.0) GO TO 540 01570 CALL FILERR(ADATA,3,ISTAT,LU) 01580 GO TO 900 015901 01600 540 CALL COMFIL(AREQ,UREC,ISTAT) 01610 IF(AND(ISTAT,$100).EQ.$100) GO TO 900 01620 IF(ISTAT.GE.0) GO TO 540 01630 CALL FILERR(ADATA,17,ISTAT,LU) 01640 GO TO 900 016502 01660 900 CALL CLOSFL(AREQ,ISTAT) 01670 920 CALL PGMOUT 01680 END 01690 END/ 01700 END/ 01710*REW,7 01720*K,I7,P21,L14 01730*FTN 01740*EOF 01750*CLOSE 01760*K,I13,L14 01770*Z 01780*Z 01790__0 AREQ(I) = 0 01550 CALL OPENFL(AREQ,ADATA,ISTAT) 01560 IF (ISTAT.GE.0) GO TO 540 01570 CALL FILERR(ADATA,3,ISTAT,LU) 01580 GO TO 900 015901 01600 540 CALL COMFIL(AREQ,UREC,ISTAT) 01610 IF(AND(ISTAT,$100).EQ.$100) GO TO 900 01620 IF(ISTAT.GE.0) GO TO 540 01630 CALL FILERR(ADATA,17,ISTAT,LU) 01640 GO TO 900 016502 01660 900 CALL CLOSFL(AREQ,ISTAT) 01670 920 CALL PGMOUT 01680 END 01690 END/ 01700 END/ 01710*REW,7 01720*K,I7,P21,L14 01730*FTN 01740*EOF 01750('H '}U.DMPFILCCS149 PJ032883(DMPFIL DCK/ I,H 00010 DEL/ 2 00020 1 /B45 F CCS CCS 3.0 . - PSRD 03/83 SL-149 00030 DEL/ 21 00040 INTEGER IREC(6000),ICNT(6),FCBHDR(6),BUFLEN 00050 EQUIVALENCE (FCBHDR(6),FCB(1)) 00060 INS/ 30 00070 DATA BUFLEN /6000/ 00080 DEL/ 38 00090 DATA MSG6/$0A0D,$0D0A,'RECORD EXCEEDS 2000 CHARACTERS '/ 00100 INS/ 44 001101 00120 ASSEM $C000,+FCBHDR,$6400,+IREQ(10) 00130 IREQ(13) = 96 00140 DEL/ 52,59 00150 110 CALL CCSBLK(IBUF,20) 00160 CALL WTREAD(LUNIT,-1,MSG2,22,-1,IBUF,18,ITC) 00170 IF(IBUF(10).EQ.0) GO TO 110 00180 IF(ITC.EQ.4) GO TO 110 00190 CALL CCSMVA(IBUF,1,16,IDATA,1,16) 002001 00210C GET VOLUME NAME 00220 120 CALL CCSBLK(IBUF,20) 00230 CALL WTREAD(LUNIT,-1,MSG3,18,-1,IBUF,18,ITC) 00240 IF(ITC.EQ.4) GO TO 120 00250 DEL/ 75,78 00260 DEL/ 89 00270 IF(RECLEN.GT.1000) GO TO 920 00280 NREC = BUFLEN/RECLEN 00290 IREQ(13)= NREC 00300 DEL/ 98 00310 170 CONTINUE 00320 INS/ 106 00330 IF (NREC.LE.0) GO TO 250 00340_ __ DEL/ 52,59 00150 110 CALL CCSBLK(IBUF,20) 00160 CALL WTREAD(LUNIT,-1,MSG2,22,-1,IBUF,18,ITC) 00170 IF(IBUF(10).EQ.0) GO TO 110 00180 IF(ITC.EQ.4) GO TO 110 00190 CALL CCSMVA(IBUF,1,16,IDATA,1,16) 002001 00210C GET VOLUME NAME 00220 120 CALL CCSBLK(IBUF,20) 00230 CALL WTREAD(LUNIT,-1,MSG3,18,-1,IBUF,18,ITC) 00240 IF(ITC.EQ.4) GO TO 120 00250(g B 5+J.AVMCONCCS149 P(*JOB,,TWB.JOB AVMCON INSTALL 08/23/84 00010*K,L14 00020*CTO, AVMCON WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.AVMCON , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.AVMCON,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120AVMCON DCK/ I,H 00130 DEL/ 2 00140 1 /B12 F CCS CCS 3.0 &LA SL-149 00150 DEL/ 85,87 001601 00170C*********** 00180 INTEGER AMDAT(4),ADDAT(4) 00190 DATA AMDAT/'ACTVERTB'/, ADDAT/'AVMDESC '/ 00200 DATA AMDATA/'LAACTVTB', 8*$2020, 0, 1, -1 / 00210 DATA ADDATA/'LAAVMDSC', 8*$2020, 0, 200, 0 / 00220 DATA UTDATA/'LAUTIFIL', 8*$2020, 1, 1, 1 / 00230C******************** 002401 00250 INS/ 109 00260 CALL CCSCST(UTDATA,1,2,ID,1,8,ICM) 00270 IF(ICM.EQ.0) GO TO 5 00280 CALL CCSMVA(AMDAT,1,8,AMDATA,1,8) 00290 CALL CCSMVA(ADDAT,1,8,ADDATA,1,8) 00300 CALL CCSMVA(UTDATA,3,6,UTDATA,1,8) 00310 5 CONTINUE 00320AVMCKD DCK/ I,H 00330AVMCKV DCK/ I,H 00340AVMSRT DCK/ I,H 00350 END/ 00360*REW,7 00370*K,I7,P21,L14 00380*FTN 00390*REW,7,20 00400*K,I13,L2 00410*CSY,I20,P7 00420*COSY 00430AVMBIT DCK/ I,H 00440 END/ 00450*REW,7 00460*K,I7,P21,L14 00470*ASSEM 00480*EOF 00490*CLOSE 00500*K,I13,L14 00510*Z 00520*Z 00530__ CALL CCSMVA(AMDAT,1,8,AMDATA,1,8) 00290 CALL CCSMVA(ADDAT,1,8,ADDATA,1,8) 00300 CALL CCSMVA(UTDATA,3,6,UTDATA,1,8) 00310 5 CONTINUE 00320AVMCKD DCK/ I,H 00330AVMCKV DCK/ I,H 00340AVMSRT DCK/ I,H 00350 END/ 00360*REW,7 00370*K,I7,P21,L14 00380*FTN 00390*REW,7,20 00400*K,I13,L2 00410*CSY,I20,P7 00420*COSY 00430AVMBIT DCK/ I,H 00440 END/ 00450*REW,7 00460*K,I7,P21,L14 00470*ASSEM 00480*EOF 00490*CLOSE 00500(m! tTFDACRTECCS149 PV999999032883( PROGRAM DACRTE B3600010 1 /B36 F CCS CCS 3.1 CCS07 01/84 SL-149B3600020C B3600030C CYBERCREDIT SYSTEM VERSION 3 B3600040C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3600050C COPYRIGHT CONTROL DATA CORPORATION, 1979 B3600060C B36000701 B3600080C THIS PROGRAM REASSIGNS QUEUES AND PRIORITIES FOR ALL ACTIVE B3600090C ACCOUNTS IN THE DELQMST FILE AND CREATES THE DLYASSN FILE B3600100C WHICH IS USED BY THE ON-LINE AUTOMATIC FUNCTION B36001101 B3600120 INTEGER DEQREQ(24),ASNREQ(24),DDATA(15),ADATA(15),ST,EFG,DT(3), B3600130 2 USER(4),HD(3,20),PRI(3,9),QUE(3,9),NQUE(2),NPRI(2),FDEL, B3600140 3 DEQREC(23000),ASNREC(462),QUEP(9),QUEL(9),PRIP(9),PRIL(9), B3600150 4 STG(40),LTHACT(2),NUMRD,ASCDAY(3),Q,P B3600160 EQUIVALENCE( DEQREQ(15),NUMRD ) ***001701 B3600180 EXTERNAL FMRDEL B36001901 B3600200 DATA DEQREQ, ASNREQ / 48*0 / B3600210 DATA DDATA / 'DELQMST ', 8*$2020, 0, 0, 0 / B3600220 DATA ADATA / 'DLYASSN ', 8*$2020, 0, 1, 0 / B3600230C************************************************************** 173*A032B3600240C VARIABLE FOR PP DATE CHECKING B3600250 INTEGER PPDATE(3) B3600260C VARIABLES FOR READING UTIFIL B3600270 INTEGER UDATA(15),UTIREQ(24),UTIREC(40),OLPM(2),PPLAG B3600280 DATA UDATA/'UTIFIL ',8*$2020,1,1,0/ B3600290 DATA UTIREQ/24*0/,OLPM/'OLPM'/ B3600300C************************************************************** 173*A032B3600310 DATA NUMREC / 23 /, ST / 0 /, EFG / 0 /, LTHACT / '0360' / B3600320 DATA QUE, PRI / 54*$2020 / B3600330. B3600340C**** SET UP THE DELQMST STARTING CHARACTER POSITIONS FOR THE B3600350C QUEUE ASSIGNMENT PARAMETERS, IF NOT USED MUST BE ZERO (0) B36003601 B3600370C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600380 DATA QUEP / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B36003901 B3600400C**** SET UP THE DELQMST PARAMETER LENGTH IN CHARACTERS MAX. = 6 B3600410C IF UNUSED MUST BE ZERO (0) B36004201 B3600430C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600440 DATA QUEL / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B36004502 B3600460C**** SET UP THE STARTING CHARACTER POSITIONS IN DELQMST FILE FOR B3600470C THE PRIORITY ASSIGNMENT PARAMETERS, IF UNSED MUST BE ZERO (0) B36004801 B3600490C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600500 DATA PRIP / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B36005101 B3600520C**** SET UP THE PRIORITY PARAMETER CHARACTER LENGTHS MAX. = 6 B3600530C IF UNUSED MUST BE ZERO (0) B36005401 B3600550C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 B3600560 DATA PRIL / 0, 0, 0, 0, 0, 0, 0, 0, 0 / B36005701 B3600580C**** SET UP THE STARTING CHARACTER POSITIONS FOR THE MOST RECENT B3600590C PAYMENT AMOUNT AND PAYMENT DATE, USED FOR BROKEN PP'S B36006001 B3600610 DATA LDATE / 0 / , LAMT / 0 / ,Q/$51/,P/$50/ ***00620. B3600630C ACCEPT LOGIN FROM ITOS B3600640 CALL PGMIN ( USER, LU, MODE, NPORT ) B36006501 B3600660C INITIALIZE VARIABLES B3600670 ASSEM $C000,FMRDEL,$6800,FDEL B3600680 IOSW = $3030 B3600690 CALL UTHEAD ( HD, DT ) B3600700 DDATA(14) = NUMREC B3600710 M = 1 B36007202 B3600730C OPEN FILES FOR USE B3600740C************************************************************** 173*A032B3600750 CALL OPENFL(UTIREQ,UDATA,ISTAT) B3600760C CHECK FOR ERROR B3600770 IF(ISTAT.GE.0) GO TO 10 B3600780 CALL FILERR(UDATA,3,ISTAT,LU) B3600790 GO TO 900 B3600800C NO ERROR-RETRIEVE OLPM RECORD TO GET DELTA FACTOR FOR PP DATE PROCB3600810 10 CALL READR(UTIREQ,UTIREC,OLPM,ISTAT) B3600820C BE SURE CORRECT RECORD READ B3600830 IF(AND(ISTAT,$0200).EQ.$0200.OR.AND(ISTAT,$8100).EQ.$8100) B3600840 . GO TO 20 B3600850C RECORD WAS FOUND-CK FOR OTHER ERROR B3600860 IF(ISTAT.LT.0) GO TO 20 B3600870C RECORD FOUND - EVERYTHING OKAY SAVE LAG FACTOR B3600880 PPLAG = ICCSAD(UTIREC(6)) B3600890C PROCESSING COMPLETE-CLOSE FILE AND CONTINUE B3600900 CALL CLOSFL(UTIREQ,ISTAT) B3600910 GO TO 50 B3600920C ERROR IN READR OF UTIFIL B3600930 20 CALL FILERR(UDATA,13,ISTAT,LU) B3600940 GO TO 900 B36009501 B3600960 50 CALL OPENFL( DEQREQ, DDATA, ISTAT ) B3600970C************************************************************** 173*A032B3600980 IF (ISTAT.GE.0) GO TO 100 B3600990 CALL FILERR ( DDATA, 3, ISTAT, LU ) B3601000 GO TO 900 B3601010 100 CALL CLEAR ( ASNREQ, ADATA, ISTAT ) B3601020 IF (ISTAT.GE.0) GO TO 110 B3601030 CALL FILERR ( ADATA, 1, ISTAT, LU ) B3601040 GO TO 900 B3601050 110 CALL OPENFL ( ASNREQ, ADATA, ISTAT ) B3601060 IF (ISTAT.GE.0) GO TO 200 B3601070 CALL FILERR ( ADATA, 3, ISTAT, LU ) B3601080 GO TO 900 B3601090. B3601100C READ RECORDS FROM THE DELQMST AND PROCESS B3601110 200 CALL GETS ( DEQREQ, DEQREC, I, ISTAT ) B3601120C EOF? B3601130 IF (AND(ISTAT,$8100).EQ.$8100) GO TO 900 B3601140 IF (AND(ISTAT,$100).EQ.$100) EFG = 1 B3601150C FILE ERROR? B3601160 IF (ISTAT.GE.0) GO TO 210 B3601170 CALL FILERR ( DDATA, 14, ISTAT, LU ) B3601180 GO TO 900 B3601190 210 DO 300 I = 1 , NUMRD ***01200 L = 40*M - 39 B3601210 K = 1000*I-999 B3601220 J = 2*K-1 B3601230C RECORD PRESENT? B36012401 ***01250 IF (DEQREC(K).EQ.FDEL) GO TO 300 ***012601 ***01270C RECORD ACTIVE? B3601280 IF (AND(DEQREC(K+152),$FF).NE.$20) GO TO 300 B36012901 ***01300C*** IF CALC OF # DAYS DELQUIENT NEEDED REMOVE COMMENTS ***01310C AND INSTALL DAYS ROUTINE. ***01320C CALL DAYS (DEQREC(K),0875,DT,0001,ASCDAY,0) ***01330C CALL CCSMVA(ASCDAY,04,03,DEQREC(K),1013,03) ***013401 ***01350C*** REMOVE COMMENT IF YOU WANT TO ***01360C*** VALIDATE ON LINE ACTIVITY BLOCK ...... ***01370C CALL VFYACF( DEQREC(K) ) ***013801 B3601390C GET THE MOST RECENT ACTIVITY B3601400C**************************************************************138*A023 B3601410 IOSW=$3031 B3601420C**************************************************************138*A023 B3601430 CALL GETACF ( STG, DEQREC(K+153), LTHACT, IOSW ) B36014402 B3601450C REASSIGN QUEUE ALLOWED? B3601460 IF (AND(DEQREC(K+146),$FF).NE.$20) GO TO 220 B36014701 B3601480. B3601490C**** SET UP THE PARAMETERS FOR QUEUE ASSIGNMENT : B3601500C - THE MOST RECENT ACTION CODE IS IN : STG(4) B3601510C - RESULT CODE IS IN : STG(5) B3601520C - CONTACT DATE STARTS IN : STG(1) B3601530C - THE SYSTEM DATE STARTS IN : DT(1) B36015403 B3601550C PARAMETER #1 B3601560 CALL CCSMVA ( DEQREC, QUEP(1)+J-1, QUEL(1), QUE, 1, 6 ) B36015701 B3601580C PARAMETER #2 B3601590 CALL CCSMVA ( DEQREC, QUEP(2)+J-1, QUEL(2), QUE, 7, 6 ) B36016001 B3601610C PARAMETER #3 B3601620 CALL CCSMVA ( DEQREC, QUEP(3)+J-1, QUEL(3), QUE, 13, 6 ) B36016301 B3601640C PARAMETER #4 B3601650 CALL CCSMVA ( DEQREC, QUEP(4)+J-1, QUEL(4), QUE, 19, 6 ) B36016601 B3601670C PARAMETER #5 B3601680 CALL CCSMVA ( DEQREC, QUEP(5)+J-1, QUEL(5), QUE, 25, 6 ) B36016901 B3601700C PARAMETER #6 B3601710 CALL CCSMVA ( DEQREC, QUEP(6)+J-1, QUEL(6), QUE, 31, 6 ) B36017201 B3601730C PARAMETER #7 B3601740 CALL CCSMVA ( DEQREC, QUEP(7)+J-1, QUEL(7), QUE, 37, 6 ) B36017501 B3601760C PARAMETER #8 B3601770 CALL CCSMVA ( DEQREC, QUEP(8)+J-1, QUEL(8), QUE, 43, 6 ) B36017801 B3601790C PARAMETER #9 B3601800 CALL CCSMVA ( DEQREC, QUEP(9)+J-1, QUEL(9), QUE, 49, 6 ) B3601810. B3601820C GET THE NEW QUEUE B3601830 CALL FTNDT1 ( QUE, NQUE ) B3601840C NEW QUEUE? B3601850 IF (NQUE(1).EQ.DEQREC(K+135).AND. B3601860 1 NQUE(2).EQ.DEQREC(K+136)) GO TO 220 B3601870C QUEUE RETURN SUCCESSFUL? B3601880 IF (NQUE(1).EQ.$3939.AND. B3601890 1 NQUE(2).EQ.$3939) GO TO 220 B3601900C SAVE OLD QUEUE , DATE , AND NEW QUEUE B3601910 CALL CCSMVA ( DEQREC, J+270, 4, DEQREC, J+295, 4 ) B3601920 CALL CCSMVA ( DT, 1, 6, DEQREC, J+299, 6 ) B3601930 CALL CCSMVA ( NQUE, 1, 4, DEQREC, J+270, 4 ) B36019402 B3601950C GET THE NEW PRIORITY B3601960 220 CONTINUE B3601970. B3601980C**** SET UP THE PARAMETERS FOR THE PRIORITY ASSIGNMENT - B3601990C - THE MOST RECENT ACTION CODE IS IN : STG(4) B3602000C - RESULT CODE IS IN : STG(5) B3602010C - CONTACT DATE STARTS IN : STG (1) B3602020C - THE SYSTEM DATE STARTS IN : DT(1) B36020302 B3602040C PARAMETER #1 B3602050 CALL CCSMVA ( DEQREC, PRIP(1)+J-1, PRIL(1), PRI, 1, 6 ) B36020601 B3602070C PARAMETER #2 B3602080 CALL CCSMVA ( DEQREC, PRIP(2)+J-1, PRIL(2), PRI, 7, 6 ) B36020901 B3602100C PARAMETER #3 B3602110 CALL CCSMVA ( DEQREC, PRIP(3)+J-1, PRIL(3), PRI, 13, 6 ) B36021201 B3602130C PARAMETER #4 B3602140 CALL CCSMVA ( DEQREC, PRIP(4)+J-1, PRIL(4), PRI, 19, 6 ) B36021501 B3602160C PARAMETER #5 B3602170 CALL CCSMVA ( DEQREC, PRIP(5)+J-1, PRIL(5), PRI, 25, 6 ) B36021801 B3602190C PARAMETER #6 B3602200 CALL CCSMVA ( DEQREC, PRIP(6)+J-1, PRIL(6), PRI, 31, 6 ) B36022101 B3602220C PARAMETER #7 B3602230 CALL CCSMVA ( DEQREC, PRIP(7)+J-1, PRIL(7), PRI, 37, 6 ) B36022401 B3602250C PARAMETER #8 B3602260 CALL CCSMVA ( DEQREC, PRIP(8)+J-1, PRIL(8), PRI, 43, 6 ) B36022701 B3602280C PARAMETER #9 B3602290 CALL CCSMVA ( DEQREC, PRIP(9)+J-1, PRIL(9), PRI, 49, 6 ) B3602300. B3602310 CALL FTNDT1 ( PRI, NPRI ) B3602320C PRIORITY RETURN SUCCESSFUL? B3602330 IF (NPRI(1).EQ.$3939.AND. B3602340 1 NPRI(2) .EQ. $3939 ) GO TO 225 B3602350C SAVE THE NEW PRIORITY B3602360 CALL CCSMVA ( NPRI, 1, 4, DEQREC, J+280, 4 ) B36023701 B3602380C IS THIS ACCOUNT A PROMISE TO PAY? B3602390 225 IF ( AND(DEQREC(K+142),$FF00) .NE. $5900 ) GO TO 230 B36024001 B3602410C************************************************************** 173*A032B3602420C CHECK IF PROMISE DUE TO BE CHECKED (SYSTEM DATE EQUAL OR B3602430C PAST PROMISE TO PAY DATE + LAG FROM UTIFIL B3602440C ADD LAG FACTOR FROM UTIFIL OBTAINED ABOVE TO PROMISE TO PAY B3602450C DATE TO SEE OF PP IS BROKEN OR NOT B3602460C MOVE PP DATE TO WORK AREA B3602470 CALL CCSMVA(DEQREC,J+1015,6,PPDATE,1,6) B3602480 IK = ICALJL(PPDATE,1) B3602490 IK = IK + PPLAG B3602500 IF(IK.LE.365)GO TO 2250 B3602510C YEAR HAS TURNED OVER-CONVERT THE DATE B3602520 PPDATE(3) = PPDATE(3) + 1 B3602530 IF(AND(PPDATE(3),$FF).GT.$39) B3602540 . PPDATE(3) = PPDATE(3) + $F6 B3602550C CONVERT THE DATE BACK B3602560 2250 CALL JULCAL(IK,PPDATE,1) B3602570C PP DATE IS READY TO BE CHECKED B3602580 CALL CCSCST( DT, 5, 2, PPDATE, 5, 2, ICOMP) B3602590C************************************************************** 173*A032B3602600C NOT DUE CHK FURTHER DUE B3602610 IF(ICOMP) 230, 2251, 2252 B36026201 B3602630C YEARS EQUAL CHECK MONTH AND DAY B3602640C************************************************************** 173*A032B3602650 2251 CALL CCSCST( DT, 1, 4, PPDATE, 1, 4, ICOMP ) B3602660C TODAYS DATE MUST BE EQUAL OR PAST PROMISE TO PAY DATE(PLUS LAG) B3602670C FOR CHECK B3602680C************************************************************** 173*A032B3602690 IF (ICOMP .LT. 0) GO TO 230 B36027001 B3602710C PROMISE DUE TO BE CHECKED. SEE IF LAST PAYMENT AMOUNT B3602720C CLEARS PROMISED AMOUNT. B3602730 2252 CALL CCSCST ( DEQREC, J+LAMT-1, 9, DEQREC, J+1021, 9, ICOMP) B3602740 IF(ICOMP .LT. 0) GO TO 224 B36027501 B3602760C LAST PAYMENT CLEARS PROMISE. VERIFY PAYMENT RECEIVED B3602770C AFTER COMMITMENT DATE. B3602780C************************************************************** 173*A018B3602790 CALL CCSCST (DEQREC, J+LDATE+3, 2, DEQREC, J+1044, 2, ICOMP) B3602800C************************************************************** 173*A018B3602810C BEFORE CHK FURTHER AFTER B3602820 IF(ICOMP) 224, 2253, 2254 B36028301 B3602840C YEARS EQUAL, CHECK MONTH AND DAY B3602850 2253 CALL CCSCST ( DEQREC, J+LDATE-1, 4, DEQREC, J+1040, 4, ICOMP) B3602860C PAYMENT DATE MUST BE PAST COMMITTMENT DATE FOR KEPT PROMISE. B3602870 IF( ICOMP .LT. 0 ) GO TO 224 B3602880C**************************************************************138*A018 B36028902 B3602900C PROMISE KEPT, INCREMENT THE KEPT COUNT B3602910C**************************************************************138*A018 B3602920 2254 DEQREC(K+518) = AND(DEQREC(K+518),$FF0F) + $31 B3602930C**************************************************************138*A018 B3602940 IF ( AND(DEQREC(K+518),$FF) .GT. $39 ) B3602950 1 DEQREC(K+518) = AND(DEQREC(K+518),$FFF) + $30F6 B3602960C INCREMENT THE NEXT CONTACT DATE 7 DAYS B3602970 IK = ICALJL ( DEQREC, J+274 ) B3602980 IK = IK + 7 B3602990 IF ( IK .LE. 365 ) GO TO 222 B3603000 DEQREC(K+139) = DEQREC(K+139) + 1 B3603010 IF ( AND(DEQREC(K+139),$FF) .GT. $39 ) B3603020 1 DEQREC(K+139) = DEQREC(K+139) + $F6 B3603030 222 CALL JULCAL ( IK, DEQREC, J+274 ) B3603040C CLEAR THE PROMISED TO PAY FLAG B3603050 CALL CCSPUT ( $4B, J+284, DEQREC ) B3603060 GO TO 230 B36030701 B36030801 B3603090C PROMISE BROKEN, INCREMENT THE BROKEN COUNT B3603100 224 DEQREC(K+519) = AND(DEQREC(K+519),$FF0F) + $31 B3603110 IF ( AND(DEQREC(K+519),$FF) .GT. $39 ) B3603120 1 DEQREC(K+519) = AND(DEQREC(K+519),$FFF) + $30F6 B3603130C SET THE PROMISED TO PAY FLAG TO BROKEN B3603140 CALL CCSPUT ( $42, J+284, DEQREC ) B3603150. B3603160C BUILD THE DLYASSN RECORD - ACCT #, QUEUE, NEXTCD, PRIORITY B3603170 230 CALL CCSMVA ( DEQREC, J, 16, ASNREC, L, 40) B3603180 CALL CCSMVA ( DEQREC, J+270, 14, ASNREC, L+16, 14 ) B36031902 B3603200C**** IF ADDITIONAL FIELDS ARE REQUIRED IN THE DLYASSN RECORD, B3603210C THEY SHOULD BE MOVED IN AT THIS POINT B36032202 B3603230 M = M + 1 B3603240 300 CONTINUE B36032501 B3603260C SAVE THE DLYASSN RECORD B3603270 M = M - 1 B3603280 IF ( M .EQ. 0 ) GO TO 310 B3603290 CALL PUTS ( ASNREQ, ASNREC, M, ISTAT ) B3603300 IF (ISTAT.GE.0) GO TO 305 B3603310 CALL FILERR ( ADATA, 11, ISTAT, LU ) B3603320 GO TO 900 B3603330C UPDATE THE RECORDS IN THE DELQMST FILE B3603340 305 CALL UPDREC ( DEQREQ, DEQREC, ISTAT ) B3603350C FILE ERROR? B3603360 IF (ISTAT.GE.0) GO TO 310 B3603370 CALL FILERR ( DDATA, 15, ISTAT, LU ) B3603380 GO TO 900 B3603390C ****************************** CONTINUE ***03400 310 CONTINUE ***03410 M = 1 B3603420 IF (EFG.EQ.0) GO TO 200 B36034301 B3603440C CLOSE THE FILES AND STOP B3603450 900 CALL CLOSFL ( DEQREQ, ISTAT ) B3603460 CALL CLOSFL ( ASNREQ, ISTAT ) B3603470 CALL PGMOUT B3603480 END B3603490 SUBROUTINE R9BASE C1203500 1 /C12 F CCS CCS 3.0 SL-149C1203510C C1203520C CYBERCREDIT SYSTEM VERSION 3 C1203530C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1203540C COPYRIGHT CONTROL DATA CORPORATION, 1979 C1203550C C1203560 RETURN C1203570 END C1203580 SUBROUTINE R9FLDL C1303590 1 /C13 F CCS CCS 3.0 SL-149C1303600C C1303610C CYBERCREDIT SYSTEM VERSION 3 C1303620C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1303630C COPYRIGHT CONTROL DATA CORPORATION, 1979 C1303640C C1303650 RETURN C1303660 END C1303670_      __ (* WSFIXINACCS149 P(032883($$TWB.JOB,WEAVE,,FIXINA,CCS149,LC 00010$$TWFTNHOL,RWE,,FIXINA,CCS149 00020$$TWFTNHOL,RWE,,HXDEC,RWE 00030$$TWFBEND,WEAVE 00040_ __ (Q 0o  bJ.DECOSYCCS149 P(*JOB,CCS ,CCS149, CCS149 SOURCE COMPILE AND LIST *CTO,************************************************************* *CTO,************************************************************* *CTO,**** **** *CTO,**** C C S 1 4 9 S O U R C E D E C O S Y **** *CTO,**** **** *CTO,************************************************************* *CTO,************************************************************* *CTO, *CTO, ------------------------------------------------------------*** *CTO, *OPEN,FN=C.CCSAP ,OW=CCS149 ,LU=20,R *OPEN,FN=SCRATCH ,OW=CCS20 ,LU=21,W *K,I13,L14 *REW,21 *CSY,I20,P21 *COSY MON01 DCK/ I,H AVMBIT DCK/ I,H CCSADD DCK/ I,H 00010 DEL/ 1 00020 NAM CCSADD A02 A CCS CCS 3.0 PSR'D SL-149 00030 DEL/ 85 00040 LDQ (POS1) STARTING POSITION IN FIRST ARRAY ???*A010 00050 DEL/ 89 00060 ADD ARR1 ADD ADDR TO ARRAY 1 TO GET ACTUAL ADDR???*A010 00070 DEL/ 93 00080 LDQ (POS1) LOAD Q WITH POSITION IN ARRAY OF FIRST???*A010 00090 DEL/ 99,109 00100 INA -$3A ???*A010 00110 SAM L03 SENSE DIGIT ASCII, BYPASS CONVERSION ???*A010 00120 INA -$4A+$3A ???*A010 00130 SAP L01 SENSE NOT POSITIVE DIGIT ???*A010 00140 INA -$10+$4A CONVERT POS. DIGIT($41-$49=POS. DIGITS???*A010 00150 JMP* L02 ???*A010 00160L01 INA -$7B+$4A ???*A010 00170 SAN L04 SENSE NOT POSITIVE ZERO ???*A010 00180 ENA $30 CONVERT POS. ZERO ???*A010 00190L02 SCA* (ARR1),Q STORE CONVERTED CHAR. ???*A010 00200L03 JMP* ISPOS1 ???*A010 00210L04 INA -$7D+$7B ???*A010 00220 SAZ ISZR1 SENSE NEG. ZERO ???*A010 00230 INA -$19+$7D CONVERT NEG. DIGIT($4A-$52=NEG. DIGITS???*A010 00240 DEL/ 157,167 00250 INA -$3A ???*A010 00260 SAM L13 SENSE DIGIT ASCII, BYPASS CONVERSION ???*A010 00270 INA -$4A+$3A ???*A010 00280 SAP L11 SENSE NOT POSITIVE DIGIT ???*A010 00290 INA -$10+$4A CONVERT POS. DIGIT ???*A010 00300 JMP* L12 ???*A010 00310L11 INA -$7B+$4A ???*A010 00320 SAN L14 SENSE NOT POSITIVE ZERO ???*A010 00330 ENA $30 CONVERT POS. ZERO ???*A010 00340L12 SCA* (ARR2),Q STORE CONVERTED CHAR. ???*A010 00350L13 JMP* ISPOS2 ???*A010 00360L14 INA -$7D+$7B ???*A010 00370 SAZ ISZR2 SENSE NEG. ZERO ???*A010 00380 INA -$19+$7D ???*A010 00390CCSBLK DCK/ I,H CCSCST DCK/ I,H CCSEAC DCK/ I,H 00010 DEL/ 1 00020 NAM CCSEAC A05 A CCS CCS 3.0 PSR'D SL-149 00030 INS/ 45 00040* ****************************************************** ???*A010 00050* 30 0 C0 00060* ***************************************************** ???*A010 00070 DEL/ 235 00080 NUM $3041 C0 - C1 0 A ???*A010 00090 DEL/ 331 00100 NUM $00C0 7A - 7B POSITIVE 0 ???*A010 00110CCSGET DCK/ I,H CCSHXA DCK/ I,H CCSMVA DCK/ I,H CCSPUT DCK/ I,H CCSPYT DCK/ I,H CCSTIM DCK/ I,H COLECT DCK/ I,H DATHAN DCK/ I,H GETACT DCK/ I,H ICCSAD DCK/ I,H PGGEN DCK/ I,H PUTACT DCK/ I,H RPGDT1 DCK/ I,H TAPHAN DCK/ I,H UPD400 DCK/ I,H UPDATE DCK/ I,H MON02 DCK/ I,H ACTADD DCK/ I,H 00010 DEL/ 2 00020 1 /B01 F CCS CCS 3.0 .LA - PSRD SL-149 00030 DEL/ 22,24 00040 DATA TDATA /'LATRNSFL', 8*$2020, 0, 1, 0 / 00050 DATA ADATA /'LAACTFIL', 8*$2020, 1, 1, 1 / 00060 DATA UDATA /'LAUTIFIL', 8*$2020, 1, 1, 0 / 00070 INS/ 29 00080 CALL CCSCST(UDATA,1,2,USER,1,8,ISTAT) 00090 IF(ISTAT.EQ.0) GO TO 5 00100 CALL CCSMVA(TDATA,3,6,TDATA,1,8) 00110 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00120 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00130 5 CONTINUE 00140 INS/ 44 00150 UREQ(23) = 1 00160 DEL/ 61,63 00170C ****************************************************** ???*0012 00180C 3 LINES DELETED 00190C ****************************************************** ???*0012 00200 INS/ 92 00210C ****************************************************** ???*A028 00220C VERIFY BLOCK IS > 51 (I.E., BLOCK DID NOT COME FROM 00230C TAPE HISTORY) 00240 IF ( AREC(9) .GT. $3530 ) GO TO 300 00250C ****************************************************** ???*A028 00260ACTMTN DCK/ I,H 00010 DEL/ 2 00020 1 /B03 F CCS CCS 3.0 &LA SL-149 00030 DEL/ 20 00040 DATA ADATA / 'LAACTFIL', 8*$2020, 1, 1, 0 / 00050 INS/ 25 00060 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00070 IF(ICM.NE.0)CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00080ADDDT1 DCK/ I,H ALVDT1 DCK/ I,H APMDT1 DCK/ I,H AREDT1 DCK/ I,H ASCBIN DCK/ I,H AVMCKD DCK/ I,H AVMCKV DCK/ I,H AVMCON DCK/ I,H 00010 DEL/ 2 00020 1 /B12 F CCS CCS 3.0 &LA SL-149 00030 DEL/ 85,87 000401 00050C*********** 00060 INTEGER AMDAT(4),ADDAT(4) 00070 DATA AMDAT/'ACTVERTB'/, ADDAT/'AVMDESC '/ 00080 DATA AMDATA/'LAACTVTB', 8*$2020, 0, 1, -1 / 00090 DATA ADDATA/'LAAVMDSC', 8*$2020, 0, 200, 0 / 00100 DATA UTDATA/'LAUTIFIL', 8*$2020, 1, 1, 1 / 00110C******************** 001201 00130 INS/ 109 00140 CALL CCSCST(UTDATA,1,2,ID,1,8,ICM) 00150 IF(ICM.EQ.0) GO TO 5 00160 CALL CCSMVA(AMDAT,1,8,AMDATA,1,8) 00170 CALL CCSMVA(ADDAT,1,8,ADDATA,1,8) 00180 CALL CCSMVA(UTDATA,3,6,UTDATA,1,8) 00190 5 CONTINUE 00200AVMDMP DCK/ I,H AVMSRT DCK/ I,H AVMVAC DCK/ I,H BINASC DCK/ I,H BLDSRN DCK/ I,H BLKDT1 DCK/ I,H CCSDMP DCK/ I,H 00010 DEL/ 2 00020 1 /B20 F CCS CCS 3.0 2 WORD RRN - PSRD SL-149 00030 INS/ 13 00040 INTEGER ISTR(2),ISTP(2) 00050 REAL RSTR ,RSTP 00060 INS/ 22 00070 IF (NOPRT.NE.0) LU = 05 00080 INS/ 26 00090C*** SET UP PROGRAM INTERRUPT 00100 ASSIGN 100 TO INTRPT 00110 CALL PGMINT(INTRPT,0) 00120C*********** BLANK INPUT BUFFER 00130 CALL CCSMVA(INBF,1,0,INBF,1,60) 00140 INS/ 32 00150 IF (NOPRT.NE.0) GOTO 100 00160 DEL/ 38 00170C ****************************************************** ???*A027 00180 CALL CCSMVA ( INBF, 1, NCH, IDATA, 1, 24 ) 00190C ***************************************************** ???*A027 00200 INS/ 58 00210C***** ALLOW READ OF LOCKED RECORDS 00220 REQBUF(23) = 1 002301 00240 DEL/ 60 00250C NREC = NUMBER OF RECORDS IN FILE. 00260 DEL/ 65,67 00270 RRN = NRECM * 32767.0 + NRECL 00280 WRITE (LUNIT, 9002) LIT1, LIT2, RRN 00290 9002 FORMAT ( 'FILE IS ', 2A2,' AND CONTAINS ',2A2,F7.0, 00300 DEL/ 71 00310240 IF (IDX .EQ. 0) GO TO 300 00320 DEL/ 96,98 00330C***** CCSDMP NOW HANDLES DOUBLE PRECISION #'S FOR DUMP BY RRN. 00340 IF (NCH .GT. 6) GO TO 300 00350 CALL REALN (INBF, NCH, RSTR, ISTR(1) ) 00360 DEL/ 109,110 00370 IF (NCH .GT. 6) GO TO 400 00380 CALL REALN ( INBF, NCH, RSTP, ISTP(1) ) 00390 DEL/ 115 00400500 ISTP(1) = ISTR(1) 00410 ISTP(2) = ISTR(2) 00420 DEL/ 121 00430 RECSPC(1) = ISTR(1) 00440 RECSPC(2) = ISTR(2) 00450 DEL/ 138,141 00460 WRITE(LU,9008)(IDATA(I),I=1,4),LIT1,JRTYP,RSTR 004709008 FORMAT ( 4X, 4A2, 2X, 2A2, 5X, I1, 10X, F7.0 ) 00480 WRITE (LU,9009) RSTP 004909009 FORMAT ( 34X, F7.0, // ) 00500 DEL/ 154 00510 IF (IND .GT. 0) GO TO 240 00520 DEL/ 157,158 00530C ************* PRINT RELATIVE RECORD # IN FILE ******************** 00540 1200 RRN = REQBUF(16) * 32767.0 00550 RRN = RRN + REQBUF(17) 00560 1205 WRITE(LU,9026)RRN 00570 9026 FORMAT(1X,'RELATIVE RECORD # IN FILE =',F7.0 ) 00580 CALL SEEIT (LU,BUFFER,LREC,0) 00590 IF (EXACT .EQ. 1) GO TO 240 00600C ******************************************************************** 00610 DEL/ 165 00620 RNOW = REQBUF(16)*32767.0 + REQBUF(17) 00630 IF (RNOW .GE. RSTP ) GO TO 240 00640CCSPAS DCK/ I,H CCSSPC DCK/ I,H 00010 DEL/ 2 00020 1 /B22 F CCS CCS 3.0 .LA SL-149 00030 DEL/ 30 00040 DEL/ 38,41 00050 INTEGER IDATA(15),ID(4),DDAT(4,7),DDATA(4,7) 000601 00070 DATA DDAT /'DELQMST COSIGNERACCAGE ACTFIL SUMHIST ' 00080 1, 'TAPEARC INACCT '/ 00090 2, DDATA/'LADLQMSTLACOSIGNLAACCAGELAACTFILLASUMHST' 00100 3, 'LATAPARCLAINACCT'/ 00110 DATA IDATA/ 12*$2020,0,1,0 / 00120 INS/ 62 00130 CALL PGMIN(ID,ISTAT,ISTAT,ISTAT) 00140 CALL CCSCST(DDATA,1,2,ID,1,8,ICM) 00150 IF(ICM.NE.0) CALL CCSMVA(DDAT ,1,56,DDATA,1,56) 00160 DEL/ 70 00170 CALL CCSMVA(DDATA(1,K),1,8,IDATA,1,24) 00180 CALL OPENFL( REQBUF, IDATA, ISTAT ) 00190 DEL/ 73 00200 CALL FILERR( IDATA, 3, ISTAT, LU ) 00210 DEL/ 80 00220 CALL FILERR( IDATA, 7, ISTAT, LU ) 00230CHEKID DCK/ I,H 00010 INS/ 23 00020C**** PRINT OUT DAY,DATE,TIME,ID 00030 CALL STIME 00040CHUPD2 DCK/ I,H 00010 DEL/ 2 00020 1 /B26 F CCS CCS 3.0 .LA - PSRD 08-83 SL-149 00030 INS/ 13 00040C 173*A078 00050C THE PURPOSE OF PSR A078 IS TO PREVENT DUPLICATE 00060C RECORDS WHEN ACCOUNTS ARE UPDATED BOTH FROM 00070C AND HISTORY TAPE. 00080C 00090C PSR A078 DOES THE FOLLOWING:- 00100C DEFINES A TEMPORARY FILE WHICH IS INDEXED BY ACCOUNT #. 00110C THE PRESENCE OF A RECORD IN THE TEMPORARY FILE MEANS 00120C THAT THIS PROGRAM WROTE THE RECORD HAVING 00130C SUFFIX 51 FOR THE SAME ACCOUNT. 00140C THE ABSENCE OF A RECORD IN THE TEMPORARY FILE MEANS 00150C THAT THIS PROGRAM DID NOT WRITE THE RECORD BUT, 00160C IF AN RECORD EXISTS, IT MUST HAVE BEEN WRITTEN 00170C BY . IF WROTE THE RECORD, 00180C THEN THIS PROGRAM WILL OVERLAY THAT RECORD WITH NEW DATA. 00190C 00200C THE DEFINED NUMBER OF RECORDS IN THE TEMPORARY FILE 00210C WILL BE ONE MORE THAN ARE ACTUALLY STORED IN . 00220C 00230C THE TEMPORARY FILE IS DELETED BY THIS PROGRAM AT ITS END. 00240C 00250 INTEGER UPRFCB(96), CHPBUF(24), CHPDAT(24), CHPREC(11) 00260 1 , VOLNAM(4), BUFCHP(24), DATCHP(15), ACTEMP(252) 00270 2 , CHPKEY(9), WRONKY 00280C 00290 DATA CHPBUF/24*0/ 00300 DATA CHPDAT/'CHUPTEMP',4*$2020,'SYSVOL ' 00310 1 , 18, 0, 0, $0001 00320 2 , 16, 1, 0, 0 00330 3 , 0, 0, 0, 0 / 00340 DATA VOLNAM/4*0/ 00350 DATA BUFCHP/24*0/, DATCHP/'CHUPTEMP',8*$2020,1,1,0/ 00360 DATA CHPREC/11*0/, WRONKY/$8200/ 00370C 00380 EQUIVALENCE (NEDATM,UPRFCB(7)), (NEDATL,UPRFCB(8)) 00390C 00400C 173*A078 00410 DEL/ 33 00420 INTEGER F2NAM(4,3) 00430 DATA F2NAM /'DELQMST ACTFIL UPREQ ' / 00440 DATA FNAME /'LADLQMSTLAACTFILLAUPDREQ' / 00450 DEL/ 38 00460C ****************************************************** ???*0016 00470 2 $D0A,'ENTER "NX" FOR NEXT TAPE ', 00480C ****************************************************** ???*0016 00490 INS/ 53 00500 CALL CCSCST(FNAME,1,2,USER,1,8,ICM) 00510 IF(ICM.NE.0) CALL CCSMVA(F2NAM,1,24,FNAME,1,24) 00520 INS/ 79 00530C 173*A078 00540C 00550C--- DEFINE THE TEMPORARY FILE AS FOLLOWS:- 00560C 1. GET THE FCB FOR . 00570C 2. CREATE FILE, INDEXED, # OF RECORDS WILL BE 00580C ONE MORE THAN STORED IN . 00590C THIS IS DONE BECAUSE MIGHT BE EMPTY 00600C 00610 RTYPE = 7 00620 CALL GETFCB(REQBUF(1),VOLNAM,INDEX,UPRFCB,ISTAT) 00630 IF(ISTAT.LT.0) GO TO 910 00640C 00650C--- FETCH NUMBER OF RECORDS. 00660 CHPDAT(14) = NEDATM 00670 CHPDAT(15) = NEDATL + 1 00680C 00690C **** FIRST DELETE FILE IF PRESENT ? 00700 CALL DELETE(CHPBUF,CHPDAT,ISTAT) 00710 DO 78 I=1,24 00720 78 CHPBUF(I) = 0 00730C 00740C--- DEFINE THE TEMPORARY FILE. 00750 CALL CREATE(CHPBUF,CHPDAT,ISTAT) 00760 RTYPE = 0 00770 IF(ISTAT.GE.0) GO TO 85 00780 80 CONTINUE 00790 CALL FILERR(CHPDAT,RTYPE,ISTAT,LU) 00800 GO TO 950 00810C 00820C--- OPEN THE TEMPORARY FILE. 00830 85 CONTINUE 00840 RTYPE = 3 00850 CALL OPENFL(BUFCHP,DATCHP,ISTAT) 00860 IF(ISTAT.LT.0) GO TO 80 00870C 173*A078 00880 DEL/ 83 00890C ****************************************************** 173*0016 00900 105 RTYPE = 14 00910C ****************************************************** 173*0016 00920 DEL/ 87 00930C ****************************************************** 173*0016 00940 IF ( ISTAT .LT. 0 ) GO TO 910 00950C ****************************************************** 173*0016 00960 DEL/ 110,111 00970C ****************************************************** 173*0016 00980 IF ( COMMD .NE. NX ) GO TO 150 00990C SKIP UPDATE REQUESTS UNTIL REQUEST FOR DIFFERENT TAPE 01000C OR END FOUND 01010 CALL CCSMVA ( RECBUF, 17, 6, OLDTP, 1, 6 ) 01020 160 CALL GETS ( REQBUF, RECBUF, KEY, ISTAT ) 01030 IF ( AND(ISTAT,$100) .NE. 0 ) GO TO 105 01040 IF ( ISTAT .LT. 0 ) GO TO 910 01050 CALL CCSCST ( RECBUF, 17, 6, OLDTP, 1, 6, ICOMP ) 01060 IF ( ICOMP .NE. 0 ) GO TO 105 01070 GO TO 160 01080C ****************************************************** 173*0016 01090 DEL/ 169,174 01100C***** PSR 07/83 01110 IF(AND(ISTAT,$100).EQ.$100.OR.AND(ISTAT,$200).EQ.$200) GO TO 500 01120C***** 01130 01140C ****************************************************** ???*0016 01150 IF ( ISTAT .LT. 0 ) GO TO 920 01160C ****************************************************** ???*0016 01170 INS/ 206 01180C**** DON'T RELOAD ACTFIL BLOCKS WITH SUFFIX > 50 PSR 07/83 01190 ISFX = TREC(250*I+9) 01200 IF(ISFX.GT.$3530) GO TO 480 01210 DEL/ 208 01220C ****************************************************** 173*0016 01230 440 K = ICCSAD(SUF(3)) 01240C ****************************************************** 173*0016 01250 DEL/ 220,221 01260C 173*A078 01270 RTYPE = 12 01280 IF(ISTAT.GE.0) GO TO 450 01290C 01300C--- SEE IF REJECT BECAUSE RECORD ALREADY EXISTS. 01310 IF(AND(ISTAT,$10).EQ.0) GO TO 930 01320C 01330C--- IF SUFFIX NOT 51, BUMP IT AND TRY AGAIN. 01340 IF(ACT(9).NE.$3531) GO TO 440 01350C 01360C--- SUFFIX IS 51; SEE IF I WROTE THE EXISTING RECORD. 01370C (PRESENCE OF RECORD SAYS I WROTE IT.) 01380 CALL CCSMVA(AREC,1,18,CHPKEY,1,18) 01390 RTYPE = 13 01400 CALL READR(BUFCHP,CHPREC,CHPKEY,ISTAT) 01410C 01420C--- IF I WROTE IT, BUMP SUFFIX AND TRY AGAIN. 01430 IF(AND(ISTAT,WRONKY).EQ.0) GO TO 440 01440C 01450C--- I DIDN'T WRITE IT. 01460C 01470C--- READ THE EXISTING RECORD AND UPDATE WITH NEW DATA. 01480 CALL CCSMVA(ACT,1,18,CHPKEY,1,18) 01490 RTYPE = 13 01500 CALL READR(REQBUF(49),ACTEMP,CHPKEY,ISTAT) 01510 IF(AND(ISTAT,WRONKY).NE.0) GO TO 930 01520 RTYPE = 15 01530 CALL UPDREC(REQBUF(49),AREC,ISTAT) 01540 IF(ISTAT.LT.0) GO TO 930 01550C 01560C--- DECLARE THAT I WROTE THIS RECORD BY 01570C WRITING A RECORD. 01580 445 CONTINUE 01590 RTYPE = 12 01600 CALL WRITER(BUFCHP,AREC,AREC,ISTAT) 01610 IF(ISTAT.LT.0) GO TO 80 01620 GO TO 477 01630C 01640C--- RECORD SUCCESSFULLY WRITTEN; SEE IF SUFFIX IS 51. 01650 450 CONTINUE 01660 IF(ACT(9).EQ.$3531) GO TO 445 01670C 01680C 01690 477 CONTINUE 01700C 173*A078 01710 INS/ 240 01720C ****************************************************** 173*0016 01730 GO TO 950 01740 910 CALL FILERR ( FNAME(1,3), RTYPE, ISTAT, LU ) 01750 GO TO 950 01760 920 CALL FILERR ( FNAME, RTYPE, ISTAT, LU ) 01770 GO TO 950 01780 930 CALL FILERR ( FNAME(1,2), RTYPE, ISTAT, LU ) 01790C ****************************************************** 173*0016 01800 INS/ 246 01810C 173*A078 01820C 01830C--- CLOSE AND DELETE TEMPORARY FILE. 01840 CALL CLOSFL(BUFCHP,ISTAT) 01850 DO 955 J = 1,24 01860 955 BUFCHP(J) = 0 01870 CALL DELETE(BUFCHP,CHPDAT,ISTAT) 01880C 173*A078 01890CLRFIL DCK/ I,H CMPDLQ DCK/ I,H CMPSUM DCK/ I,H CPYIND DCK/ I,H 00010 DEL/ 2 00020 1 /B34 F CCS CCS 3.0 PSR'D SL-149 00030 INS/ 131 00040C ****************************************************** ???*A019 00050C IGNORE DELETED RECORDS. 00060 IF (INREC(JW) .EQ. FDEL ) GO TO 300 00070C ****************************************************** ???*A019 00080DACRTE DCK/ I=13,H 00010DACRTE HOL/ 00020 PROGRAM DACRTE 00010 1 /B36 F CCS CCS 3.1 CCS07 01/84 SL-149 00020C 00030C CYBERCREDIT SYSTEM VERSION 3 00040C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION, 1979 00060C 000701 00080C THIS PROGRAM REASSIGNS QUEUES AND PRIORITIES FOR ALL ACTIVE 00090C ACCOUNTS IN THE DELQMST FILE AND CREATES THE DLYASSN FILE 00100C WHICH IS USED BY THE ON-LINE AUTOMATIC FUNCTION 001101 00120 INTEGER DEQREQ(24),ASNREQ(24),DDATA(15),ADATA(15),ST,EFG,DT(3), 00130 2 USER(4),HD(3,20),PRI(3,9),QUE(3,9),NQUE(2),NPRI(2),FDEL, 00140 3 DEQREC(23000),ASNREC(462),QUEP(9),QUEL(9),PRIP(9),PRIL(9), 00150 4 STG(40),LTHACT(2),NUMRD,ASCDAY(3),Q,P 00160 EQUIVALENCE( DEQREQ(15),NUMRD ) 001701 00180 EXTERNAL FMRDEL 001901 00200 DATA DEQREQ, ASNREQ / 48*0 / 00210 DATA DDATA / 'DELQMST ', 8*$2020, 0, 0, 0 / 00220 DATA ADATA / 'DLYASSN ', 8*$2020, 0, 1, 0 / 00230C************************************************************** 173*A032 00240C VARIABLE FOR PP DATE CHECKING 00250 INTEGER PPDATE(3) 00260C VARIABLES FOR READING UTIFIL 00270 INTEGER UDATA(15),UTIREQ(24),UTIREC(40),OLPM(2),PPLAG 00280 DATA UDATA/'UTIFIL ',8*$2020,1,1,0/ 00290 DATA UTIREQ/24*0/,OLPM/'OLPM'/ 00300C************************************************************** 173*A032 00310 DATA NUMREC / 23 /, ST / 0 /, EFG / 0 /, LTHACT / '0360' / 00320 DATA QUE, PRI / 54*$2020 / 00330. 00340C**** SET UP THE DELQMST STARTING CHARACTER POSITIONS FOR THE 00350C QUEUE ASSIGNMENT PARAMETERS, IF NOT USED MUST BE ZERO (0) 003601 00370C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 00380 DATA QUEP / 0, 0, 0, 0, 0, 0, 0, 0, 0 / 003901 00400C**** SET UP THE DELQMST PARAMETER LENGTH IN CHARACTERS MAX. = 6 00410C IF UNUSED MUST BE ZERO (0) 004201 00430C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 00440 DATA QUEL / 0, 0, 0, 0, 0, 0, 0, 0, 0 / 004502 00460C**** SET UP THE STARTING CHARACTER POSITIONS IN DELQMST FILE FOR 00470C THE PRIORITY ASSIGNMENT PARAMETERS, IF UNSED MUST BE ZERO (0) 004801 00490C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 00500 DATA PRIP / 0, 0, 0, 0, 0, 0, 0, 0, 0 / 005101 00520C**** SET UP THE PRIORITY PARAMETER CHARACTER LENGTHS MAX. = 6 00530C IF UNUSED MUST BE ZERO (0) 005401 00550C P-1 P-2 P-3 P-4 P-5 P-6 P-7 P-8 P-9 00560 DATA PRIL / 0, 0, 0, 0, 0, 0, 0, 0, 0 / 005701 00580C**** SET UP THE STARTING CHARACTER POSITIONS FOR THE MOST RECENT 00590C PAYMENT AMOUNT AND PAYMENT DATE, USED FOR BROKEN PP'S 006001 00610 DATA LDATE / 0 / , LAMT / 0 / ,Q/$51/,P/$50/ 00620. 00630C ACCEPT LOGIN FROM ITOS 00640 CALL PGMIN ( USER, LU, MODE, NPORT ) 006501 00660C INITIALIZE VARIABLES 00670 ASSEM $C000,FMRDEL,$6800,FDEL 00680 IOSW = $3030 00690 CALL UTHEAD ( HD, DT ) 00700 DDATA(14) = NUMREC 00710 M = 1 007202 00730C OPEN FILES FOR USE 00740C************************************************************** 173*A032 00750 CALL OPENFL(UTIREQ,UDATA,ISTAT) 00760C CHECK FOR ERROR 00770 IF(ISTAT.GE.0) GO TO 10 00780 CALL FILERR(UDATA,3,ISTAT,LU) 00790 GO TO 900 00800C NO ERROR-RETRIEVE OLPM RECORD TO GET DELTA FACTOR FOR PP DATE PROC 00810 10 CALL READR(UTIREQ,UTIREC,OLPM,ISTAT) 00820C BE SURE CORRECT RECORD READ 00830 IF(AND(ISTAT,$0200).EQ.$0200.OR.AND(ISTAT,$8100).EQ.$8100) 00840 . GO TO 20 00850C RECORD WAS FOUND-CK FOR OTHER ERROR 00860 IF(ISTAT.LT.0) GO TO 20 00870C RECORD FOUND - EVERYTHING OKAY SAVE LAG FACTOR 00880 PPLAG = ICCSAD(UTIREC(6)) 00890C PROCESSING COMPLETE-CLOSE FILE AND CONTINUE 00900 CALL CLOSFL(UTIREQ,ISTAT) 00910 GO TO 50 00920C ERROR IN READR OF UTIFIL 00930 20 CALL FILERR(UDATA,13,ISTAT,LU) 00940 GO TO 900 009501 00960 50 CALL OPENFL( DEQREQ, DDATA, ISTAT ) 00970C************************************************************** 173*A032 00980 IF (ISTAT.GE.0) GO TO 100 00990 CALL FILERR ( DDATA, 3, ISTAT, LU ) 01000 GO TO 900 01010 100 CALL CLEAR ( ASNREQ, ADATA, ISTAT ) 01020 IF (ISTAT.GE.0) GO TO 110 01030 CALL FILERR ( ADATA, 1, ISTAT, LU ) 01040 GO TO 900 01050 110 CALL OPENFL ( ASNREQ, ADATA, ISTAT ) 01060 IF (ISTAT.GE.0) GO TO 200 01070 CALL FILERR ( ADATA, 3, ISTAT, LU ) 01080 GO TO 900 01090. 01100C READ RECORDS FROM THE DELQMST AND PROCESS 01110 200 CALL GETS ( DEQREQ, DEQREC, I, ISTAT ) 01120C EOF? 01130 IF (AND(ISTAT,$8100).EQ.$8100) GO TO 900 01140 IF (AND(ISTAT,$100).EQ.$100) EFG = 1 01150C FILE ERROR? 01160 IF (ISTAT.GE.0) GO TO 210 01170 CALL FILERR ( DDATA, 14, ISTAT, LU ) 01180 GO TO 900 01190 210 DO 300 I = 1 , NUMRD 01200 L = 40*M - 39 01210 K = 1000*I-999 01220 J = 2*K-1 01230C RECORD PRESENT? 012401 01250 IF (DEQREC(K).EQ.FDEL) GO TO 300 012601 01270C RECORD ACTIVE? 01280 IF (AND(DEQREC(K+152),$FF).NE.$20) GO TO 300 012901 01300C*** IF CALC OF # DAYS DELQUIENT NEEDED REMOVE COMMENTS 01310C AND INSTALL DAYS ROUTINE. 01320C CALL DAYS (DEQREC(K),0875,DT,0001,ASCDAY,0) 01330C CALL CCSMVA(ASCDAY,04,03,DEQREC(K),1013,03) 013401 01350C*** REMOVE COMMENT IF YOU WANT TO 01360C*** VALIDATE ON LINE ACTIVITY BLOCK ...... 01370C CALL VFYACF( DEQREC(K) ) 013801 01390C GET THE MOST RECENT ACTIVITY 01400C**************************************************************138*A023 01410 IOSW=$3031 01420C**************************************************************138*A023 01430 CALL GETACF ( STG, DEQREC(K+153), LTHACT, IOSW ) 014402 01450C REASSIGN QUEUE ALLOWED? 01460 IF (AND(DEQREC(K+146),$FF).NE.$20) GO TO 220 014701 01480. 01490C**** SET UP THE PARAMETERS FOR QUEUE ASSIGNMENT : 01500C - THE MOST RECENT ACTION CODE IS IN : STG(4) 01510C - RESULT CODE IS IN : STG(5) 01520C - CONTACT DATE STARTS IN : STG(1) 01530C - THE SYSTEM DATE STARTS IN : DT(1) 015403 01550C PARAMETER #1 01560 CALL CCSMVA ( DEQREC, QUEP(1)+J-1, QUEL(1), QUE, 1, 6 ) 015701 01580C PARAMETER #2 01590 CALL CCSMVA ( DEQREC, QUEP(2)+J-1, QUEL(2), QUE, 7, 6 ) 016001 01610C PARAMETER #3 01620 CALL CCSMVA ( DEQREC, QUEP(3)+J-1, QUEL(3), QUE, 13, 6 ) 016301 01640C PARAMETER #4 01650 CALL CCSMVA ( DEQREC, QUEP(4)+J-1, QUEL(4), QUE, 19, 6 ) 016601 01670C PARAMETER #5 01680 CALL CCSMVA ( DEQREC, QUEP(5)+J-1, QUEL(5), QUE, 25, 6 ) 016901 01700C PARAMETER #6 01710 CALL CCSMVA ( DEQREC, QUEP(6)+J-1, QUEL(6), QUE, 31, 6 ) 017201 01730C PARAMETER #7 01740 CALL CCSMVA ( DEQREC, QUEP(7)+J-1, QUEL(7), QUE, 37, 6 ) 017501 01760C PARAMETER #8 01770 CALL CCSMVA ( DEQREC, QUEP(8)+J-1, QUEL(8), QUE, 43, 6 ) 017801 01790C PARAMETER #9 01800 CALL CCSMVA ( DEQREC, QUEP(9)+J-1, QUEL(9), QUE, 49, 6 ) 01810. 01820C GET THE NEW QUEUE 01830 CALL FTNDT1 ( QUE, NQUE ) 01840C NEW QUEUE? 01850 IF (NQUE(1).EQ.DEQREC(K+135).AND. 01860 1 NQUE(2).EQ.DEQREC(K+136)) GO TO 220 01870C QUEUE RETURN SUCCESSFUL? 01880 IF (NQUE(1).EQ.$3939.AND. 01890 1 NQUE(2).EQ.$3939) GO TO 220 01900C SAVE OLD QUEUE , DATE , AND NEW QUEUE 01910 CALL CCSMVA ( DEQREC, J+270, 4, DEQREC, J+295, 4 ) 01920 CALL CCSMVA ( DT, 1, 6, DEQREC, J+299, 6 ) 01930 CALL CCSMVA ( NQUE, 1, 4, DEQREC, J+270, 4 ) 019402 01950C GET THE NEW PRIORITY 01960 220 CONTINUE 01970. 01980C**** SET UP THE PARAMETERS FOR THE PRIORITY ASSIGNMENT - 01990C - THE MOST RECENT ACTION CODE IS IN : STG(4) 02000C - RESULT CODE IS IN : STG(5) 02010C - CONTACT DATE STARTS IN : STG (1) 02020C - THE SYSTEM DATE STARTS IN : DT(1) 020302 02040C PARAMETER #1 02050 CALL CCSMVA ( DEQREC, PRIP(1)+J-1, PRIL(1), PRI, 1, 6 ) 020601 02070C PARAMETER #2 02080 CALL CCSMVA ( DEQREC, PRIP(2)+J-1, PRIL(2), PRI, 7, 6 ) 020901 02100C PARAMETER #3 02110 CALL CCSMVA ( DEQREC, PRIP(3)+J-1, PRIL(3), PRI, 13, 6 ) 021201 02130C PARAMETER #4 02140 CALL CCSMVA ( DEQREC, PRIP(4)+J-1, PRIL(4), PRI, 19, 6 ) 021501 02160C PARAMETER #5 02170 CALL CCSMVA ( DEQREC, PRIP(5)+J-1, PRIL(5), PRI, 25, 6 ) 021801 02190C PARAMETER #6 02200 CALL CCSMVA ( DEQREC, PRIP(6)+J-1, PRIL(6), PRI, 31, 6 ) 022101 02220C PARAMETER #7 02230 CALL CCSMVA ( DEQREC, PRIP(7)+J-1, PRIL(7), PRI, 37, 6 ) 022401 02250C PARAMETER #8 02260 CALL CCSMVA ( DEQREC, PRIP(8)+J-1, PRIL(8), PRI, 43, 6 ) 022701 02280C PARAMETER #9 02290 CALL CCSMVA ( DEQREC, PRIP(9)+J-1, PRIL(9), PRI, 49, 6 ) 02300. 02310 CALL FTNDT1 ( PRI, NPRI ) 02320C PRIORITY RETURN SUCCESSFUL? 02330 IF (NPRI(1).EQ.$3939.AND. 02340 1 NPRI(2) .EQ. $3939 ) GO TO 225 02350C SAVE THE NEW PRIORITY 02360 CALL CCSMVA ( NPRI, 1, 4, DEQREC, J+280, 4 ) 023701 02380C IS THIS ACCOUNT A PROMISE TO PAY? 02390 225 IF ( AND(DEQREC(K+142),$FF00) .NE. $5900 ) GO TO 230 024001 02410C************************************************************** 173*A032 02420C CHECK IF PROMISE DUE TO BE CHECKED (SYSTEM DATE EQUAL OR 02430C PAST PROMISE TO PAY DATE + LAG FROM UTIFIL 02440C ADD LAG FACTOR FROM UTIFIL OBTAINED ABOVE TO PROMISE TO PAY 02450C DATE TO SEE OF PP IS BROKEN OR NOT 02460C MOVE PP DATE TO WORK AREA 02470 CALL CCSMVA(DEQREC,J+1015,6,PPDATE,1,6) 02480 IK = ICALJL(PPDATE,1) 02490 IK = IK + PPLAG 02500 IF(IK.LE.365)GO TO 2250 02510C YEAR HAS TURNED OVER-CONVERT THE DATE 02520 PPDATE(3) = PPDATE(3) + 1 02530 IF(AND(PPDATE(3),$FF).GT.$39) 02540 . PPDATE(3) = PPDATE(3) + $F6 02550C CONVERT THE DATE BACK 02560 2250 CALL JULCAL(IK,PPDATE,1) 02570C PP DATE IS READY TO BE CHECKED 02580 CALL CCSCST( DT, 5, 2, PPDATE, 5, 2, ICOMP) 02590C************************************************************** 173*A032 02600C NOT DUE CHK FURTHER DUE 02610 IF(ICOMP) 230, 2251, 2252 026201 02630C YEARS EQUAL CHECK MONTH AND DAY 02640C************************************************************** 173*A032 02650 2251 CALL CCSCST( DT, 1, 4, PPDATE, 1, 4, ICOMP ) 02660C TODAYS DATE MUST BE EQUAL OR PAST PROMISE TO PAY DATE(PLUS LAG) 02670C FOR CHECK 02680C************************************************************** 173*A032 02690 IF (ICOMP .LT. 0) GO TO 230 027001 02710C PROMISE DUE TO BE CHECKED. SEE IF LAST PAYMENT AMOUNT 02720C CLEARS PROMISED AMOUNT. 02730 2252 CALL CCSCST ( DEQREC, J+LAMT-1, 9, DEQREC, J+1021, 9, ICOMP) 02740 IF(ICOMP .LT. 0) GO TO 224 027501 02760C LAST PAYMENT CLEARS PROMISE. VERIFY PAYMENT RECEIVED 02770C AFTER COMMITMENT DATE. 02780C************************************************************** 173*A018 02790 CALL CCSCST (DEQREC, J+LDATE+3, 2, DEQREC, J+1044, 2, ICOMP) 02800C************************************************************** 173*A018 02810C BEFORE CHK FURTHER AFTER 02820 IF(ICOMP) 224, 2253, 2254 028301 02840C YEARS EQUAL, CHECK MONTH AND DAY 02850 2253 CALL CCSCST ( DEQREC, J+LDATE-1, 4, DEQREC, J+1040, 4, ICOMP) 02860C PAYMENT DATE MUST BE PAST COMMITTMENT DATE FOR KEPT PROMISE. 02870 IF( ICOMP .LT. 0 ) GO TO 224 02880C**************************************************************138*A018 028902 02900C PROMISE KEPT, INCREMENT THE KEPT COUNT 02910C**************************************************************138*A018 02920 2254 DEQREC(K+518) = AND(DEQREC(K+518),$FF0F) + $31 02930C**************************************************************138*A018 02940 IF ( AND(DEQREC(K+518),$FF) .GT. $39 ) 02950 1 DEQREC(K+518) = AND(DEQREC(K+518),$FFF) + $30F6 02960C INCREMENT THE NEXT CONTACT DATE 7 DAYS 02970 IK = ICALJL ( DEQREC, J+274 ) 02980 IK = IK + 7 02990 IF ( IK .LE. 365 ) GO TO 222 03000 DEQREC(K+139) = DEQREC(K+139) + 1 03010 IF ( AND(DEQREC(K+139),$FF) .GT. $39 ) 03020 1 DEQREC(K+139) = DEQREC(K+139) + $F6 03030 222 CALL JULCAL ( IK, DEQREC, J+274 ) 03040C CLEAR THE PROMISED TO PAY FLAG 03050 CALL CCSPUT ( $4B, J+284, DEQREC ) 03060 GO TO 230 030701 030801 03090C PROMISE BROKEN, INCREMENT THE BROKEN COUNT 03100 224 DEQREC(K+519) = AND(DEQREC(K+519),$FF0F) + $31 03110 IF ( AND(DEQREC(K+519),$FF) .GT. $39 ) 03120 1 DEQREC(K+519) = AND(DEQREC(K+519),$FFF) + $30F6 03130C SET THE PROMISED TO PAY FLAG TO BROKEN 03140 CALL CCSPUT ( $42, J+284, DEQREC ) 03150. 03160C BUILD THE DLYASSN RECORD - ACCT #, QUEUE, NEXTCD, PRIORITY 03170 230 CALL CCSMVA ( DEQREC, J, 16, ASNREC, L, 40) 03180 CALL CCSMVA ( DEQREC, J+270, 14, ASNREC, L+16, 14 ) 031902 03200C**** IF ADDITIONAL FIELDS ARE REQUIRED IN THE DLYASSN RECORD, 03210C THEY SHOULD BE MOVED IN AT THIS POINT 032202 03230 M = M + 1 03240 300 CONTINUE 032501 03260C SAVE THE DLYASSN RECORD 03270 M = M - 1 03280 IF ( M .EQ. 0 ) GO TO 310 03290 CALL PUTS ( ASNREQ, ASNREC, M, ISTAT ) 03300 IF (ISTAT.GE.0) GO TO 305 03310 CALL FILERR ( ADATA, 11, ISTAT, LU ) 03320 GO TO 900 03330C UPDATE THE RECORDS IN THE DELQMST FILE 03340 305 CALL UPDREC ( DEQREQ, DEQREC, ISTAT ) 03350C FILE ERROR? 03360 IF (ISTAT.GE.0) GO TO 310 03370 CALL FILERR ( DDATA, 15, ISTAT, LU ) 03380 GO TO 900 03390C ****************************** CONTINUE 03400 310 CONTINUE 03410 M = 1 03420 IF (EFG.EQ.0) GO TO 200 034301 03440C CLOSE THE FILES AND STOP 03450 900 CALL CLOSFL ( DEQREQ, ISTAT ) 03460 CALL CLOSFL ( ASNREQ, ISTAT ) 03470 CALL PGMOUT 03480 END 03490 SUBROUTINE R9BASE 03500 1 /C12 F CCS CCS 3.0 SL-149 03510C 03520C CYBERCREDIT SYSTEM VERSION 3 03530C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 03540C COPYRIGHT CONTROL DATA CORPORATION, 1979 03550C 03560 RETURN 03570 END 03580 SUBROUTINE R9FLDL 03590 1 /C13 F CCS CCS 3.0 SL-149 03600C 03610C CYBERCREDIT SYSTEM VERSION 3 03620C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 03630C COPYRIGHT CONTROL DATA CORPORATION, 1979 03640C 03650 RETURN 03660 END 03670 END/ 00040ITKDAC DCK/ I,H DAQUEL DCK/ I,H DEBDT1 DCK/ I,H DECMTN DCK/ I,H 00010 DEL/ 2 00020 1 /B39 F CCS CCS 3.0 1500 WD TB.SL-149 00030 DEL/ 9 00040 INTEGER TABLE(1502) 00050 DEL/ 16 00060 INTEGER Y, MSG(3), LN(3), ICMD(5), IU(2), IST(2) 00070 DEL/ 21 00080 DATA COMTLN/1500/ 00090 DEL/ 28,29 00100C**** IF NOT MASTER TERMINAL PRINTER LU = 05 00110 NPLU = 12 00120 IF (NPORT.NE.0) NPLU = 05 001301 00140 ASSIGN 150 TO INTRPT 00150 CALL PGMINT(INTRPT,INTRP) 00160 DEL/ 40,41 00170 WRITE(CRT,9000)COMTLN 00180 9000 FORMAT(' DECISION TABLE MAINTENCE PROGRAM IN (',I4,' WORDS)',/) 00190 DEL/ 51 00200 200 ICMD = 0 00210 CALL WTREAD( CRT, -1, MSG, 6, -1, ICMD, 8, K ) 00220 DEL/ 78 00230 900 WRITE(CRT,9012) ICMD(1) 00240 DEL/ 164 00250 5000 CALL PRTDT1(TABLE,NPLU) 00260DELDT1 DCK/ I,H DHUPDT DCK/ I,H 00010 DEL/ 2 00020 1 /B42 F CCS CCS 3.0 .LA - PSRD 07-83 SL-149 00030 DEL/ 9 00040 INS/ 20 00050C ???*A078 00060C 00070C PSR A078 MADE THE FOLLOWING CHANGES:- 00080C 1. THE ACTIVITY BLOCK FROM IS NOT 00090C MOVED TO . 00100C 2. THE ACTIVITY BLOCK FROM IS WRITTEN 00110C TO AS A NEW RECORD. 00120C 00130C THE REASON FOR THESE CHANGES IS THAT WILL READ 00140C WHEN IT NEEDS TO DISPLAY ACTIVITIES AND THE 00150C DATE OF ENTRIES IN DIFFERS FROM SYSTEM DATE. 00160C THE ORIGINAL IDEA WAS THAT THE LAST FEW ACTIVITIES WERE 00170C SAVED BOTH IN AND , BUT DOES NOT 00180C DISPLAY DUPLICATED ACTIVITIES ANYWAY. 00190C THEREFORE, THERE IS NO REASON TO STORE OLD ACTIVITIES 00200C IN . 00210C ???*A078 00220 INS/ 25 00230C ???*A078 00240 INTEGER ACTDAT(15), ACTREQ(24), ACTREC(252) 00250 1 , ROOM(3) 00260C ???*A078 00270 INS/ 30 00280C ****************************************************** ???*A012 00290 INTEGER MSG(10) 00300C ****************************************************** ???*A012 00310 DEL/ 32,35 00320 INTEGER TDAT(4),SDAT(4),DDAT(4) 003301 00340 DATA TDAT/'TAPEARC '/,SDAT/'SUMHIST '/,DDAT/'DELQMST '/ 00350 DATA ADATA/'LAADDACT',8*$2020,0,20,-1/ 00360 DATA TDATA/'LATAPARC',8*$2020,1, 1,-1/ 00370 DATA SDATA/'LASUMHST',8*$2020,1, 1,-1/ 00380 DATA DDATA/'LADLQMST',8*$2020,1,1,1/ 00390C ???*A078 00400 DATA ACTDAT/'LAACTFIL',8*$2020,1,1,0/ 00410 1 , ACTREQ/24*0/ 00420C ???*A078 00430C ****************************************************** ???*A012 00440 DATA MSG / 'TAPEARC RECORD ONLY ' / 00450C ****************************************************** ???*A012 00460 INS/ 71 00470 CALL CCSCST(ADATA,1,2,IDUSER,1,8,ICM) 00480 IF (ICM.EQ.0) GOTO 5 00490 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00500 CALL CCSMVA(TDAT ,1,8,TDATA,1,8) 00510 CALL CCSMVA(SDAT ,1,8,SDATA,1,8) 00520 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00530 CALL CCSMVA(ACTDAT,3,6,ACTDAT,1,8) 00540 5 CONTINUE 00550 DEL/ 97 00560C ???*A078 00570 IF(ISTAT.GE.0) GO TO 150 00580C ???*A078 00590 INS/ 99 00600C ???*A078 00610C OPEN ACTFIL 00620 150 CALL OPENFL(ACTREQ,ACTDAT,ISTAT) 00630 IF(ISTAT.GE.0) GO TO 200 00640 CALL FILERR(ACTDAT,3,ISTAT,LU) 00650 GO TO 950 00660C ???*A078 00670 DEL/ 122,123 00680C 2 CARDS DELETED ???*A078 00690 DEL/ 192 00700C*************** PSR TO CHECK FOR ZERO HOME PHONE ALSO *** 00710 IF ( II.EQ.2 .OR. II.EQ.4 ) GO TO 303 00720 GO TO 320 00730 303 CONTINUE 00740C*************** END PSR CORRECTION FOR ZERO HOME PHONE *** 00750 DEL/ 199 00760C ONE CARD DELETED ???*A078 00770 DEL/ 220 00780C ONE CARD CHANGED ???*A078 00790 CALL CCSCST(SUMREC,SPOS(7),90,BLK,1,90,ICOMP) 00800 DEL/ 248,251 00810 INS/ 254 00820C FIRST ???*A078 00830C--- CREATE RECORD. 00840C 00850C******** IF NO ACTIVITY SKIP THE CREATE OF THE ACTFIL RECORD - 03/83 00860 CALL CCSCST(SUMREC,193,4,ROOM,1,0,ICM) 00870 IF(ICM.EQ.0) GO TO 365 00880C******** PSR 03/83 END 00890C 00900 CALL CCSBLK(ACTREC,500) 00910C 00920C--- ACCOUNT GROUP & NUMBER 00930 CALL CCSMVA(DELQRC,1,16,ACTREC,1,16) 00940C--- SUFFIX = '51' 00950 ACTREC(9) = $3531 00960C 00970C--- ACTIVITY BLOCK FROM SUMHIST 00980C 00990C--- FIRST, ADD 122 BYTES TO AVAILABLE ROOM. 01000 ROOM = $3030 01010 CALL CCSMVA(SUMREC,193,4,ROOM,3,4) 01020 CALL DECHEX(ROOM,IROOM) 01030 IROOM = IROOM + 122 01040 CALL BINASC(IROOM,ROOM(2)) 01050 CALL CCSMVA(ROOM,3,4,ACTREC,19,4) 01060 CALL CCSMVA(SUMREC,197,356,ACTREC,145,356) 01070C 01080C--- WRITE THIS RECORD. 01090 CALL WRITER(ACTREQ,ACTREC,ACTREC,ISTAT) 01100 IF(ISTAT.GE.0) GO TO 365 01110 CALL FILERR(ACTDAT,12,ISTAT,LU) 01120 GO TO 950 01130 365 CONTINUE 01140C ???*A078 01150 DEL/ 284 01160C ************** ONE CARD DELETED HERE ************* ???*A012 01170 DEL/ 290 01180C ************** ONE CARD DELETED HERE ************* ???*A012 01190 INS/ 291 01200C ****************************************************** ???*A012 01210 IF (UPD .NE. $5400 ) GO TO 460 01220 CALL CCSMVA ( MSG, 1, 20, PRTLN, 68, 20 ) 01230C ****************************************************** ???*A012 01240 INS/ 296 01250C ****************************************************** ???*A012 01260 IF (UPD .EQ. $5400 ) GO TO 500 01270C ****************************************************** ???*A012 01280 INS/ 300 01290 CALL UPDREC(ADDREQ,ADDREC,ISTAT) 01300 IF(ISTAT.GE.0) GO TO 505 01310 CALL FILERR(ADATA,15,ISTAT,LU) 01320 GO TO 950 01330 505 CONTINUE 01340 DEL/ 305 01350 DEL/ 320,343 01360C ************** CARDS DELETED HERE **************** ???*0014 01370 INS/ 346 01380C ONE CARD ADDED ???*A078 01390 CALL CLOSFL(ACTREQ,ISTAT) 01400DMPFIL DCK/ I,H 00010 DEL/ 2 00020 1 /B45 F CCS CCS 3.0 . - PSRD 03/83 SL-149 00030 DEL/ 21 00040 INTEGER IREC(6000),ICNT(6),FCBHDR(6),BUFLEN 00050 EQUIVALENCE (FCBHDR(6),FCB(1)) 00060 INS/ 30 00070 DATA BUFLEN /6000/ 00080 DEL/ 38 00090 DATA MSG6/$0A0D,$0D0A,'RECORD EXCEEDS 2000 CHARACTERS '/ 00100 INS/ 44 001101 00120 ASSEM $C000,+FCBHDR,$6400,+IREQ(10) 00130 IREQ(13) = 96 00140 DEL/ 52,59 00150 110 CALL CCSBLK(IBUF,20) 00160 CALL WTREAD(LUNIT,-1,MSG2,22,-1,IBUF,18,ITC) 00170 IF(IBUF(10).EQ.0) GO TO 110 00180 IF(ITC.EQ.4) GO TO 110 00190 CALL CCSMVA(IBUF,1,16,IDATA,1,16) 002001 00210C GET VOLUME NAME 00220 120 CALL CCSBLK(IBUF,20) 00230 CALL WTREAD(LUNIT,-1,MSG3,18,-1,IBUF,18,ITC) 00240 IF(ITC.EQ.4) GO TO 120 00250 DEL/ 75,78 00260 DEL/ 89 00270 IF(RECLEN.GT.1000) GO TO 920 00280 NREC = BUFLEN/RECLEN 00290 IREQ(13)= NREC 00300 DEL/ 98 00310 170 CONTINUE 00320 INS/ 106 00330 IF (NREC.LE.0) GO TO 250 00340DPTDT1 DCK/ I,H DSPDT1 DCK/ I,H EDIT DCK/ I,H 00010 DEL/ 2 00020 1 /B50 F CCS CCS 3.0 PSR'D SL-149 00030 DEL/ 26 00040C ****************************************************** ???*A009 00050C 3 = DOLLAR AMOUNT. NINE DIGIT FIELD EDITED TO 9999999.99S 00060C S=SIGN: POS.=BLANK, NEG.='-' 00070C ****************************************************** ???*A009 00080 DEL/ 77,90 00090C ****************************************************** ???*A010 00100C ..CHECK LAST DIGIT FOR OVERPUNCH & CONVERT AS REQUIRED 00110 400 J = OSTART + LEN 00120 CALL CCSGET (OBUF, J, M) 00130C ..IF NO OVERPUNCH(ASCII), SET SIGN=BLANK(POS.) & EXIT 00140 IF (M .LE. NINE) GO TO 420 00150C ..IF OVERPUNCH = POSITIVE DIGIT($41-$49), CONVERT & SET SIGN 00160C .. = BLANK 00170 IF (M .GT. $49) GO TO 410 00180 M = M - $10 00190 CALL CCSPUT (M, J, OBUF) 00200 GO TO 420 00210C ..IF OVERPUNCH=POSITIVE ZERO, CONVERT TO ASCII ZERO & SET 00220C .. SIGN=BLANK 00230 410 IF (M .NE. $7B) GO TO 430 00240 CALL CCSPUT (ZERO, J, OBUF) 00250C ..SET SIGN = BLANK 00260 420 J = J + 1 00270 CALL CCSPUT (BLANK, J, OBUF) 00280 GO TO 500 00290C ..IF OVERPUNCH=NEG. ZERO, CONVERT & SET SIGN MINUS 00300 430 IF (M .NE. $7D) GO TO 440 00310 CALL CCSPUT (ZERO, J, OBUF) 00320 GO TO 450 00330C ..ASSUME OVERPUNCH = NEG. DIGIT($4A-$52), CONVERT & SET 00340C .. SIGN MINUS 00350 440 M = M - $19 00360 CALL CCSPUT (M, J, OBUF) 00370C ****************************************************** ???*A010 00380C ****************************************************** ???*A009 00390 450 J = J + 1 00400 CALL CCSPUT (MINUS, J, OBUF) 00410C ****************************************************** ???*A009 00420FILERR DCK/ I,H 00010 DEL/ 1,79 00020 SUBROUTINE FILERR(FILNAM,REQUES,ISTAT,LU) 00030 1 /B52 F CCS CCS 3.1 10-23-81 SL-149 00040C 00050C FORMAT USER-SUPPLIED VARIABLES INTO AN ERROR MESSAGE AND 00060C DISPLAY IT ON THE TERMINAL. THE CRT OPERATOR MUST 00070C ACKNOWLEDGE THE MESSAGE BY TYPING CARRIAGE-RETURN. 00080C 00090C FILNAM: FOUR-WORD ARRAY CONTAINING ASCII FILE NAME 00100C REQUES: INTEGER DESIGNATING REQUEST ON WHICH ERROR OCCURRED- 00110C 0 - CREATE 9 - RENAME 00120C 1 - CLEAR 10 - VOLUSE 00130C 2 - DELETE 11 - PUTS 00140C 3 - OPENFL 12 - WRITER 00150C 4 - CLOSFL 13 - READR 00160C 5 - LOKFIL 14 - GETS 00170C 6 - UNLFIL 15 - UPDREC 00180C 7 - GETFCB 16 - DELREC 00190C 8 - UPDFCB 17 - COMFIL 00200C ISTAT: FILE MANAGER ERROR STATUS WORD 00210C LU : LOGICAL UNIT OF TERMINAL ON WHICH TO DISPLAY MESSAGE 00220C 00230C IF IS OTHER THAN THE INTEGERS 0-17, IT IS CONVERTED 00240C TO ASCII HEX AND IS USED IN LIEU OF THE REQUEST NAME. 00250C 00260 INTEGER FILNAM(4), REQUES 00270 1 , MSG(38), ACK(8) 00280 2 , SCRACH(3) 00290 3 , FILREQ(57) 00300C 00310 DATA MSG/$0D0A,'FILE MANAGER ERROR: FILE NAME = 12345678, REQUEST 00320 1= 123456, ISTAT = 1234. '/ 00330 DATA LENMSG/75/ 00340C--- THE FOLLOWING SPECIFIES BYTE POSITIONS IN THE ERROR MESSAGE 00350C WHERE ACTUAL FILE NAME, REQUEST, AND ISTAT ARE PLACED. 00360 DATA NAMFIL/35/, NREQ/55/, NISTAT/71/ 00370C 00380 DATA FILREQ/'CREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCB' 00390 1 , 'UPDFCBRENAMEVOLUSEPUTS WRITERREADR GETS ' 00400 2 , 'UPDRECDELRECCOMFIL123456'/ 00410C 00420 DATA NONSTD/55/ 00430C 00440 DATA ACK/$0D0A,'CR TO CONTINUE'/ 00450 1 , LENACK/16/ 00460. PAGE EJECT 00470C 00480C--- MOVE FILE NAME. 00490 CALL CCSMVA(FILNAM,1,8,MSG,NAMFIL,8) 00500C 00510C--- SAVE REQUEST TYPE CODE. 00520 KODE = REQUES 00530 IF(KODE.GE.0.AND.KODE.LE.17) GO TO 100 00540C 00550C--- CONVERT THIS NON-STANDARD CODE TO ASCII HEX. 00560 CALL CCSHXA(KODE,FILREQ(NONSTD+1)) 00570 FILREQ(NONSTD) = $2024 00580C 00590C--- CHANGE REQUEST CODE SO THAT IT POINTS TO LAST ENTRY IN . 00600 KODE = 18 00610 100 CONTINUE 00620C 00630C--- MOVE REQUEST DESCRIPTION. 00640 J = 6*KODE +1 00650 CALL CCSMVA(FILREQ,J,6,MSG,NREQ,6) 00660C 00670C--- CONVERT TO ASCII HEX. PLUG INTO ERROR MESSAGE. 00680 CALL CCSHXA(ISTAT,MSG(36)) 00690C 00700C--- DISPLAY ERROR MESSAGE. 00710 CALL WTREAD(LU,-1,MSG,LENMSG,0,0,0,J) 00720C 00730C--- DISPLAY ACKNOWLEDGE MESSAGE AND WAIT FOR CARRIAGE-RETURN. 00740 CALL WTREAD(LU,-1,ACK,LENACK,-1,SCRACH,1,J) 00750C 00760C 00770 RETURN 00780 END 00790FTNDT1 DCK/ I,H 00010 DEL/ 2 00020 1 / F CCS CCS 3.0 1500 WD TBL SL-149 00030 DEL/ 22,23 00040 INTEGER TABLE (1502) 00050 DATA TABLE(2) /1500/ 00060GPMDT1 DCK/ I,H GTPDT1 DCK/ I,H GTSDT1 DCK/ I,H INPUT DCK/ I,H INTGR DCK/ I,H LCLRFL DCK/ I,H LDTDT1 DCK/ I,H LMOVDT DCK/ I,H LODDAT DCK/ I,H LODFIL DCK/ I,H 00010 DEL/ 2 00020 1 /B73 F CCS CCS 3.0 REPORT DUP RECORD SL-149 00030 INS/ 39 00040 INTEGER MSGA(15) 00050 DATA MSGA/$0D0C,'DUPLICATE RECORD CONTENTS ',$0D0A/ 00060 INS/ 106 00070 IF(AND(ISTAT,$8010).EQ.$8010) GO TO 202 00080 INS/ 107 00090 202 CONTINUE 00100 IWLEN=(BYTLEN+1)/2 00110 IF(IWLEN.GT.65 ) IWLEN=65 00120 IBLEN = IWLEN*2 00130 ISAV = OREC(IWLEN) 00140 OREC(IWLEN) = MSG2(1) 00150 CALL WTREAD(09,-1,MSGA,30,0,0,0,ITC) 00160 MSGA(1) = MSG2(1) 00170 CALL WTREAD(09,-1,OREC,IBLEN,0,0,0,ITC) 00180 OREC(IWLEN) = ISAV 00190 GO TO 170 00200LTPRNT DCK/ I,H 00010 DEL/ 2 00020 1 /B74 F CCS CCS 3.0 PSR'D SL-149 00030 DEL/ 46 00040 DATA MAXLEN/57/, PRTLEN/86/, NO/'N'/, MARGIN/$0005/ 00050 INS/ 93 00060 CALL PGMIN(FARRAY,LU,MODE,NPORT) 00070 IF(NPORT.NE.0) PRT=5 00080 DEL/ 411 00090C ****************************************************** ???*0007 00100 CALL CCSMVA (CONAME, 1, 12, OBUF, 37, 12) 00110C ****************************************************** ???*0007 00120 DEL/ 418 00130C ****************************************************** ???*0007 00140 CALL CCSMVA (PHONE, 1, 13, OBUF, 37, 13) 00150C ****************************************************** ???*0007 00160 DEL/ 424 00170C ****************************************************** ???*0007 00180 CALL CCSMVA (EXT, 1, 8, OBUF, 37, 8) 00190C ****************************************************** ???*0007 00200 DEL/ 431 00210C ****************************************************** ???*0007 00220 CALL CCSMVA (COLDP, 1, 15, OBUF, 37, 15) 00230LTRBLD DCK/ I,H 00010 DEL/ 2 00020 1 /B75 F CCS CCS 3.0 .LA PSR 07/83 SL-149 00030 DEL/ 47,51 00040 INTEGER INBUF(66), LTREC1(40), LTRS(100) , LFBUF, OBUF(66) 00050 DATA LFBUF/0/, LTREC1/40*$2A2A/, LTRS/100*$2020 /, OBUF/66*$2020/ 000601 00070 INTEGER LRPTBL(42), REQBRP(24), INAMKY(3),LRCBF1(42),TEMP 00080 DATA REQBRP/24*0/,INAMKY/3*0/,LRCBF1/42*$2020/ 00090 DEL/ 60,76 00100C******** FILE DESCRIPTION BUFFERS... 00110 INTEGER IDATLD(15),IDATRP(15),IDATLF(15),IDATUT(15) 00120 INTEGER DATLD(4) 001301 00140 DATA DATLD/'LTRDESC '/ 00150 DATA IDATLD/'LALTRDSC',8*$2020, 0, 1, 0/ 00160 DATA IDATRP/'LARPTTBL',8*$2020, 1, 1, 0/ 00170 DATA IDATLF/'LALTRFIL',8*$2020, 1, 1, 0/ 00180 DATA IDATUT/'LAUTIFIL',8*$2020, 1, 1, 1/ 00190 DEL/ 111,112 00200 INTEGER SNGLSP, DBLSPA,A1,A2,A3,A4,RE,TWO 00210 DATA SNGLSP/$000A/, DBLSPA/$0D0A/,TWO/$32/ 00220 DEL/ 132 00230 DATA WKKEY/0/,PRTLEN/86/ 00240 DEL/ 189 00250 DATA TEXT2/'NUMBER OF LETTERS EXCEED 50 '/ 002601 00270 INTEGER MXNUML,NLRC 00280 DATA MXNUML / 50/,NLRC / 1 / 00290 DEL/ 231 00300 20 IF (NOPORT .NE. 0) PRT = 5 003101 00320 CALL CCSCST(IDATUT,1,2,ID,1,8,ICM) 00330 IF(ICM.EQ.0) GO TO 25 00340 CALL CCSMVA(IDATUT,3,6,IDATUT,1,8) 00350 CALL CCSMVA(IDATRP,3,6,IDATRP,1,8) 00360 CALL CCSMVA(IDATLF,3,6,IDATLF,1,8) 00370 CALL CCSMVA(DATLD ,1,8,IDATLD,1,8) 00380 25 CONTINUE 00390 DEL/ 257 00400C******* CLEAR LTRFIL THEN OPEN IT. 004101 00420 CALL CLEAR(REQBLF,IDATLF,ISTAT) 00430 DO 56 IZ = 1,24 00440 56 REQBLF(IZ) = 0 00450 DEL/ 267 00460 65 IF (ISTAT .GE. 0) GO TO 90 00470 DEL/ 271,276 00480 DEL/ 285 00490 IF(AND(ISTAT,$100).EQ.$100) GO TO 196 00500 DEL/ 320 00510 CALL CCSMVA(HD2B, 1, 4, PRTBUF, 75, 4) 00520 DEL/ 344 00530 167 CALL CCSMVA(PAGOUT,1,4,PRTBUF,80,4) 00540 DEL/ 363 00550 196 NSWICH = NSWICH +1 00560 DEL/ 1189 00570 1500 IF(LTRCNT.GT.MXNUML)GO TO 1570 00580 DEL/ 1221 00590 CALL CCSMVA(HD2B,1,4,PRTBUF,75,4) 00600 DEL/ 1245 00610 1557 CALL CCSMVA(PAGOUT,1,4,PRTBUF,80,4) 00620 DEL/ 1261,1274 00630C PLACE LETTER NUMBER IN LETTER # ARRAY FOR SORT 006401 00650 LTRS(LTRCNT) = SAVKEY 00660 DEL/ 1297,1379 00670C COMPLETE UTILITY RECORDS LTR1 THRU LTR4. 006801 00690 1600 CONTINUE 007001 00710C SORT LETTER NUMBERS INTO ASCENDING ORDER. 00720C SORT IS A BUBBLE SORT. 007301 00740 K = 1 00750 MELM=LTRCNT-1 00760 IF (MELM.LE.1) GO TO 1610 00770 DO 1610 I=1,MELM 007801 00790 IF(LTRS(I).LT.LTRS(I+1))GO TO 1615 00800 TEMP = LTRS(I) 00810 LTRS(I) = LTRS(I+1) 00820 LTRS(I+1) = TEMP 00830 DO 1605 J=I,2,-K 00840 IF(LTRS(J).GT.LTRS(J-1))GO TO 1605 00850 TEMP = LTRS(J) 00860 LTRS(J) = LTRS(J-1) 00870 LTRS(J-1) = TEMP 00880 1605 CONTINUE 00890 1610 CONTINUE 00900C *** SORT COMPLETE *** 009102 00920 1615 K = LTRCNT 00930 1620 DO 1800 I = 0,NLRC 00940 J = 50 00950 IF( K.LT.26 ) J = K*2 00960 K2 = I*25+1 009701 00980 CALL CCSMVA( LTREC1,1,70,LRCBF1,1,80 ) 00990 CALL CCSMVA( LTRS(K2),1,J,LRCBF1,5,J ) 01000 CALL CCSMVA( LKEY1, 1, 4, LKEY2, 1,4 ) 01010 LKEY2(2) = LKEY2(2)+I 01020 CALL CCSMVA( LKEY2, 1, 4, LRCBF1,1,4 ) 01030 CALL CCSMVA( LRCBF1,1,80, OBUF ,1,80 ) 01040 K = K-25 01050 IF (K.LT.0) K=0 01060 1650 CONTINUE 01070 CALL WRITER ( REQBUT,LRCBF1,LKEY2,ISTAT ) 01080 IF (AND(ISTAT,$10).EQ.$10) GO TO 1675 01090 IF (ISTAT.GE.0) GO TO 1750 01100 CALL FILERR ( IDATUT,12,ISTAT,LU ) 01110 GO TO 2010 011201 01130C GET LTRX RECORD FROM UTILITY FILE. 011401 01150 1675 CALL READR(REQBUT, LRCBF1, LKEY2, ISTAT) 01160 IF(AND(ISTAT,$200).EQ.$200) GO TO 1860 01170 IF(AND(ISTAT,$100).EQ.$100) GO TO 1860 01180 1677 IF(ISTAT .GE. 0) GO TO 1680 01190 CALL FILERR(LRCBF1, 13, ISTAT, LU) 01200 GO TO 2010 012101 01220C MOVE UPDATE INFO TO LTRX RECORD BUFFER. 012301 01240 1680 CALL CCSMVA( OBUF, 1,80, LRCBF1, 1,80 ) 012501 012601 01270C REWRITE LTRX TO UTILITY FILE 012801 01290 1700 CALL UPDREC(REQBUT, LRCBF1, ISTAT) 01300 IF(ISTAT .GE. 0) GO TO 1750 01310 CALL FILERR(LRCBF1, 15, ISTAT, LU) 01320 GO TO 2010 013301 01340C MOVE LTR1 TO ECHO PRINT AND PRINT AFTER ADVANCING 01350C TO TOP OF PAGE.++++++++++++++++++++++++++++++++++++++++++++++++ 013601 01370 1750 CALL CCSBLK(PRTBUF,PRTLEN) 01380 PRTBUF(1)=DBLSPA 01390 IF(I.EQ.0) PRTBUF(1)=TOPPAG 01400 CALL CCSMVA(LRCBF1,1,60,PRTBUF,5,60) 01410 ASSIGN 1800 TO ICOMP 01420 CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP) 01430 CALL DISP 014401 01450 1800 CONTINUE 01460 GO TO 2010 014701 01480C LTRX RECORD WAS NOT FOUND PRINT MESSAGE 01490C WE SHOULD NEVER GET HERE BECAUSE OF WRITER. 015001 01510 1860 CALL CCSBLK(OBUF,PRTLEN) 01520 OBUF(1) = DBLSPA 01530 IF(I.EQ.0) OBUF(1) = TOPPAG 01540 CALL CCSMVA(LKEY2,4,1,UTFERR,21,1) 01550 1870 CALL CCSMVA(UTFERR,1,38,OBUF,10,38) 01560 IF(I.LT.NLRC) ASSIGN 1800 TO ICOMP 01570 IF(I.EQ.NLRC) ASSIGN 2010 TO ICOMP 01580LTRDTE DCK/ I,H LTRPRT DCK/ I=13,H 00010LTRPRT HOL/ 00020 PROGRAM LTRPRT 00010 1 /B77 F CCS CCS 3.0 PSR'D SL-149 000201 00030C CYBERCREDIT SYSTEM VERSION 3 00040C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION, 1979 00060C 000701 00080C THIS PROGRAM IS DESIGNED TO PRINT REQUESTED LETTERS 00090C THAT WERE REQUESTED BY COLLECTORS DURING THE COLLECTION 00100C ACTIVITIES. 00110C 00120C FILES, IO BUFFERS, AND FILE MANAGER******************** 001301 00140 INTEGER BUF(6),DATBUF(13),DMBUF(1000) 00150 DATA BUF/6*$2020/,DATBUF/13*$2020/ 001601 00170 INTEGER FARRAY(27),FULNAM(25),PBUF(67) 00180 DATA FARRAY/27*0/,FULNAM/25*$2020/ 00190 DATA PBUF/'1 ',66*' '/ 002001 00210 INTEGER LASNAM(15),LTFILB(756),LTRFBF(40),OBUF(66) 00220 DATA LASNAM/15*$2020/,LTFILB/756*$2020/,LTRFBF/40*$2020/ 002301 00240 INTEGER IOBUF(41),LTRARR(760) 00250 DATA IOBUF/41*0/,LTRARR/760*$2020/ 002601 00270 INTEGER REQ1(24),REQ2(24),REQ3(24),REQ4(24) 002801 00290 DATA REQ1/24*0/,REQ2/24*0/,REQ3/24*0/,REQ4/24*0/ 003001 00310 INTEGER SALARA(33),TFBUF(69) 00320 DATA SALARA/33*$2020/,TFBUF/69*$2020/ 003301 00340C FILE DATA........ 003501 00360 INTEGER DAT1(15),DAT2(15),DAT3(15),DAT4(15) 00370 +, LD1(4),LD2(4),LD3(4),LD4(4) 003801 00390 DATA DAT1/'LACOSIGN ',01,01,00/ 00400 +, DAT2/'LADLQMST ',01,01,00/ 00410 +, DAT3/'LALTRFIL ',01,01,00/ 00420 +, DAT4/'LATRNSFL ',00,01,00/ 004301 00440 DATA LD1 /'COSIGNER'/,LD2 /'DELQMST '/ 00450 +, LD3 /'LTRFIL '/,LD4 /'TRNSFL '/ 004601 00470C CONSTANTS***************** 004801 00490 INTEGER A,ADAYTO,AMONTO,ASTRSK,AT,AYERTO,B 00500 DATA A/$0041/,ASTRSK/$002A/,AT/$0040/,B/$0042/ 005101 00520 INTEGER BLANK(10),COMMA,LENGTH,COID,CC 00530 DATA BLANK/10*$2020/,COMMA/$2C2C/,LENGTH/0/,COID/0/,CC/2/ 005401 00550 INTEGER DATLIN,FIRLEN,FULLEN,EJT,DBLSPC 00560 DATA DATLIN/3/,EJT/'1 '/,DBLSPC/'0 '/ 005701 00580 INTEGER D,DOL,DT(3),EOF,EXT(2),FEQ 00590 DATA D/$0044/,DOL/$0024/,DT/3*0/,EOF/$100/ 00600 DATA FEQ/$463D/,EXT/'EXT'/ 006101 00620 INTEGER IEND(2),MARGIN,MAXLEN,NO,PUN 00630 DATA IEND/'END'/,MARGIN/13/,MAXLEN/57/ 00640 DATA NO/$4E20/ 006501 00660 INTEGER RECTYP,TWO,START 00670 DATA RECTYP/$3031/,TWO/$0032/ 006801 00690 INTEGER WRONKY,XYN,ZERO 00700 DATA WRONKY/$200/,XYN/-1/,ZERO/0/ 007101 00720 INTEGER YES,ZEROE 00730 DATA YES/$5920/,ZEROE/$3030/ 007401 00750C KEYS, VAIRABLES, MISC************** 007601 00770 INTEGER COL,COLCPO 00780 DATA COL/0/,COLCPO/0/ 007901 00800 INTEGER FCOUNT,FSWICH,IARAPT,IADR,ICTLD 00810 DATA FSWICH/0/,FCOUNT/0/,IARAPT/0/,IADR/0/,ICTLD/0/ 008201 00830 INTEGER ICOL,IPOINT,IPOS 00840 DATA ICOL/0/,IPOINT/0/,IPOS/0/ 008501 00860 INTEGER LCOUNT,LTLPT 00870 DATA LCOUNT/0/,LTLPT/0/ 008801 00890 INTEGER MNAM(15),MADR1(15),MADR2(15),MCS(10),MZP(3),MBNM(15) 00900 INTEGER MSLCD,LTBUPT,LTRF(2) 00910 DATA MSLCD/0/,LTBUPT/0/,LTRF/'LTRF'/ 009201 00930 INTEGER NOF,NUMCLC 00940 DATA NOF/0/,NUMCLC/0/ 009501 00960 INTEGER POS,SALC(2),SALLEN 00970 DATA POS/0/,SALC/'SALC'/,SALLEN/0/ 009801 00990 INTEGER TCIDWK(2),TCIDCK(2),TCIDKY(2) 010001 01010 INTEGER TACTKY(8),TACTWK(9) 010201 01030 INTEGER TCIDSC,TFKEY(8),TLACKY 01040 DATA TCIDSC/0/,TLACKY/0/ 010501 01060 INTEGER TLRKY,TLRPNT,TLRWKY,TYPE 01070 DATA TLRKY/0/,TLRPNT/0/,TLRWKY/0/,TYPE/0/ 010801 01090C MESSAGE BUFFERS************MESSAGE BUFFERS 011001 01110 INTEGER ACCTNO(10) 01120 DATA ACCTNO/$D0A,'1234567890123456',$D0A/ 011301 01140 INTEGER MSG2(40) 01150 DATA MSG2/$1820,'DO YOU WISH TO PRINT ALL OF THE LETTERS ' 01160 +, 'REQUESTED BY THE COLLECTORS?',$0D0A,' (Y/N): '/ 011701 01180 INTEGER MSG4(30) 01190 DATA MSG4/'LINE THE * TO THE TOP OF PAGE AND SEVENTH CHARACTER ' 01200 +, 'POSITION'/ 012101 01220 INTEGER MSG4A(31) 01230 DATA MSG4A/ 01240 1$1820,'DO YOU WISH TO HAVE ANOTHER ALIGNMENT ', 01250 2 'LINE PRINTED? (Y/N) :' / 012601 01270 INTEGER MSG6(40) 01280 DATA MSG6/ 01290 1$A0D,'ENTER ACCOUNT NUMBER OF THE NEXT LETTE', 01300 2 'R TO BE PRINTED - (16 DIGITS MAX). ',$0A0D/ 013101 01320 INTEGER MSG7(33) 01330 DATA MSG7/ ' UNABLE TO LOCATE ACCOUNT ', 01340 1 'IN THE DELQMST FILE '/ 013501 01360 INTEGER MSG5(33) 01370 DATA MSG5/$A0D,'UNABLE TO LOCATE ACCOUNT ', 01380 1 ' IN THE TRNSFL FILE '/ 013901 01400 INTEGER MSG9(23) 01410 DATA MSG9/ 01420 1 ' UNABLE TO LOCATE COLLECTOR TTTT IN UTIFIL. '/ 014301 01440 INTEGER MSG9A(40) 01450 DATA MSG9A/ 01460 1 ' LETTER TO BE SENT TO ACCOUNT NUMBER XX', 01470 2 'XXXXXXXXXXXXXX HAS NOT BEEN PRINTED '/ 014801 01490 INTEGER MSG10(40) 01500 DATA MSG10/ 01510 1 ' UNABLE TO LOCATE LETTER NUMBER ', 01520 2 'TO BE SENT TO ACCT# . '/ 015301 015401 01550 INTEGER MSG12(40) 01560 DATA MSG12/ 01570 1 ' UNABLE TO LOCATE ACCOUNT XXXXXXXXXXXXX', 01580 2 'XXX IN THE COSIGNER FILE '/ 015901 01600 INTEGER MSG13(23) 01610 DATA MSG13/ '1 UNABLE TO LOCATE LTRF RECORD IN THE UTIFIL '/ 016201 01630 INTEGER REFLIN(2),COF(2) 01640 DATA REFLIN/'RE: '/,COF/'C/O '/ 016501 016601 01670C EXTERNALS************************** 016801 01690 EXTERNAL AMONTO,AYERTO,ADAYTO 017001 01710C**** SYSPRT PARAMETERS........ 017201 01730 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 017401 01750 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 01760 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 01770 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 017801 01790 DATA PLN/080/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 018001 01810 INTEGER USER(4),GRPBUF(10) 01820 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 018301 01840 DATA PLU/12/,IWAY/3/,IMODE/3/ 018501 01860C**** 01870C**** BEGIN PROGRAM ....... 018801 01890C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 019001 01910 CALL PGMINT( IADR,ICTLD ) 019201 01930 CALL PGMIN ( USER,LU,MODE,NPORT ) 019401 01950C*** CCS/LA LOOK-ALIKE..... 019601 01970 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 01980 IF ( ICM.EQ.0 ) GO TO 5 01990 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 02000 CALL CCSMVA( LD2,1,8,DAT2,1,16 ) 02010 CALL CCSMVA( LD3,1,8,DAT3,1,16 ) 02020 CALL CCSMVA( LD4,1,8,DAT4,1,16 ) 02030 5 CONTINUE 020401 02050 CALL GTSYSP( IWAY, 25 ) 02060 CALL GTSYSP( IMODE, 26 ) 02070 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 02080 CALL GETGRP( GRPBUF,IALL,IMODE ) 020901 02100C**** OPEN FILES AND GET UTIFIL RECORDS 021101 02120 IF( NPORT.EQ.0 .OR. IPF.EQ.1 ) GO TO 25 02130 EJT = $0C20 02140 DBLSPC = $0A20 021501 02160 25 CONTINUE 021701 02180 CALL SYSPRT( ICM,0,SYSPRM,0 ) 02190 IF( ISERR.LT.0 ) GO TO 9840 022001 02210C BRING IN SYSTEM DATE 022201 02230 40 DT(1)=AND($FFFF,AMONTO) 02240 DT(2)=AND($FFFF,ADAYTO) 02250 DT(3)=AND($FFFF,AYERTO) 022601 02270C OPEN LETTER FILE (LTRFIL) 022801 02290 50 CALL OPENFL(REQ3,DAT3,ISTAT) 02300 IF( ISTAT.LT.0 ) GO TO 9820 023101 02320C OPEN TRANSACTION FILE (TRNSFL) 023301 02340 70 CALL OPENFL(REQ4,DAT4,ISTAT) 02350 IF( ISTAT.LT.0 ) GO TO 9830 023601 02370C OPEN DELINQUENT MASTER FILE (DELQMST) - OVERRIDE LOCKED RECORDS 023801 02390 80 CALL OPENFL(REQ2,DAT2,ISTAT) 02400 REQ2(23)=1 02410 IF( ISTAT.LT.0 ) GO TO 9810 024201 02430C OPEN COSIGNER FILE - OVERRIDE LOCKED RECORDS 024401 02450 90 CALL OPENFL(REQ1, DAT1, ISTAT) 02460 REQ1(23)=1 02470 IF( ISTAT.LT.0 ) GO TO 9800 024801 02490C INITIALIZE COUNTERS AND POINTERS 025001 02510 120 COLCPO=0 02520 NUMCLC=0 02530 LTLPT=0 02540 TLRPNT=0 02550 LTBUPT=0 025601 02570C PROMPT OPERATOR TO ALIGN PAPER IN PRINTER 025801 02590 200 CONTINUE 02600 CALL CCSBLK(OBUF,PLN) 02610 CALL CCSMVA( PBUF , 1, 2, OBUF, 1, PLN ) 02620C PUT * IN 7TH POSITION, REQUIRES DISPLACEMENT OF 8 02630 CALL CCSMVA (ASTRSK, 2, 1, OBUF, 8, 1) 02640 CALL CCSMVA(MSG4, 1, 60, OBUF, 12, 60) 026501 02660 230 CONTINUE 02670 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 026801 02690 240 CALL CCSBLK( IOBUF,80 ) 02700 CALL WTREAD(LU,XYN,MSG4A,62,XYN,IOBUF,80,ITC) 02710 IF(IOBUF(1) .EQ. YES) GO TO 230 02720 IF(IOBUF(1) .EQ. NO) GO TO 300 02730 GO TO 240 027401 02750 02760. 02770C*********************************************************************** 02780C 02790C READ UTILITY FILE TO 02800C GET SALUTATION CODES FROM UTILITY FILE 02810C 02820C*********************************************************************** 028301 02840 300 CONTINUE 02850 CALL GETUTI( SALC,IOBUF,IFOUND,IFER,0 ) 02860 IF( IFER.LT.0 ) GO TO 9840 02870 IF( IFOUND.NE.1 ) GO TO 330 028801 02890 320 CONTINUE 02900 CALL CCSMVA( SALC,1,4,MSG13,20,4 ) 02910 GO TO 350 029201 02930C LOAD SALUTATION CODES ARRAY 029401 02950 330 CALL CCSMVA(IOBUF, 5, 65, SALARA, 1, 65) 029601 02970C READ THE LTRF RECORD FROM THE UTIFIL 02980 340 CONTINUE 02990 CALL GETUTI( LTRF,LTRFBF,IFOUND,IFER,0 ) 03000 IF( IFER.LT.0 ) GO TO 9840 03010 IF( IFOUND.NE.1 ) GO TO 400 030201 03030C DID NOT FIND LTRF PRINT MESSAGE 03040 350 CONTINUE 03050 CALL CCSMVA(MSG13,1,46,OBUF,1,PLN) 03060 360 CONTINUE 03070 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 03080 GO TO 9900 030901 03100C*********************************************************************** 03110C 03120C CHECK WITH OPERATOR TO DETERMINE IF ALL LETTERS ARE TO BE 03130C PRINTED. 03140C 03150C*********************************************************************** 031601 03170 400 CONTINUE 03180 CALL CCSBLK( IOBUF,80 ) 03190 410 CALL WTREAD(LU,XYN,MSG2,80,XYN,IOBUF,80,ITC) 03200 IF(IOBUF(1) .EQ. YES) GO TO 430 03210 IF(IOBUF(1) .EQ. NO) GO TO 420 03220 GO TO 400 032301 03240C GET ACCOUNT NUMBER FROM OPERATOR 032501 03260 420 CALL CCSBLK( IOBUF,80 ) 03270 MSG2 = MSG6 03280 CALL WTREAD(LU,XYN,MSG6,80,0, 0, 0, ITC) 03290 CALL WTREAD(LU,XYN,ACCTNO,20,XYN,IOBUF,80 ,ITC) 03300 IF( ITC.NE.2 ) GO TO 420 033101 03320 CALL CCSMVA( IOBUF,1,IOBUF(41),TACTWK,1,16 ) 033301 033401 03350C LOCATE ACCOUNT IN TRANSACTION FILE LETTER PRINT IS TO 03360C START WITH 033701 03380 430 CONTINUE 03390 TFKEY(1) = ZERO 03400 TFKEY(2) = 1 034101 03420 CALL READR( REQ4,TFBUF,TFKEY,ISTAT ) 03430 IF( IOBUF.EQ.YES ) GO TO 507 03440 GO TO 445 034501 03460 440 CONTINUE 03470 CALL GETS( REQ4,TFBUF,TFKEY,ISTAT ) 03480 445 CONTINUE 03490 IF( AND(ISTAT,EOF).EQ.EOF ) GO TO 470 03500 IF( ISTAT.LT.0 ) GO TO 9830 035101 03520 450 CALL CCSCST(TFBUF, 1, 16, TACTWK, 1, 16, ICOMP) 03530C ****************************************************** ???*A031 03540 IF (ICOMP .NE. 0) GO TO 440 03550C CHECK TO BE SURE THIS RECORD IS A VALID LETTER REQUEST. 03560 CALL CCSCST (TFBUF, 29, 2, RECTYP, 1, 2, ICOMP) 03570 IF (ICOMP .NE. 0) GO TO 440 03580 CALL CCSCST (TFBUF, 41, 2, BLANK, 1, 2, ICOMP) 03590 IF (ICOMP .EQ. 0) GO TO 440 03600 GO TO 520 03610C ****************************************************** ???*A031 036201 03630C*** NOTIFY OPERATOR OF INABILITY TO LOCATE ACCOUNT NUMBER 036401 03650 470 CALL CCSMVA(TACTWK,1,16,MSG5,28,16) 03660 CALL WTREAD(LU,XYN,MSG5,66,0,0,0,ITC) 03670 GO TO 400 036801 03690. 03700C*********************************************************************** 03710C 03720C READ TRANSACTION FILE 03730C 03740C*********************************************************************** 037501 03760 500 CONTINUE 03770 IF( ICTLD.NE.0 ) GO TO 9900 03780 CALL CCSBLK(TACTKY, 16) 03790 CALL CCSBLK(TLRKY, 2) 03800 TLACKY=0 038101 03820 505 CALL GETS (REQ4, TFBUF, TFBUF, ISTAT) 03830 507 IF(AND(ISTAT, EOF) .EQ. EOF) GO TO 3000 03840 IF( ISTAT.LT.0 ) GO TO 9830 038501 03860C CHECK FOR RECORD TYPE 038701 03880 520 CALL CCSCST(TFBUF, 29, 2, RECTYP, 1, 2, ICOMP) 03890 IF(ICOMP .NE. 0) GO TO 500 03900 CALL CCSCST(TFBUF,41,2,BLANK,1,2,ICOMP) 03910 IF(ICOMP.EQ.0) GO TO 500 039201 03930C*** CHECK FOR VALID ACCOUNT GROUP 03940 IF( ICKGRP( GRPBUF,IALL,TFBUF,1 ).EQ.1 ) GO TO 500 039501 03960C MOVE ACCOUNT NUMBER (TACCT) TO KEY (TACTKY) 039701 03980 03990 530 CALL CCSMVA(TFBUF, 1, 16, TACTKY, 1, 16) 040001 04010C READ UTIFIL TO GET COLLECTOR INFO 04020C IF COLLECTOR ID NOT FOUND DONT PROCESS 04030C ANY OF THE LETTERS WITH THIS ID. 040401 04050 540 CALL CCSMVA(TFBUF,17,4,TCIDKY,1,4) 040601 04070 550 COID=0 040801 04090C*** IF SAME COLLECTOR ID AS LAST, THEN SKIP 041001 04110 CALL CCSCST( TCIDKY,1,4,MSG9,30,4,ICM ) 04120 IF( ICM.EQ.0 ) GO TO 566 04130 CALL CCSCST( TCIDKY,1,4,IOBUF,1,4,ICM ) 04140 IF( ICM.EQ.0 ) GO TO 570 041501 04160 CALL GETUTI( TCIDKY,IOBUF,IFOUND,IFER,0 ) 04170 IF( IFOUND.NE.1 ) GO TO 570 04180 IF( IFER.LT.0 ) GO TO 9840 041901 04200C COLLECTOR ID WAS NOT FOUND PRINT MESSAGE 04210 560 CONTINUE 04220 CALL CCSMVA(TFBUF,17,4,MSG9,30,4) 04230 CALL CCSMVA(MSG9,1,46,OBUF,1,PLN) 042401 04250C PRINT MESSAGE COID NOT FOUND 042601 04270 564 CONTINUE 04280 PBUF = EJT 04290 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 04300 PBUF = DBLSPC 04310 CALL SYSPRT( PBUF,2,SYSPRM,0 ) 04320 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 04330 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 043401 04350 566 CONTINUE 04360 CALL CCSMVA(TFBUF,1,16,MSG9A,39,16) 04370 CALL CCSMVA(MSG9A,1,80,OBUF,1,PLN) 043801 04390C PRINT ACCOUNT NUMBER OF LETTER NOT PRINTED 044001 04410 568 CONTINUE 04420 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 04430 GO TO 500 044401 04450C MOVE LETTER CODE(TLR) TO KEY (TLRKY) 044601 04470 570 CALL CCSMVA(TFBUF, 41, 2, TLRKY, 1, 2) 044801 044901 04500C MOVE LETTER ADDRESS CODE (TLAC) TO KEY (TLACKY) 045101 04520 580 CALL CCSGET(TFBUF, 105, TLACKY) 045301 04540. 04550C*********************************************************************** 04560C 04570C READ LETTER FILE(LTFIL) KEY = TLRKY FROM 04580C TRANSACTION FILE 04590C 04600C*********************************************************************** 046101 04620 700 CALL CCSCST(TLRKY, 1, 2, TLRWKY, 1, 2, ICOMP) 04630 IF(ICOMP .EQ. 0) GO TO 1000 046401 04650C NOT EQUAL MOVE KEY TO WORK KEY 046601 04670 730 CALL CCSMVA(TLRKY, 1, 2, TLRWKY, 1, 2) 046801 04690C TLRKY AND TLRWKY NOT EQUAL - READ LETTER FILE 047001 04710 750 CALL READR(REQ3,LTFILB, TLRKY, ISTAT) 04720 IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 780 04730 IF( ISTAT.LT.0 ) GO TO 9820 04740 GO TO 900 047501 04760C NOTIFY OPEATOR UNABLE TO LOCATE REQUESTED LETTER 047701 04780 780 CALL CCSMVA(TLRWKY,1, 2, MSG10, 34, 2) 04790 CALL CCSMVA(TACTKY, 1, 16, MSG10, 61, 16) 04800 CALL CCSMVA(MSG10,1,80,OBUF,1,PLN) 04810 GO TO 2200 048201 04830C INITIALIZE COUNTERS AND ARRAYS 048401 04850 900 FCOUNT=0 04860 FSWICH=0 04870 IPOINT=0 04880C DMBUPT=0 04890 LCOUNT=0 04900 ICOL=0 04910 NOF=0 049201 04930C MOVE MAXIMUM OF 9 VALID FIELD DESCRIPTIONS TO TABLE FARRAY 049401 04950 920 IPOINT=IPOINT+3 04960 IARAPT=1 04970 CALL CCSBLK(FARRAY,54) 049801 04990 930 DO 990 I=1,9 05000 CALL CCSCST(LTFILB,IPOINT,2,FEQ,1,2,ICOMP) 05010 935 IF(ICOMP .NE. 0) GO TO 995 050201 05030C LTFILB = 'F=' - SET SWITCH AND MOVE POINTER 050401 05050 940 FSWICH=1 05060 IPOINT=IPOINT+2 050701 05080C CHECK FOR 'F=NO' - WHICH DESIGNATES A LETTER WITH NO F FIELDS. 050901 05100 950 CALL CCSCST(LTFILB,IPOINT, 1, NO, 1, 1, ICOMP) 05110 IF(ICOMP.NE.0) GO TO 960 05120 NOF=1 05130 IPOINT=IPOINT+1 05140 START=IPOINT 05150 GO TO 1000 051601 05170C STORE IN ARRAY USING LINE NUMBER AS POINTER 051801 05190 960 CALL CCSMVA(LTFILB, IPOINT, 6, FARRAY, IARAPT, 6) 052001 05210C INCREMENT COUNTERS AND POINTERS 052201 05230 970 IARAPT=IARAPT+6 05240 IPOINT=IPOINT+6 05250 FCOUNT=FCOUNT+1 052601 05270 990 CONTINUE 05280 995 START=IPOINT 05290. 05300C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 05310C 05320C READ INFORMATION FOR LETTER 05330C 05340C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 053501 05360C*** CHECK IF TO SEND TO COSIGNER OR BORROWER ? 053701 05380 1000 CONTINUE 05390 IF( TLACKY.LT.$31 .OR. TLACKY.GT.$33 ) GO TO 1030 054001 05410C SEND TO COSIGNER READ COSIGNER FILE 05420 CALL READR(REQ1,DMBUF,TACTKY,ISTAT) 05430 IF(AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 1010 05440 IF(AND(ISTAT,EOF).EQ.EOF) GO TO 1010 05450 IF(ISTAT.LT.0) GO TO 9800 05460 GO TO 1020 054701 05480C COSIGNER WAS NOT FOUND PRINT MESSAGE 05490 1010 CONTINUE 05500 CALL CCSMVA( TFBUF,1,16,MSG12,28,16 ) 05510 CALL CCSMVA(MSG12,1,80,OBUF,1,PLN ) 05520 GO TO 2200 055301 05540C SEND TO CORRECT COSIGNER 05550 1020 J=((TLACKY-$30)-1)*115 05560 CALL CCSMVA(DMBUF,J+20,30,MNAM,1,30) 05570 CALL CCSMVA(DMBUF,J+50,30,MADR1,1,30) 05580 CALL CCSBLK(MADR2,30) 05590 CALL CCSMVA(DMBUF,J+80,20,MCS,1,20) 05600 CALL CCSMVA(DMBUF,J+100,5,MZP,1,5) 05610 CALL CCSBLK(MBNM,30) 05620 CALL CCSGET(DMBUF,J+18,MSLCD) 056301 05640C READ DELQMST FOR LETTER FIELDS 05650 1030 CONTINUE 05660 CALL READR(REQ2,DMBUF,TACTKY,ISTAT) 05670 IF(AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 1040 05680 IF(AND(ISTAT,EOF).EQ.EOF) GO TO 1040 05690 IF(ISTAT.LT.0) GO TO 9810 05700 GO TO 1050 057101 05720C DID NOT FIND BORROWER PRINT MESSAGE 05730 1040 CONTINUE 05740 CALL CCSMVA( TFBUF,1,16,MSG7,28,16 ) 05750 CALL CCSMVA(MSG7,1,66,OBUF,1,PLN) 05760 GO TO 2200 057701 05780C CHECK FOR HOME OR BUSINESS 05790C MOVE IN DATA FOR HEADINGS 05800C************************************************************ ???*A03 05810C FIRST MOVE THE LETTER DATE 05820C AND AMOUNT FROM TRANSFL 05830 1050 CALL CCSMVA(TFBUF,106,6,DMBUF,842,6) 05840 CALL CCSMVA(TFBUF,112,9,DMBUF,848,9) 05850 IF(TLACKY.EQ.B) GO TO 1070 05860C*********************************************************** ???*A037 05870C CHECK IF COSIGNER 05880 IF(TLACKY .GE. $31 .AND. TLACKY .LE. $33) GO TO 1100 058901 05900C SEND TO BORROWERS HOME 05910 1060 CALL CCSGET( DMBUF,17,MSLCD ) 05920 CALL CCSMVA(DMBUF,18,30,MNAM,1,30) 05930 CALL CCSMVA(DMBUF,48,30,MADR1,1,30) 05940 CALL CCSMVA(DMBUF,78,30,MADR2,1,30) 05950 CALL CCSMVA(DMBUF,108,30,MCS,1,20) 05960 CALL CCSMVA(DMBUF,128,5,MZP,1,5) 05970 CALL CCSBLK(MBNM,30) 05980 GO TO 1100 059901 06000C SEND TO BORROWERS BUSINESS ADDRESS 06010 1070 CALL CCSMVA(DMBUF,18,30,MNAM,1,30) 06020 CALL CCSGET( DMBUF,17,MSLCD ) 06030 CALL CCSMVA(DMBUF,177,30,MADR1,1,30) 06040 CALL CCSMVA(DMBUF,207,20,MCS,1,20) 06050 CALL CCSMVA(DMBUF,227,5,MZP,1,5) 06060 CALL CCSMVA(DMBUF,147,30,MBNM,1,30) 06070 CALL CCSBLK(MADR2,30) 06080 GO TO 1100 06090. 06100C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 06110C 06120C PRINT THE LETTER 06130C 06140C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 061501 06160C PRINT THE TOP 8 LINES 06170 1100 CONTINUE 06180 PBUF = EJT 06190 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 06200 PBUF = DBLSPC 06210 CALL SYSPRT( PBUF,DATLIN,SYSPRM,0 ) 062201 06230C PRINT DATE 06240C BLANK OUT BUFFER RECEIVING CONVERTED DATE 06250 1140 CALL CCSBLK( OBUF,PLN ) 06260 CALL CCSBLK(DATBUF,26) 06270 CALL LTRDTE(DT,DATBUF,1,1) 06280 1150 CALL CCSMVA(DATBUF,1,26,OBUF,46,26) 06290 OBUF = DBLSPC 06300 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 063101 06320C PRINT REFERENCE 06330 1160 CALL CCSBLK( OBUF(2),PLN-2 ) 06340 CALL CCSMVA(REFLIN,1,4,OBUF,46,4) 063501 06360C CHECK ACCOUNT SWITCH IN LTRF 06370 1170 CALL CCSCST(LTRFBF,5,1,TWO,2,1,ICOMP) 06380 CALL CCSMVA(TFBUF,2,15,OBUF,51,15) 06390 IF(ICOMP.EQ.0) GO TO 1180 06400 CALL CCSMVA(TFBUF,1,1,OBUF,50,1) 06410 1180 CONTINUE 06420 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 064301 06440C GET SALUTATION 06450C ****************************************************** ???*A034 06460 1190 SALLEN = 1 06470 CALL CCSBLK (FULNAM, 40) 06480 CALL CCSBLK (LASNAM, 30) 06490C CHECK FOR NON-LEGAL SALUTATION CODE 06500 IF (MSLCD .LT. $31 .OR. MSLCD .GT. $38) GO TO 1220 06510 MSLCD = MSLCD - $30 06520C ****************************************************** ???*A034 06530 N=(MSLCD-1)*8+1 06540 CALL CCSMVA(SALARA,N,8,FULNAM,1,8) 065501 06560C FIND END OF SALUTATION 06570 1200 DO 1210 I=1,8 06580 CALL CCSCST(FULNAM,I,1,BLANK,1,1,ICOMP) 06590 IF(ICOMP.EQ.0) GO TO 1215 06600 1210 CONTINUE 06610 1215 IF(I.GT.1) GO TO 1216 06620 SALLEN=1 06630 GO TO 1220 06640 1216 SALLEN=I+1 066501 06660C FIND END OF LAST NAME 06670 1220 DO 1230 I=1,30 06680 CALL CCSCST(MNAM,I,1,COMMA,1,1,ICOMP) 06690 IF(ICOMP.EQ.0) GO TO 1250 06700 1230 CONTINUE 067101 06720C COMMA NOT FOUND PRINT AS IS 06730 CALL CCSMVA(MNAM,1,30,FULNAM,SALLEN,30) 067401 06750C FIND END OF NAME 06760 DO 1245 FULLEN=30,1,-1 06770 CALL CCSCST(FULNAM,FULLEN,1,BLANK,1,1,ICOMP) 06780 IF(ICOMP.NE.0) GO TO 1246 06790 1245 CONTINUE 06800 FULLEN=30 06810 1246 GO TO 1290 068201 06830C MOVE LAST NAME INTO BUFFER 06840 1250 LASLEN=I-1 06850 CALL CCSMVA(MNAM,1,LASLEN,LASNAM,1,LASLEN) 068601 068701 06880C FIND FIRST NAME 06890 1260 N1=I+1 06900 DO 1262 I=N1,30 06910 CALL CCSCST(MNAM,I,1,BLANK,1,1,ICOMP) 06920 IF(ICOMP.NE.0) GO TO 1264 06930 1262 CONTINUE 069401 06950C NO FIRST NAME 06960 CALL CCSMVA(MNAM,1,LASLEN,FULNAM,SALLEN,LASLEN) 06970 FULLEN=LASLEN+SALLEN 06980 GO TO 1290 069901 07000C FOUND FIRST NAME, FIND END OF FIRST NAME 07010 1264 N1=I 07020 DO 1266 I=N1,30 07030 CALL CCSCST(MNAM,I,1,BLANK,1,1,ICOMP) 07040 IF(ICOMP.EQ.0) GO TO 1275 07050 1266 CONTINUE 070601 07070C DID NOT FIND END OF FIRST NAME 07080 FIRLEN=30-N1+1 07090 GO TO 1280 071001 07110C SEE IF THERE IS MIDDLE INITIAL 07120 1275 CALL CCSCST(MNAM,I+1,1,BLANK,1,1,ICOMP) 07130 IF(ICOMP.NE.0) GO TO 1276 071401 07150C NO MIDDLE INITIAL 07160 FIRLEN=I-N1 07170 GO TO 1280 071801 07190C INCLUDE MIDDLE INITIAL IN FIRST NAME 07200 1276 FIRLEN=I-N1+2 072101 07220C MOVE FIRST NAME, MI AND LAST INTO FULNAM 07230 1280 FULLEN=SALLEN 07240 CALL CCSMVA( MNAM,N1,FIRLEN,FULNAM,FULLEN,FIRLEN) 07250 FULLEN=FULLEN+FIRLEN+1 07260 CALL CCSMVA(LASNAM,1,LASLEN,FULNAM,FULLEN,LASLEN) 07270 FULLEN=FULLEN+LASLEN-1 072801 07290C PRINT 2 BLANK LINES 07300 1290 CONTINUE 07310 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 073201 07330C PRINT NAME 07340 1300 CALL CCSBLK(OBUF,PLN) 07350 CALL CCSMVA(FULNAM,1,30,OBUF,MARGIN,30) 073601 07370 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 073801 07390C IF SENT TO BUSINESS PRINT C/O LINE 07400 1320 CALL CCSBLK( OBUF,PLN ) 07410 IF(TLACKY.NE.B) GO TO 1330 07420 CALL CCSMVA(COF,1,4,OBUF,MARGIN,4) 07430 CALL CCSMVA(MBNM,1,30,OBUF,MARGIN+5,30) 074401 07450 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 074601 07470C PRINT ADDRESS 1 07480 1330 CALL CCSBLK( OBUF,PLN ) 07490 CALL CCSMVA(MADR1,1,30,OBUF,MARGIN,30) 075001 07510 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 075201 07530C IF THERE IS A ADDRESS 2 PRINT IT 07540 1340 CALL CCSCST(MADR2,1,10,BLANK,1,10,ICOMP) 07550 IF(ICOMP.EQ.0) GO TO 1350 07560 CALL CCSBLK( OBUF,PLN ) 07570 CALL CCSMVA(MADR2,1,30,OBUF,MARGIN,30) 075801 07590 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 076001 07610C PRINT MCS AND ZIP 07620 1350 CALL CCSBLK( OBUF,PLN ) 07630 CALL CCSMVA(MCS,1,20,OBUF,MARGIN,20) 07640 CALL CCSMVA(MZP,1,5,OBUF,MARGIN+22,5) 07650 1355 CONTINUE 07660 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 076701 07680C PRINT 2 BLANK LINES 07690 1360 CALL CCSBLK(OBUF,PLN) 077001 07710 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 077201 07730 1370 CONTINUE 07740. 07750C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 07760C 07770C BUILD BODY OF THE LETTER 07780C 07790C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 078001 07810 1400 CALL CCSBLK(LTRARR,1520) 07820 IPOINT=START 07830 IAT=0 07840 CC=2 07850 1405 DO 1650 I=1,24 07860 IPOS=IPOINT 07870 LB=(I-1)*60+1 07880 LW=(I-1)*30+1 07890 LINCT=I 079001 07910C CHECK FOR END 07920 1430 CALL CCSCST(LTFILB,IPOINT,3,IEND,1,3,ICOMP) 07930 IF(ICOMP.EQ.0) GO TO 1660 079401 07950C IF FIRST LINE, GO CHECK FOR @ 07960 1440 IF(LINCT.EQ.1) GO TO 1500 079701 07980C LOOK FOR CARRIAGE CONTROL AND LENGTH 07990 1450 DO 1470 J=1,MAXLEN 080001 08010C MOVE IN CARRIAGE CONTROL FOR LAST LINE 08020 LTRARR(LW)=CC 080301 08040C GET BYTE AND CHECK FOR * 08050 1460 CALL CCSGET(LTFILB,IPOINT,N) 08060 1465 IF(N.EQ.ASTRSK) GO TO 1480 08070 IPOINT=IPOINT+1 080801 08090C END OF ASTERSK SEARCH LOOP 08100 1470 CONTINUE 081101 08120C BYTE WAS * GET CARRIAGE CONTROL 08130 1480 LENGTH=IPOINT-IPOS 08140 IPOINT=IPOINT+2 08150 CALL CCSGET(LTFILB,IPOINT,N) 08160 CC=N-$30 081701 08180C MOVE IN THE TEXT AND GET NEXT LINE 08190 1490 CALL CCSMVA(LTFILB,IPOS,LENGTH,LTRARR,LB+2,LENGTH) 08200 GO TO 1640 08210. 082201 08230C FIRST LINE ONLY 08240C CHECK FOR @ 08250 1500 DO 1630 J=1,MAXLEN 082601 08270C MOVE IN CARRIAGE CONTROL FROM LAST LINE 08280 LTRARR(LW)=CC 082901 08300C GET BYTE AND CHECK FOR @ 08310 1510 CALL CCSGET(LTFILB,IPOINT,N) 08320 1520 IF(N.NE.AT) GO TO 1600 083301 08340C BYTE WAS @ MOVE IN TEXT BEFORE @ 08350 1530 LENGTH=IPOINT-IPOS 08360 IAT=1 08370 CALL CCSMVA(LTFILB,IPOS,LENGTH,LTRARR,LB+2,LENGTH) 08380 LB=LB+LENGTH 08390 IPOINT=IPOINT+1 084001 08410C GET NAME TYPE 08420 1540 CALL CCSGET(LTFILB,IPOINT,N) 08430 NAMSW=N-$30 08440 IPOINT=IPOINT+1 084501 08460C GET PUNCUATION 08470 1550 CALL CCSGET(LTFILB,IPOINT,N) 08480 PUN=N 08490 IPOINT=IPOINT+3 085001 08510C GET CARRIAGE CONTROL 08520 1560 CALL CCSGET(LTFILB,IPOINT,N) 08530 CC=N-$30 085401 08550C MOVE IN THE NAME 08560 1570 IF(NAMSW.EQ.2.AND.SALLEN.GT.1) GO TO 1580 08570 CALL CCSMVA(FULNAM,1,FULLEN,LTRARR,LB+2,FULLEN) 08580 LB=LB+2+FULLEN 08590 GO TO 1590 08600C SET UP CORRECT SPACING FOR SALUTATION 08610 1580 SALLEN = SALLEN - 1 08620 CALL CCSMVA(FULNAM,1,SALLEN,LTRARR,LB+2,SALLEN) 08630 LB=LB+SALLEN 08640 CALL CCSMVA(LASNAM,1,LASLEN,LTRARR,LB+2,LASLEN) 08650 LB=LB+LASLEN+2 086601 08670C MOVE IN PUNCUATION AND GET NEXT LINE 08680 1590 CALL CCSMVA(PUN,2,1,LTRARR,LB,1) 08690 GO TO 1640 087001 08710C WAS NOT @ CHECK FOR * 08720 1600 IF(N.NE.ASTRSK) GO TO 1620 087301 08740C WAS * GET CARRIAGE CONTROL 08750 IPOINT=IPOINT+2 08760 CALL CCSGET(LTFILB,IPOINT,N) 08770 CC=N-$30 087801 08790C CHECK IF @ WAS FOUND 08800 1610 IF(IAT.EQ.1) GO TO 1640 088101 08820C NO @ WAS FOUND TREAT AS REGULAR LINE 08830 1615 LENGTH=IPOINT-IPOS-2 08840 GO TO 1490 088501 08860 1620 IPOINT=IPOINT+1 088701 08880C END OF FIRST ONLY LOOP 08890 1630 CONTINUE 089001 08910C END OF BUILD LETTER BODY LOOP 08920 1640 IPOINT=IPOINT+1 08930 1650 CONTINUE 08940. 08950C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 08960C 08970C BODY FOR LETTER HAS BEEN BUILT 08980C PUT IN PLUGS 08990C 09000C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 090101 09020 1660 DO 1710 I=1,9 09030 IW=(I-1)*3+1 09040 1665 IF(FARRAY(IW).EQ.BLANK) GO TO 1730 09050 LINE=FARRAY(IW)/$100 09060 COL=AND(FARRAY(IW),$FF) 09070 LB=(LINE-1)*60+COL+2 09080 LENGTH=FARRAY(IW+1)/$100 09090 TYPE=AND(FARRAY(IW+1),$FF) 09100 POS=AND(FARRAY(IW+2),$FFFF) 091101 09120C CHECK FOR WHICH TYPE OF PLUG 09130 1670 IF(TYPE.EQ.D) GO TO 1680 09140 IF(TYPE.EQ.DOL) GO TO 1690 09150 IF(TYPE.EQ.A) GO TO 1700 09160 GO TO 1700 091701 09180C TYPE WAS DATE MOVE IN DATE 09190C IF MASTER FILE POS IS ZERO, USE CURRENT DATE 09200 1680 IF (POS .NE. $0000) GO TO 1682 09210 CALL EDIT (DT, 1, LTRARR, LB, 1) 09220 GO TO 1710 09230C CHECK TYPE OF DATE TO PRINT 09240 1682 IF(LENGTH.EQ.2.OR.LENGTH.EQ.1) GO TO 1685 09250 IF(IDATVR(DMBUF,POS).LT.0) GO TO 1710 09260 CALL EDIT(DMBUF,POS,LTRARR,LB,1) 09270 GO TO 1710 09280 1685 CALL CCSMVA(DMBUF,POS,6,BUF,1,6) 09290 IF(IDATVR(BUF,1).LT.0) GO TO 1710 09300C DATE TYPE EQUAL 1 OR 2 09310 CALL CCSBLK(DATBUF,18) 09320 CALL LTRDTE(BUF,DATBUF,1,LENGTH) 09330 IF(LENGTH.EQ.1) CALL CCSMVA(DATBUF,1,18,LTRARR,LB,18) 09340 IF(LENGTH.EQ.2) CALL CCSMVA(DATBUF,1,12,LTRARR,LB,12) 09350 GO TO 1710 093601 09370C TYPE WAS DOLLAR,CENTER AND MOVE IN $ 09380 1690 CALL CCSBLK(BUF,12) 09390 CALL CCSMVA(BLANK,1,11,LTRARR,LB,11) 09400 CALL EDIT(DMBUF,POS,BUF,1,3) 094101 09420 DO 1692 J=1,10 09430 CALL CCSCST(BUF,J,1,BLANK,1,1,ICOMP) 09440 IF(ICOMP.NE.0) GO TO 1694 09450 1692 CONTINUE 09460 1694 LB=LB+((10-(10-J))/2) 09470 CALL CCSMVA(DOL,2,1,LTRARR,LB,1) 09480 N1=10-J+1 09490 CALL CCSMVA(BUF,J,N1,LTRARR,LB+1,N1) 09500 GO TO 1710 095101 09520C TYPE WAS ALPHA MOVE IN STRING 09530 1700 CALL CCSMVA(DMBUF,POS,LENGTH,LTRARR,LB,LENGTH) 095401 09550C END OF PLUG LOOP 09560 1710 CONTINUE 09570C PRINT THE BODY OF THE LETTER 09580 1730 DO 1830 I=1,24 09590 LB=(I-1)*60+1 09600 LW=(I-1)*30+1 09610 1740 IF(LTRARR(LW).EQ.$2020) GO TO 2000 09620 CC=LTRARR(LW) 096301 09640C CC IS NUMBER OF BLANK LINES TO PRINT 09650 1750 CONTINUE 09660 CALL CCSBLK( OBUF,PLN ) 09670 IF ( CC.LE.1 ) GO TO 1810 096801 09690 OBUF = DBLSPC 09700 IF ( CC.EQ.2 ) GO TO 1810 097101 09720 ICC = CC/2 09730 CC = CC - ICC*2 09740 IF( CC.EQ.0 ) ICC = ICC-1 09750 IF( CC.EQ.0 ) CC = 2 097601 09770 CALL SYSPRT( OBUF,ICC,SYSPRM,0 ) 09780 GO TO 1750 097901 09800C MOVE IN A LINE OF TEXT AND PRINT 09810 1810 CONTINUE 09820 CALL CCSMVA( LTRARR,LB+2,58,OBUF,MARGIN,58 ) 098301 09840 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 098501 09860C END OF PRINT LOOP 09870 1830 CONTINUE 098802 09890C PRINT 2 LINES 09900 2000 CONTINUE 09910 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 09920 CALL CCSBLK( OBUF,PLN ) 099301 09940C GET COID SALUTATION 09950C************************************************************** ???*A041 09960 2010 TCIDSC = 0 09970 CALL CCSMVA(IOBUF,21,1,TCIDSC,2,1) 09980C************************************************************** ???*A041 09990 TCIDSC=TCIDSC-$30 10000 N=MARGIN+27 10010C************************************************************** ???*A042 10020 2020 IF(TCIDSC.LE.0) GO TO 2051 10030C************************************************************** ???*A042 10040 J=(TCIDSC-1)*8+1 10050 CALL CCSMVA(SALARA,J,8,OBUF,N,8) 100601 10070C FIND END OF SALUTATION 10080 2030 DO 2040 I=1,8 10090 J=N+I 10100 CALL CCSCST(OBUF,J,1,BLANK,1,1,ICOMP) 10110 IF(ICOMP.EQ.0) GO TO 2050 10120 2040 CONTINUE 101301 10140C MOVE IN FIRST INITIAL 10150 2050 N=N+I+1 10160C************************************************************** ???*A042 10170 2051 CALL CCSMVA(IOBUF,20,1,OBUF,N,1) 10180C************************************************************** ???*A042 101901 10200C MOVE IN LAST NAME 10210 2060 N=N+2 10220 CALL CCSMVA(IOBUF,5,15,OBUF,N,15) 102301 10240C PRINT COID 10250 2070 CONTINUE 10260 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 102701 10280C PRINT PHONE NUMBER 10290 2080 N=MARGIN+27 10300C IF THERE IS A PHONE NUMBER, PRINT IT 10310 CALL CCSCST (IOBUF, 22, 10, BLANK, 1, 10, ICOMP) 10320 IF (ICOMP .EQ. 0) GO TO 2090 10330 CALL CCSBLK(OBUF(2),130) 10340 CALL EDIT(IOBUF,22,OBUF,N,4) 103501 10360 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 103701 10380C IF THERE IS AN EXTENSION PRINT IT 10390 2090 CALL CCSCST(IOBUF,32,4,BLANK,1,4,ICOMP) 10400 IF(ICOMP.EQ.0) GO TO 2100 10410 CALL CCSBLK(OBUF(2),130) 10420 CALL CCSMVA(EXT,1,3,OBUF,N,3) 10430 CALL CCSMVA(IOBUF,32,4,OBUF,N+4,4) 104401 10450 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 104601 10470C PRINT LTRF STRING 10480 2100 CONTINUE 10490 CALL CCSBLK( OBUF,PLN ) 10500 CALL CCSMVA(LTRFBF,6,30,OBUF,N,30) 105101 10520 OBUF = DBLSPC 10530 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 105401 10550 2110 CONTINUE 105601 10570C GO GET NEXT TRANSACTION 10580 2120 GO TO 500 105902 10600C PRINT ERROR MESSAGE 10610 2200 CONTINUE 10620 PBUF = EJT 10630 CALL SYSPRT( PBUF,1,SYSPRM,0 ) 10640 PBUF = DBLSPC 10650 CALL SYSPRT( PBUF,2,SYSPRM,0 ) 10660 CALL SYSPRT( OBUF,1,SYSPRM,0 ) 106701 10680 GO TO 500 106901 10700C**** DONE PRINT TWO PAGE EJECTS...... 107101 10720 3000 CONTINUE 10730 PBUF = EJT 10740 CALL SYSPRT( PBUF,2,SYSPRM,0 ) 10750 GO TO 9900 10760. 107701 10780C**** ERROR SECTION FILE 1 10790 9800 CONTINUE 10800 IREQ = AND(REQ1(4),$FF) 10810 IF (IREQ.LT.11) IREQ = IREQ-1 10820 IF (IREQ.EQ.18) IREQ = 10 10830 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 10840 IERR = 1 10850 GO TO 9900 108601 10870C**** ERROR SECTION FILE 2 10880 9810 CONTINUE 10890 IREQ = AND(REQ2(4),$FF) 10900 IF (IREQ.LT.11) IREQ = IREQ-1 10910 IF (IREQ.EQ.18) IREQ = 10 10920 CALL FILERR( DAT2,IREQ,ISTAT,LU ) 10930 IERR = 1 10940 GO TO 9900 109501 10960C**** ERROR SECTION FILE 3 10970 9820 CONTINUE 10980 IREQ = AND(REQ3(4),$FF) 10990 IF (IREQ.LT.11) IREQ = IREQ-1 11000 IF (IREQ.EQ.18) IREQ = 10 11010 CALL FILERR( DAT3,IREQ,ISTAT,LU ) 11020 IERR = 1 11030 GO TO 9900 110401 11050C**** ERROR SECTION FILE 4 11060 9830 CONTINUE 11070 IREQ = AND(REQ4(4),$FF) 11080 IF (IREQ.LT.11) IREQ = IREQ-1 11090 IF (IREQ.EQ.18) IREQ = 10 11100 CALL FILERR( DAT4,IREQ,ISTAT,LU ) 11110 IERR = 1 11120 GO TO 9900 111301 11140C**** ERROR SECTION FILE 5 11150 9840 CONTINUE 11160 IERR = 1 11170 GO TO 9900 111801 11190C CLOSE FILES AND EXIT 11200 9900 CONTINUE 11210 CALL CLOSFL(REQ3,ISTAT) 11220 CALL CLOSFL(REQ4,ISTAT) 11230 CALL CLOSFL(REQ2,ISTAT) 11240 CALL CLOSFL(REQ1,ISTAT) 11250 CALL GETUTI( ISTAT,ISTAT,IFOUND,IFER,2 ) 11260 CALL SYSPRT( ISTAT,0,SYSPRM,1 ) 112701 11280C EXIT 11290 CALL PGMOUT 11300 END 11310 END/ 00040LTRSTA DCK/ I,H 00010 DEL/ 2 00020 1 /B78 F CCS 3.0 .LA/LETTER STATS 05/84 SL-149 00030 DEL/ 11,14 00040 INTEGER IDUSER(4),DT(3),TRNREC(0690),TRNREQ(24) 00050 INTEGER TDATA(15),TYPE,TLR(3),COIDCT,MAT(100,50 ),COID(100) 00060 INTEGER COIDWK(2),COIDPS,PRT(66,8),PAGE,IBUF(3),ZERO(3) 00070 INTEGER BLANK,PRTLIN(66),POS,PASS,LTR1(40) 00080 DEL/ 16,17 00090 INTEGER HDL6(66),HDL7(66),C,TC(51),TL(100),LTR(100) 00100 INS/ 18 00110 INTEGER HDLA(66),HDLB(66),TTC 00120 DEL/ 21,22 00130 DATA TDATA/'LATRNSFL',8*$2020,0,10,0/,TRNREQ/24*0/ 00140 DATA TYPE/'01'/,COIDCT/0/,COIDWK/2*$FFFF/,TTC/0/,L/0/ 00150 DEL/ 24,26 00160 DATA TC/51*0/,TL/100*0/,LTR/100*0/,IBUF/3*$3030/ 00170 DATA BLANK/$2020/,MAT/ 5000*0/,COID/100*$2020/ 00180 DATA PASS/0/,IEOF/0/,IREC/0/ 00190 DEL/ 27,28 00200 DATA AST/'**'/,TOTAL/'TOTALS'/ 00210 DEL/ 31,62 00220C POS. 01 +------------------ THRU ------------------+ 44 00230 DATA HDL1/'1---------- HDR1 GOES HERE -------------- ' 00240 +, ' COLLECTOR LETTER STATISTICS ' 00250 +, ' PAGE '/ 002601 00270C POS. 01 +------------------ THRU ------------------+ 44 00280 DATA HDL2/' ---------- HDR2 GOES HERE -------------- ' 00290 +, ' AS OF: ' 00300 +, ' '/ 003101 00320C POS. 01 +------------------ THRU ------------------+ 44 00330 DATA HDL3/' ---------- HDR3 GOES HERE -------------- ' 00340 +, ' ' 00350 +, ' '/ 003601 00370C POS. 01 +------------------ THRU ------------------+ 44 00380 DATA HDL4/' ' 00390 +, ' LETTERS REQUESTED ' 00400 +, ' '/ 004101 00420C POS. 01 +------------------ THRU ------------------+ 44 00430 DATA HDL5/' COLLECTOR ' 00440 +, ' ' 00450 +, ' '/ 004601 00470C POS. 01 +------------------ THRU ------------------+ 44 00480 DATA HDL6/' COLLECTOR ' 00490 +, ' ' 00500 +, ' '/ 005101 00520C POS. 01 +------------------ THRU ------------------+ 44 00530 DATA HDLA/' COLLECTOR ' 00540 +, ' ' 00550 +, ' '/ 005601 00570C POS. 01 +------------------ THRU ------------------+ 44 00580 DATA HDLB/' COLLECTOR ' 00590 +, ' ' 00600 +, ' '/ 006101 00620C POS. 01 +------------------ THRU ------------------+ 44 00630 DATA HDL7/' TOTALS ' 00640 +, ' ' 00650 +, ' '/ 006601 00670C POS. 01 +------------------ THRU ------------------+ 44 00680 DATA HDL8/' LTR1 RECORD NOT FOUND ' 00690 +, ' ' 00700 +, ' '/ 007101 00720 INS/ 69 00730 EQUIVALENCE (PRT(1,7),HDLA(1)) 00740 EQUIVALENCE (PRT(1,8),HDLB(1)) 007501 00760 INTEGER UTFILE(4),SYPFIL(4) 00770 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 007801 00790 EQUIVALENCE ( TRNREQ(15), NUMRD ) 00800 INTEGER HEAD(18) 008101 00820 DATA HEAD/$0D0A,$0A17,'EXECUTING LTRSTA ',$0F16/ 008301 00840 INTEGER U(8),GRPBUF(10),HDR(20,3) 00850 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 008601 00870 DATA PLU/12/,IFOUND/0/ 008801 00890 INTEGER L14(66) 009001 00910 DATA L14/' **LTRSTA** ERROR IN FILE : XXXXXXXX ' 00920 +, ' RUN ABORTED ********** ' 00930 +, ' '/ 009401 00950C**** SYSPRT PARAMETERS........ 009601 00970 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 009801 00990 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 01000 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 01010 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 010201 01030 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 01040 DEL/ 71,93 010501 01060C**** 01070C**** BEGIN PROGRAM ....... 010801 01090C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 011001 01110 CALL PGMIN ( IDUSER,LUNIT,MODE,NPORT ) 011201 01130C*** CCS/LA LOOK-ALIKE..... 011401 01150 CALL CCSCST( TDATA,1,2,USER,1,8,ICM ) 01160 IF ( ICM.EQ.0 ) GO TO 5 01170 CALL CCSMVA( TDATA,3,6,TDATA,1,16 ) 01180 5 CONTINUE 011901 01200 CALL CCSMVA( IDUSER,1,8,HEAD,23,8 ) 01210 CALL WTREAD( LUNIT,-1,HEAD,36,0,0,0,ITC ) 01220 CALL UTHEAD( HDR,DT ) 012301 01240 CALL GTSYSP( IWAY, 29 ) 01250 CALL GTSYSP( IMODE, 30 ) 01260 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01270 CALL GETGRP( GRPBUF,IALL,IMODE ) 012801 01290C**** OPEN FILES AND GET UTIFIL RECORDS 013001 01310 CALL SYSPRT( HDL1,0,SYSPRM,0 ) 01320 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01330 IF( ISERR.LT.0 ) GO TO 9820 013401 01350 CALL OPENFL( TRNREQ,TDATA,ISTAT ) 01360 IF ( ISTAT.LT.0 ) GO TO 9800 01370 TRNREQ(23) = 1 013801 01390 CALL EDIT( DT,1,HDL2,70,1 ) 01400C--- CALL CCSTIM( HDL2(40) ) 01410 CALL CCSMVA( HDR(01,01),1,40,HDL1,2,40 ) 01420 CALL CCSMVA( HDR(01,02),1,40,HDL2,2,40 ) 01430 CALL CCSMVA( HDR(01,03),1,40,HDL3,2,40 ) 01440 IF(NPORT.NE.0) CALL CCSPUT( $0C,1,HDL1 ) 014501 01460 DEL/ 95,137 01470C READ LTR1 THRU LTR4 01480 150 DO 170 I=1,4 01490 155 CONTINUE 01500 CALL GETUTI( UTKEY,LTR1,IFOUND,IFER,0 ) 01510 IF( IFER.LT.0 ) GO TO 9810 01520 IF( IFOUND.EQ.0 ) GO TO 160 015301 01540 157 IF ( I.EQ.1 ) GO TO 900 01550 GO TO 180 015601 01570 160 UTKEY(2)=UTKEY(2)+1 015801 01590 162 DO 164 J=1,25 01600 J1=I*25-25+J 01610 J2=(J-1)*2+5 01620 J3= I+4 01630 J4=(J-1)*4+16 01640 CALL CCSCST(LTR1,J2,2,AST,1,2,ICOMP) 01650 IF(ICOMP.EQ.0) GO TO 170 01660 CALL CCSCST(LTR1,J2,2,BLANK,1,2,ICOMP) 01670 IF(ICOMP.EQ.0) GO TO 170 01680 CALL CCSMVA(LTR1,J2,2,PRT(1,J3),J4,2) 01690 CALL CCSMVA(LTR1,J2,2,IBUF,5,2) 01700 L = L+1 01710 LTR(L) = IBUF(3) 01720 164 CONTINUE 017301 01740 170 CONTINUE 017501 01760 180 CONTINUE 01770 CALL CCSMVA( HDL8,1,0,HDL8,1,132 ) 01780 DEL/ 139 01790 200 CONTINUE 01800 DEL/ 141,146 01810 IF( AND(ISTAT,$8100).EQ.$8100 ) GO TO 282 01820 IF( ISTAT.LT.0 ) GO TO 9800 018301 01840 DEL/ 148,150 01850 IF ( NREC.LE.0 ) GO TO 282 01860 230 DO 280 N=1,NREC 01870 JW=(N-1)*69 01880 JB=(N-1)*138 01890 INS/ 154 019001 01910C***** CHECK IF OK TO USE THIS ACCOUNT GROUP. 01920 IF( ICKGRP( GRPBUF,IALL,TRNREC,JB+1 ).EQ.1 ) GO TO 280 01930 DEL/ 158,159 01940 LTRNO = TLR(3) 01950 INS/ 167 01960 IF ( COIDCT.LE.50 ) GO TO 265 01970 KFLG = 1 01980 COIDCT = COIDCT-1 01990 GO TO 282 02000 262 CONTINUE 02010 KFLG = 0 02020 COIDCT = 1 02030 CALL CCSBLK( COID,200 ) 02040 DO 264 I0=1,100 02050 TL(I0) = 0 02060 IF( I0.LE.50 ) TC(I0) = 0 02070 DO 264 I1=1,50 02080 264 MAT(I0,I1) = 0 02090 265 CONTINUE 02100 TTC = TTC+1 02110 INS/ 175 02120 GO TO 280 02130 DEL/ 200 02140 TC(51)= TC(51) + TC(I) 02150 DEL/ 202,214 02160 DEL/ 216,387 021701 02180 LT = L 02190 IF ( LT.GT.0 ) LT = LT-1 02200 LTC = LT/25+1 022101 02220 DO 450 LTP=1,LTC 022301 02240 LZ = (L-LTP*25)+25 02250C PRINT PASS 1 THRU 3 02260 360 PASS = 1 02270 N1=(PASS-1)*50+1 02280 N2=PASS*50 02290 IF(C.LT.N2)N2=C 023001 02310C PRINT 1-25 02320 370 DO 440 I=N1,N2 02330 COIDPS=(I-1)*4+1 02340 IF(I.NE.N1) GO TO 410 023501 02360C PRINT HEADINGS 02370 380 PAGE=PAGE+1 02380 CALL BHXDEC(PAGE,IBUF) 02390 390 CALL CCSMVA(IBUF,5,2,HDL1,126,2) 024001 02410C CHECK IF LESS THAN 26 LETTERS 02420 IF(LZ.GE.26) GO TO 398 02430 J=LZ*4+16 02440 JJ=LTP+4 02450 CALL CCSMVA(TOTAL,1,6,PRT(1,JJ),J,6) 02460 398 DO 400 J=1,5 02470 JJ = J 02480 IF(J.GE.5)JJ=LTP+4 024901 02500 CALL SYSPRT( PRT(1,JJ),1,SYSPRM,0 ) 02510 IF( J.EQ.3 .OR. J.EQ.5 ) CALL SYSPRT( HDL8,1,SYSPRM,0 ) 025201 02530 400 CONTINUE 025401 02550C BUILD PRINT LINE 02560 410 CALL CCSBLK(PRTLIN,132) 02570 CALL CCSMVA(COID,COIDPS,4,UTKEY,1,4) 02580 CALL GETUTI( UTKEY,LTR1,IFOUND,IFER,0 ) 02590 IF ( IFER.LT.0 ) GO TO 9800 02600 IF ( IFOUND.EQ.1 ) CALL CCSMVA( UTKEY,1,4,LTR1,5,74 ) 026101 02620 415 CALL CCSMVA (LTR1,5,12,PRTLIN,2,12) 02630 IF(LZ.LT.26) L1=LZ 02640 IF(LZ.GE.26) L1=25 02650 DO 420 II=1,L1 02660 J=(II-1)*4+15 02670 J2=LTP*25-25+II 02680 CALL BHXDEC(MAT(J2,I),IBUF) 02690 418 CALL CCSMVA(IBUF,4,3,PRTLIN, J ,3) 02700 420 CONTINUE 027101 02720C IF LESS THAN 26 LETTERS MOVE TOTALS 02730C INTO FIRST PAGE 02740 IF(LZ.GE.26) GO TO 430 02750 CALL BHXDEC(TC(I),IBUF2) 02760 424 J=LZ*4+16 02770 CALL CCSMVA(IBUF2,3,4,PRTLIN,J,4) 02780C PRINT DETAIL LINE 02790 430 CONTINUE 02800 CALL SYSPRT( PRTLIN,1,SYSPRM,0 ) 028101 02820 440 CONTINUE 028301 02840C IF END-PRINT TOTAL LINE 02850 441 IF((I-1).LT.C) GO TO 450 02860 IF(KFLG.EQ.1) GO TO 450 02870 CALL CCSBLK(HDL7(7),118) 02880 DO 444 K=1,L1 02890 J=(K-1)*4+14 02900 J2= LTP*25-25+K 02910 CALL BHXDEC(TL(J2),IBUF2) 02920 443 CALL CCSMVA(IBUF2,3,4,HDL7,J,4) 02930 444 CONTINUE 029401 02950C IF LESS THAN 26 LETTERS CALCULATE AND 02960C PRINT TOTAL OF TOTALS 02970 446 IF (LZ .GE. 26) GO TO 4491 02980 CALL BHXDEC(TC(51),IBUF2) 02990 449 J=LZ*4+16 03000 CALL CCSMVA(IBUF2,3,4,HDL7,J,4) 03010 4491 CONTINUE 03020 CALL SYSPRT( HDL8,1,SYSPRM,0 ) 03030 CALL SYSPRT( HDL7,1,SYSPRM,0 ) 030401 03050 450 CONTINUE 03060 IF ( KFLG.EQ.1 ) GO TO 262 03070 GO TO 9900 030802 03090 DEL/ 388,393 031001 031101 03120C**** ERROR SECTION FILE 1 03130 9800 CONTINUE 03140 IREQ = AND(TRNREQ(4),$FF) 03150 IF (IREQ.LT.11) IREQ = IREQ-1 03160 IF (IREQ.EQ.18) IREQ = 10 03170 CALL FILERR( TDATA,IREQ,ISTAT,LUNIT ) 03180 CALL CCSMVA( TDATA,1,8,L14,32,8 ) 03190 IERR = 1 03200 GO TO 9900 032101 03220C**** ERROR SECTION FILE 2 03230 9810 CONTINUE 03240 CALL SYSPRT( HDL8,1,SYSPRM,0 ) 032501 03260C**** ERROR SECTION FILE 3 03270 9820 CONTINUE 03280 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 03290 IERR = 1 03300 GO TO 9900 033101 03320C**** CLOSE THE FILES AND EXIT........ 03330 9900 CONTINUE 03340 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 033501 03360 CALL CLOSFL( TRNREQ,ISTAT ) 03370 CALL GETUTI( UTKEY,LTR1,IFOUND,IFER,2 ) 03380 CALL SYSPRT( HDL4,0,SYSPRM,1 ) 033901 03400 CALL PGMOUT 03410MHUPDT DCK/ I,H 00010 DEL/ 2 00020 1 /B79 F CCS CCS 3.0 .LA - PSRD 07-83 SL-149 00030 DEL/ 42,48 00040 INTEGER DATAD(4),DATAC(4),DATAS(4),DATAT(4) 00050 DATA DATAD,DATAC,DATAS,DATAT/'DELQMST COSIGNERSUMHIST TAPEARC '/ 00060 DATA IDATAI /'LAINACCT',8*$2020,0,1,0/ 00070 DATA IDATAD /'LADLQMST',8*$2020,1,1,1/ 00080 DATA IDATAC /'LACOSIGN',8*$2020,1,1,1/ 00090 DATA IDATAA /'LAACTFIL',8*$2020,1,1,1/ 00100 DATA IDATAS /'LASUMHST',8*$2020,1,1,1/ 00110 DATA IDATAT /'LATAPARC',8*$2020,1,1,1/ 00120 DATA IDATAU /'LAUTIFIL',8*$2020,1,1,1/ 00130 INS/ 72 00140 CALL CCSCST(IDATAU,1,2,ID,1,8,ICM) 00150 IF(ICM.EQ.0) GO TO 5 00160 CALL CCSMVA(IDATAI,3,6,IDATAI,1,8) 00170 CALL CCSMVA(DATAD ,1,8,IDATAD,1,8) 00180 CALL CCSMVA(DATAC ,1,8,IDATAC,1,8) 00190 CALL CCSMVA(IDATAA,3,6,IDATAA,1,8) 00200 CALL CCSMVA(DATAS ,1,8,IDATAS,1,8) 00210 CALL CCSMVA(DATAT ,1,8,IDATAT,1,8) 00220 CALL CCSMVA(IDATAU,3,6,IDATAU,1,8) 00230 5 CONTINUE 00240 DEL/ 239 00250 GO TO 160 00260 DEL/ 251 00270C***** PSR 07/83 00280 IF (ICOMP.EQ.0) GO TO 360 00290C***** 00300 DEL/ 253,261 00310 DEL/ 285 00320 . GO TO 360 00330 DEL/ 298,299 00340C ACCT NOT R,S,W; READ NEXT INACCT RECORD 00350 GO TO 360 00360 DEL/ 339 00370C REC NOT THERE OR EOF, READ NEXT INACCT 00380 DEL/ 341 00390 . GO TO 360 00400 DEL/ 347,348 00410 IF(AND(IDLREC(153),$FF).EQ.$20) GO TO 360 00420 INS/ 364 00430C**************************************************** PSR (05/83) 00440C*** CHECK IF NAME CHANGE NOT COMPLETE - IF SO MOVE 00450C*** OLD NAME KEY TO CURRENT NAME KEY ! THEN DELETE 004601 00470 CALL CCSCST(IDLREC,1047,6,0,0,0,ICOMP) 00480 IF(ICOMP.NE.0) CALL CCSMVA(IDLREC,1047,6,IDLREC,18,6) 00490 INS/ 368 00500C**************************************************** PSR (05/83) 00510C*** IF CANT FIND OLD KEY 2 - THEN DONT WORRY ABOUT IT ! 005201 00530 IF(ISTAT.EQ.$8800) GO TO 720 00540C**************************************************** *** (05/83) 00550 INS/ 417 00560C ****************************************************** ???*0016 00570 GO TO 870 005801 00590C BLANK COSIGNER PART OF RECORD, NO 00600C COSIGNER FOUND 00610 860 CALL CCSBLK ( IDLREC, 500 ) 00620C ****************************************************** ???*0016 00630 DEL/ 420 00640C ****************************************************** ???*0016 00650 870 CONTINUE 00660C ****************************************************** ???*0016 00670 DEL/ 429 00680C ****************************************************** ???*0016 00690 IF ( ISTAT .GE. 0 ) GO TO 900 00700 IF ( AND(ISTAT,$8100) .NE. 0 ) GO TO 960 00710C ****************************************************** ???*0016 00720 INS/ 449 007301 00740C ****************************************************** ???*0016 00750C IF ACTFIL RECORD ALREADY CAME FROM TAPE 00760C HISTORY (SUFFIX > 50), CONTINUE TO READ 00770C AND DELETE BLOCKS OVER 50 - DO NOT SAVE 00780C TO TAPE 00790 IF ( IDLREC(K+8) .GE. $3531 ) GO TO 880 00800C ****************************************************** ???*0016 00810 DEL/ 509 00820 GO TO 1140 00830 DEL/ 518 00840 IF(ISTAT.GE.0) GO TO 1140 00850 DEL/ 522,528 00860 DEL/ 560,589 00870MOVDAT DCK/ I,H NEWS DCK/ I,H NMCHNG DCK/ I,H 00010 DEL/ 2 00020 1 /B82 F CCS CCS 3.0 .LA PSR(05/83) SL-149 00030 DEL/ 19,20 00040 INTEGER DDAT(4) 00050 DATA DDAT /'DELQMST '/ 00060 DATA DDATA/'LADLQMST', 8*$2020, 1, 1, 1 / 00070 DATA ADATA/'LAADDACT', 8*$2020, 0, 1, 0 / 00080 INS/ 21 00090 INTEGER KYERR(29) 00100 DATA KYERR/$D0A,'NAME CHANGE KEY-INDEX ERROR *** ' 00110 1, 'PROGRAM CONTINUING..',$2E07/ 00120 INS/ 24 00130 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00140 IF(ICM.EQ.0) GO TO 5 00150 CALL CCSMVA(DDAT,1,8,DDATA,1,8) 00160 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00170 5 CONTINUE 00180 INS/ 52 00190C**************************************************** PSR(05/83) 00200C UPDATE ADDACT RECORD . SO WE DONT CHANGE NAME TWICE 002101 00220 CALL CCSPUT( $5A, 17, ADDREC ) 00230 CALL UPDREC( ADDREQ, ADDREC, ISTAT ) 00240 IF (ISTAT.GE.0) GO TO 215 00250 CALL FILERR(ADATA,15,ISTAT,LU) 00260 GOTO 300 002701 00280 215 CONTINUE 00290 INS/ 64 00300C**************************************************** PSR(05/83) 00310C CHECK IF OLD KEY AND NEW KEY ARE SAME IF SO THEN 00320C BLANK OUT OLD KEY AND UPDATE RECORD. 003301 00340 CALL CCSCST(DEQREC,18,6,DEQREC,1047,6,ICOMP) 00350 IF(ICOMP.NE.0) GO TO 225 003601 00370 222 CALL CCSBLK(DEQREC(524),6) 00380 CALL UPDREC( DEQREQ, DEQREC, ISTAT ) 00390 IF (ISTAT.GE.0) GO TO 200 00400 CALL FILERR(DDATA,15,ISTAT,LU) 00410 GO TO 200 004201 00430 225 CONTINUE 00440 INS/ 69 00450 IF(ISTAT.EQ.$8800) GO TO 228 00460 INS/ 73 00470C**************************************************** PSR(05/83) 00480C*** KEY INDEX ERROR - REPORT, THEN CONTINUE PROCESSING 004901 00500 228 CONTINUE 00510C** CALL WTREAD(LU,-1,KYERR,58,0,0,0,ITC) 00520 INS/ 77 00530 IF(ISTAT.EQ.$8010) GO TO 222 00540NUMDT1 DCK/ I,H PGCNT1 DCK/ I,H PGCNT2 DCK/ I,H PGGBLK DCK/ I,H PGGEN0 DCK/ I,H 00010 DEL/ 2 00020 1 /B90 F CCS CCS 3.0 POST 3.0 PSR 12/28/2 SL-149 00030 DEL/ 157 00040C***************************************************** ???*A??? 00050 IF(RADDR.EQ.$8010) GO TO 8010 00060C***************************************************** ???*A??? 00070PGGEN1 DCK/ I,H 00010 DEL/ 2 00020 1 /B91 F CCS CCS 3.0 PSR 03/23/81 SL-149 00030 DEL/ 36 00040CSPEC REVERSE DATES YYMMDD 00050 2 MSG5A(70),MSG5B(24),MSG5C(27),MSG5D(93),MSG6(83), 00060CSPEC END 00070 DEL/ 69 00080CPEC REVERSE DATES YYMMDD 00090 3NAME2 (CR) ',$D0A,' NOTE - DATE FIELDS MUST BE IN YEAR, MONTH, DA 00100 4Y ORDER, I.E. YYMMDD ',$D0A/ 00110CSPEC END 00120 DEL/ 116 00130CSPEC REVERSE DATES YYMMDD 00140 3 LNG5D/186/,LNG5A0/108/ 00150CSPEC END 00160 DEL/ 202 00170C***********************************************************A040*??? 00180 IF(AND(ISTAT,$300).NE.0) GO TO 1000 00190 IF(ISTAT.LT.0) GO TO 1010 00200C**********************************************************A040*??? 00210 DEL/ 210,212 00220C************** 3 LINES DELETED ***************************A040*??? 00230PGGEN3 DCK/ I,H 00010 DEL/ 2 00020 1 /B92 F CCS CCS 3.0 POST 3.0 PSR 12/28/2 SL-149 00030 DEL/ 33 00040C***************************************************** ???*A??? 00050 2 PRC060(3),PRC070(8),PRC080(8),PRC090(4),PRC100(37), 00060C***************************************************** ???*A??? 00070 DEL/ 51 00080C***************************************************** ???*A??? 00090 DATA PRC100 /'KF= ',35*$2020/ 00100C***************************************************** ???*A??? 00110 DEL/ 65 00120C***************************************************** ???A*??? 00130 2 LPC060/6/,LPC070/16/,LPC080/16/,LPC090/8/,LPC100/73/, 00140C***************************************************** ???A*??? 00150PGGN2E DCK/ I,H 00010 DEL/ 2 00020 1 /B93 F CCS CCS 3.0 SPECIAL 12/29/82 SL-149 00030 INS/ 34 00040 INTEGER IASLU(2) 00050C*********************************************************** ???*A079 00060 INTEGER RTTYPE 00070C*********************************************************** ???*A079 00080 INS/ 35 00090CSPEC REVERSE DATES YYMMDD 00100 INTEGER KSBIN,KSASC(2),F010(11),ICHGYR(19),ICHGMO(19) 00110 DATA F010/' INTEGER SAVE(3) '/ 00120 DATA ICHGYR/'CALL CCSMVA(WRKMST,K+XXXX,2,SAVE,1,2) '/ 00130 DATA ICHGMO/'CALL CCSMVA(WRKMST,K+XXXX,4,SAVE,3,4) '/ 00140 INTEGER USEDT(18),ISDATE 00150 DATA USEDT/'CALL CCSCST(SAVE,1,6,IVLXX,1,6,ICMP)'/ 001601 00170CSPEC END 00180 INS/ 37 00190C*********************************************************** ???*A079 00200 INTEGER F1047(10), F2047(19) 00210C*********************************************************** ???*A079 00220 DEL/ 57 00230 INTEGER J1000(3),J1100(3),J1200(2),J1300(2),J1400(4),J1500(5) 00240 DEL/ 69 00250 00260C*********************************************************** ???*A079 00270 DATA INCCS/'CALL QCST(A,WRKMST,K+XXXX,XXXX,WRKMST,K+XXXX,XXXX,ICMP 00280C*********************************************************** ???*A079 00290 DEL/ 73 00300C*********************************************************** ???*A079 00310 DATA IVCCS/'CALL QCST(A,WRKMST,K+XXXX,XXXX,IVLXX,1,XXXX,ICMP) '/ 00320C*********************************************************** ???*A079 00330 INS/ 82 00340C************************************************************** ???*A044 00350 INTEGER IRACMP(20) 00360 DATA IRACMP/'IF(ICMP.GE.0 .AND. JCMP.LE.0) GO TO 200 '/ 00370C************************************************************** ???*A044 00380 INS/ 85 00390C*********************************************************** ???*A079 00400 DATA F1047/' INTEGER A,N,T '/ 00410C*********************************************************** ???*A079 00420 DEL/ 101 00430C************************************************************** ???*AO45 00440 12720,',0, 9,0 ',$2F20/ 00450C************************************************************** ???*AO45 00460 INS/ 104 00470C*********************************************************** ???*A079 00480 DATA F2047/' DATA A,N,T',$2F20,'$41,$4E,$54',$2F20,' '/ 00490C*********************************************************** ???*A079 00500 DEL/ 128,129 00510C*********************************************************** ???*A079 00520 DATA F4000/' 115 DO 300 M = 1,9 '/ 00530 DATA F4100/' J = 1000*M-999'/ 00540C*********************************************************** ???*A079 00550 DEL/ 154 00560 DATA J1500/'*K,I08,P08'/ 00570 DEL/ 156 00580 DATA J1700/'*K,I08'/ 00590 INS/ 161 00600C GET SCRATCH LOGICAL UNIT FROM SYSDAT;LOCATION $B3 . 00610 ASSEM $C0B3,$6800,ISCRLU 00620C CONVERT TO ASCII & STORE IN THE TWO JCL ARRAYS. 00630 CALL BINASC (ISCRLU, IASLU) 00640 J1500(3) = IASLU(2) 00650 J1500(5) = IASLU(2) 00660 J1700(3) = IASLU(2) 00670 INS/ 180 00680CSPEC REVERSE DATE YYMMDD 00690 L = L + 80 00700 CALL CCSMVA(F010,1,22,WRPGWK,L,22) 00710CSPEC END 00720 INS/ 181 00730C*********************************************************** ???*A079 00740 CALL CCSMVA(F1047,1,20,WRPGWK,L,20) 00750 L = L + 80 00760C*********************************************************** ???*A079 00770 INS/ 221 00780C*********************************************************** ???*A079 00790 CALL CCSMVA(F2047,1,38,WRPGWK,L,38) 00800 L = L + 80 00810C*********************************************************** ???*A079 00820 INS/ 250 00830C ???*A085 00840 IF(J.LE.0) GO TO 3070 00850C ???*A085 00860 INS/ 318 00870C*********************************************************** ???*A079 00880C 00890C--- SET DATA TYPE INTO CALLS TO STRING-COMPARE SUBROUTINE. 00900 CALL CCSGET(TBLREC,15,RTTYPE) 00910 CALL CCSPUT(RTTYPE,11,INCCS) 00920 CALL CCSPUT(RTTYPE,11,IVCCS) 00930C***************************************************** ???*A079 009402 00950CSPEC REVERSE DATE YYMMDD 00960C CHECK IF A DATE FIELD BEING USED 00970 ISDATE = 0 00980 IF(AND(TBLREC(8),$00FF).EQ.$0059) ISDATE = 1 00990 IF(ISDATE.EQ.0) GO TO 3170 01000 CALL ASCBIN(TBLREC(4),K4LEN) 01010 CALL ASCBIN(TBLREC(5),K5LEN) 01020 KBIN = K4LEN * 100 + K5LEN - 1 01030 CALL BINASC(KBIN,KASC) 01040C NOW REVERSE THE DATE IN THE SAVE AREA FOR THE COMPARE 01050 3161 KSBIN = KBIN + 4 01060 CALL BINASC(KSBIN,KSASC) 01070 CALL CCSMVA(KSASC,1,4,ICHGYR,22,4) 01080 CALL CCSMVA(ICHGYR,1,38,WRPGWK,7,38) 01090 ASSIGN 3162 TO IRTN 01100 GO TO 3000 01110 3162 KSBIN = KBIN 01120 CALL BINASC(KSBIN,KSASC) 01130 CALL CCSMVA(KSASC,1,4,ICHGMO,22,4) 01140 CALL CCSMVA(ICHGMO,1,38,WRPGWK,7,38) 01150 ASSIGN 3170 TO IRTN 01160 GO TO 3000 01170 3170 CONTINUE 01180CSPEC END 01190 INS/ 324 01200CSPEC REVERSE DATES YYMMDD 01210C CHECK IF DATE FIELD 01220 IF(ISDATE.EQ.0) GO TO 3190 01230 CALL BINASC(K,KASC) 01240 CALL CCSMVA(KASC,3,2,USEDT,25,2) 01250 CALL CCSMVA(USEDT,1,36,WRPGWK,7,36) 01260 J = 1 01270 ASSIGN 3300 TO IRTN 01280 GO TO 3000 01290 3190 CONTINUE 01300CSPEC END 01310 DEL/ 368,378 01320C***************** 11 LINES DELETED HERE ************* ???*A044 01330 INS/ 380 01340CSPEC REVERSE DATES YYMMDD 01350C CHECK IF DATE FIELD 01360 IF(ISDATE.EQ.0) GO TO 3335 01370 CALL CCSMVA(KASC,3,2,USEDT,25,2) 01380C CHANGE THE RESULT FIELD TO A 'J'CMP FOR THIS COMPARE ONLY, IT IS 01390C CHANGED BACK RIGHT AFTER THE LINE IS WRITTEN 01400 CALL CCSPUT($4A,32,USEDT) 01410 CALL CCSMVA(USEDT,1,36,WRPGWK,7,36) 01420 ASSIGN 3332 TO IRTN 01430 GO TO 3000 01440C CHANGE IT BACK TO AN 'I'CMP 01450 3332 CALL CCSPUT($49,32,USEDT) 01460 CALL CCSMVA(IRACMP,1,40,WRPGWK,7,40) 01470 ASSIGN 3550 TO IRTN 01480 GO TO 3000 01490 3335 CONTINUE 01500CSPEC END 01510 INS/ 382 01520C************************************************************** ???*A044 01530C CHANGE THE RESULT FIELD TO A 'J'CMP FOR THIS COMPARE ONLY IT IS 01540C CHANGED BACK RIGHT AFTER THE LINE IS WRITTEN 01550 CALL CCSPUT($4A,45,IVCCS) 01560C************************************************************** ???*A044 01570 DEL/ 386,393 01580C************************************************************** ???*A044 01590C CHANGE IT BACK TO 'I'CMP 01600 3340 CALL CCSPUT($49,45,IVCCS) 01610 CALL CCSMVA(IRACMP,1,40,WRPGWK,7,40) 01620C************************************************************** ???*A044 01630 INS/ 405 01640CSPEC REVERSE DATES YYMMDD 01650C CHECK IF ITS A DATE FIELD 01660 IF(ISDATE.EQ.0) GO TO 3375 01670 CALL CCSMVA(KASC,3,2,USEDT,25,2) 01680 CALL CCSMVA(USEDT,1,36,WRPGWK,7,36) 01690 ASSIGN 3380 TO IRTN 01700 GO TO 3000 01710 3375 CONTINUE 01720CPEC END 01730 DEL/ 569,573 01740C POST 3.1 PSR 01750C ***** 5 COMMENT LINES DELETED HERE ***** 01760C END 01770 DEL/ 609 01780 CALL CCSMVA(J1500,1,10,WRPGWK,L,10) 01790PGGN2P DCK/ I,H PGLTTB DCK/ I,H PGPURG DCK/ I,H PGSEDT DCK/ I,H PGSJL DCK/ I,H PGSJR DCK/ I,H PGSLST DCK/ I,H PHDEL1 DCK/ I,H 00010 DEL/ 2 00020 1 /C02 F CCS CCS 3.0 &LA SL-149 00030 DEL/ 7,12 00040 DEL/ 23 00050 INTEGER IDAT(4) 00060 DEL/ 26 00070 DATA IDAT /'TAPEARC '/ 00080 DATA IDATA /'LATAPARC',8*$2020, 1, 1, -1 / 00090 DATA UDATA /'LAUTIFIL',8*$2020, 1, 1, 1 / 00100 INS/ 36 00110 CALL CCSCST(UDATA,1,2,USER,1,8,ICM) 00120 IF(ICM.EQ.0) GO TO 5 00130 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00140 CALL CCSMVA(IDAT ,1,8,IDATA,1,8) 00150 5 CONTINUE 00160PHDEL2 DCK/ I,H 00010 DEL/ 2 00020 1 /C03 F CCS CCS 3.0 &LA SL-149 00030 DEL/ 7,12 00040 DEL/ 25 00050 INTEGER IDAT(4) 00060 DEL/ 28 00070 DATA IDAT /'SUMHIST '/ 00080 DATA IDATA /'LASUMHST',8*$2020, 1, 1, -1 / 00090 DATA UDATA /'LAUTIFIL',8*$2020, 1, 1, 1 / 00100 INS/ 41 00110 CALL CCSCST(UDATA,1,2,USER,1,8,ICM) 00120 IF(ICM.EQ.0) GO TO 5 00130 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00140 CALL CCSMVA(IDAT ,1,8,IDATA,1,8) 00150 5 CONTINUE 00160PMEDT1 DCK/ I,H PRETSR DCK/ I,H 00010 DEL/ 2 00020 1 /C06 F CCS CCS 3.0 .LA SL-149 00030 DEL/ 22,23 00040 DATA IDATA / 'LATRNSFL',8*$2020,0,1,-1/ 000502 00060 DEL/ 26 00070 CALL CCSCST(IDATA,1,2,USER,1,8,ICM) 00080 IF(ICM.NE.0)CALL CCSMVA(IDATA,3,6,IDATA,1,8) 000901 00100PRNTIT DCK/ I,H PRTDT1 DCK/ I,H 00010 INS/ 21 00020 DATA I1PS / 0/ 00030 INS/ 23 00040 IF( I1PS.NE.0 ) GO TO 50 00050 I1PS = 1 00060PRTSCN DCK/ I,H 00010 DEL/ 2 00020 1 /C10 F CCS CCS 3.0 PSR'D SL-149 00030 DEL/ 112 00040C ****************************************************** ???*A021 00050 105 ILN = IOBUF(41) 00060 CALL CCSBLK (ACCTNO, 16) 00070 CALL CCSMVA (IOBUF, 1, ILN, ACCTNO, 1, 16) 00080C ****************************************************** ???*A021 00090QLOAD DCK/ I,H 00010 DEL/ 2 00020 1 /C11 F CCS CCS 3.0 .LA - PSRD SL-149 00030 DEL/ 32 00040 INTEGER DDAT(4) 00050 DATA DDAT/'DLYASSN '/ 00060 DATA DDATA/'LADLYASN',8*$2020,0,20,0/, ITC/0/ 00070 INS/ 37 00080C********************************************************** ???*A001 00090 INTEGER QTMSB(7) 00100 DATA QTMSB/7*0/ 00110C********************************************************** ???*A001 00120 INS/ 39 00130 CALL CCSCST(DDATA,1,2,IDUSER,1,8,ICM) 00140 IF(ICM.NE.0) CALL CCSMVA(DDAT,1,8,DDATA,1,8) 00150 DEL/ 211 00160C********************************************************** ???*A001 00170C........USE MSB MODULO 30000 TO IMPLEMENT DOUBLE PRCISION ARITHMETIC 00180 IF (QT(AGE1) .LT. 30000) GO TO 470 00190 QT(AGE1) = 0 00200 QTMSB(AGE1) = QTMSB(AGE1) + 1 00210 470 QT(7) = QT(7) + 1 00220 IF (QT(7) .LT. 30000) GO TO 474 00230 QT(7) = 0 00240 QTMSB(7) = QTMSB(7) + 1 00250 474 CONTINUE 00260C********************************************************** ???*A001 00270 INS/ 226 00280C********************************************************** ???*A001 00290 IF (QTMSB(II) .EQ. 0) GO TO 515 00300C.........'QTMSB' = NO. OF MULTIPLES OF 30000. 00310C......... (ADJUST 10**4 DIGIT ONLY) 00320 QPRT(IJ) = $2030 + QTMSB(II)*3 + AND(QPRT(IJ),$F) 00330 515 CONTINUE 00340C********************************************************** ???*A001 00350R9BASE DCK/ I,H R9FLDL DCK/ I,H RESDT1 DCK/ I,H RTVDT1 DCK/ I,H SEEIT DCK/ I,H SUMACL DCK/ I,H 00010 DEL/ 2 00020 1 /C20 F CCS CCS 3.0 .LA - PSRD SL-149 00030 INS/ 28 00040C ****************************************************** ???*A011 00050C 00060C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00070 INTEGER FDEL 00080 EXTERNAL FMRDEL 00090C ******************************************************* ???*A011 00100 DEL/ 34 00110 INTEGER IDAT(4) 00120 DATA IDAT /'DELQMST '/ 00130 DATA IDATA/'LADLQMST',8*$2020,1,7,0/ 00140 INS/ 43 00150 CALL CCSCST(IDATA,1,2,ID,1,8,ICM) 00160 IF(ICM.NE.0) CALL CCSMVA(IDAT,1,8,IDATA,1,8) 00170 INS/ 44 00180C ****************************************************** ???*A011 00190C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00200 ASSEM $C000,FMRDEL,$6800,FDEL 00210C ****************************************************** ???*A011 00220C 00230 INS/ 80 00240C ****************************************************** ???*A011 00250C FIX FOR PSR GENERATED 7-10-80 DO NOT PRINT DELETED RECORDS 00260 CALL CCSCST(RECBUF,IW,2,FDEL,1,2,ICOMP) 00270 IF(ICOMP.EQ.0) GO TO 250 00280C ****************************************************** ???*A011 00290SUMHD DCK/ I,H TAPE DCK/ I,H TOTEDT DCK/ I,H TRENDF DCK/ I,H 00010 DEL/ 2 00020 1 /C25 F CCS CCS 3.0 .LA - PSRD RWE 10/82 SL-XXX 00030 INS/ 33 000401 00050C**** TRENDF - MODIFIED TO USE RECORD BLOCKING. 00060C DON'T DO DELETE FROM ACCAGE. JUST FLAG RECORD SO IT 00070C CAN BE REMOVED BY DSORT. 00080C FIXED TO CLEAR AND CREATE RSWFIL IF BUILDING ACCAGE. 00090C AND ALSO WHEN OUTPUTTING TO RSWFIL DURING UPDATE OF 00100C ACCAGE TO MOVE CURRENT TO PREVIOUS ON RSWFIL RECORD. 00110 DEL/ 39,40 00120 INTEGER DELREQ(24),DELQRC(15004),DDATA(15),DELKEY(8) 00130 INTEGER DT(3),RDT(7),LRDT(4),READA,READD,EOFA,EOFD 00140 DEL/ 44 00150 INTEGER RSWB(2),RSW9(2,3),ACCRC1(1),RSWREC(620),RSWF 00160 EQUIVALENCE (DELQRC(1005),ACCRC1(1)) 00170 DEL/ 48 00180 DATA DELREQ/24*0/,DELQRC/15004*$2020/,DELKEY/8*$2020/ 00190 DATA RSWB/'RSW '/,RSW9/'998 999 997 '/,IFIRST/0/,RSWF/0/ 00200 DATA IOF/0/,IEND/0/,NUMPUT/0/,NUMHI/15/,LNDLQB/15000/ 00210 DEL/ 51,52 00220 DATA DT/3*$2020/,RDT/7*$2020/,LRDT/4*$2020/ 00230 DEL/ 83,85 00240C************************************************************** ???*A046 00250 DATA ACDATA/'LAACCAGE',8*$2020,1,1,-1/ 00260 DATA DDATA /'LADLQMST',8*$2020,1,1,0/ 00270 DATA RDATA /'LARSWFIL',8*$2020,0,1,0/ 00280 INTEGER DDAT(4) 00290 DATA DDAT/'DELQMST '/ 00300 INS/ 86 00310C************************************************************** ???*A043 00320 INTEGER DTMSG(32),DTINP(2) 00330 DATA DTMSG/$0A0D,'THE DATE ENTERED IS . IS THIS THE CORRECT 00340 1DATE? Y OR N',$0A0D/ 00350C************************************************************** ???*A043 00360 DEL/ 93,95 00370 CALL CCSCST(RDATA,1,2,IDUSER,1,8,ICM) 00380 IF(ICM.EQ.0) GO TO 5 00390 CALL CCSMVA(RDATA,3,6,RDATA,1,8) 00400 CALL CCSMVA(ACDATA,3,6,ACDATA,1,8) 00410 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00420 5 CONTINUE 00430 DEL/ 99 00440 INS/ 131 004501 00460C*** BLANK OUT RSW FLAG ON HEADER IN CASE NO INACTIVE RECORDS FOUND ! 00470 CALL CCSMVA(ACCREC,1,0,ACCREC,50,3) 00480 DEL/ 147,148 00490 160 CALL CCSMVA(RDT,1,0,RDT,1,14) 00500 CALL WTREAD(LUNIT,-1,MSG2,122,-1,RDT,12,ITC) 00510 INS/ 150 00520C************************************************************** ???*A043 00530C DATE CHECKING 00540 IF(RDT(1).EQ.$2020) CALL CCSMVA(DT,1,6,DTMSG,23,6) 00550 IF(RDT(1).NE.$2020) CALL CCSMVA(RDT,1,6,DTMSG,23,6) 00560C ASK IF IT IS THE CORRECT DATE 00570 165 DTINP(1) = $2020 00580 CALL WTREAD(LUNIT,-1,DTMSG,64,-1,DTINP,2,ITC) 00590C CHECK FOR AN 'N' AND IF SO GO REDO PROMPT FOR DATE 00600 IF(DTINP(1).EQ.$4E4F.OR.DTINP(1).EQ.$4E20) GO TO 160 00610C CHECK FOR 'Y' AND IF NOT GO REDO PROMPT FOR Y OR N 00620 IF(DTINP(1).EQ.YES(1).OR.DTINP(1).EQ.$5920) GO TO 167 00630C DATE WAS VERIFIED-CONTINUE 00640C************************************************************** ???*A043 00650 167 CONTINUE 00660 DEL/ 154 00670 IF(RDT(7).NE.6) GO TO 160 00680 DEL/ 189,190 00690 220 CONTINUE 00700 CALL CLOSFL(ACCREQ,ISTAT) 00710 NUMACC = (LNDLQB-1005)/42 00720 NUMDLQ = LNDLQB/1000 00730 ACDATA(13) = 0 00740 ACDATA(14) = NUMACC 00750 IF (INIT.NE.0) GO TO 225 00760 DDATA(13) = 0 00770 DDATA(14) = NUMDLQ 00780 ACDATA(13) = 1 00790 ACDATA(14) = 1 00800 CALL CLEAR(RSWREQ,RDATA,ISTAT) 00810 IF(ISTAT.GE.0) GO TO 225 00820 CALL FILERR(RDATA,01,ISTAT,LUNIT) 00830 GO TO 950 00840 225 CONTINUE 00850 DO 226 I = 1,24 00860 ACCREQ(I) = 0 00870 226 RSWREQ(I) = 0 00880 CALL OPENFL(ACCREQ,ACDATA,ISTAT) 00890 IF (ISTAT.GE.0) GO TO 228 00900 CALL FILERR(ACDATA,3,ISTAT,LUNIT) 00910 GO TO 950 00920 228 CONTINUE 00930 DEL/ 206,223 00940 240 CONTINUE 00950 CALL GETS(ACCREQ,ACCRC1,ACCKEY,ISTAT) 00960 IF(AND(ISTAT,$100).EQ.$100) IOF = 1 00970 IF(IOF.EQ.1) GO TO 250 00980 IF(ISTAT.GE.0) GO TO 250 00990 CALL FILERR(ACDATA,14,ISTAT,LUNIT) 01000 GO TO 950 01010 250 CONTINUE 01020 NUMRED = ACCREQ(15) 01030 IF (NUMRED.LE.0) GO TO 400 01040 DO 400 IL = 1,NUMRED 01050 IPT = IL*41-40 01060 IF (IFIRST.EQ.0) GO TO 395 01070 IF (ACCRC1(IPT).EQ.FDEL) GO TO 400 01080 CALL CCSMVA(ACCRC1(IPT),1,16,DELKEY,1,16) 01090 CALL READR(DELREQ,DELQRC,DELKEY,ISTAT) 01100 IF(AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 390 01110 DEL/ 228,229 01120 300 CONTINUE 01130 CALL CCSGET(DELQRC,306,MSTC) 01140 DO 305 I1 = 1,4 01150 CALL CCSGET(RSWB,I1,ICH) 01160 IF (ICH.NE.MSTC) GO TO 305 01170 GO TO 310 01180 305 CONTINUE 01190 310 IF (I1.LT.4) GO TO 315 01200 IF (UPDAT1.EQ.0.AND.UPDAT2.EQ.0) GO TO 340 01210 315 CONTINUE 01220 DEL/ 233 01230 CALL CCSMVA(ACCRC1(IPT),APOS(I),ALEN(I), 01240 + ACCRC1(IPT),APOS(I+4),ALEN(I)) 01250 DEL/ 238 01260 CALL CCSMVA(DELQRC,DPOS(I),DLEN(I), 01270 + ACCRC1(IPT),DPOS(I+6),DLEN(I)) 01280 DEL/ 242,281 01290 IF (I1.GE.4) GO TO 380 01300 CALL CCSCST(ACCRC1(IPT),35,3,RSWB,1,3,ICM) 01310 IF (ICM.EQ.0) GO TO 390 01320 NUMPUT = NUMPUT+1 01330 RSWF = 1 01340 IP1 = NUMPUT*41-40 01350 CALL CCSMVA(ACCRC1(IPT),1,82,RSWREC(IP1),1,82) 01360 CALL CCSMVA(RSW9(1,I1),1,3,RSWREC(IP1),35,3) 01370 CALL CCSMVA(RSWB,1,3,ACCRC1(IPT),35,3) 01380 IF (NUMPUT.LT.NUMHI) GO TO 375 01390 370 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 01400 IF(ISTAT.GE.0) GO TO 375 01410 CALL FILERR(RDATA,11,ISTAT,LUNIT) 01420 GO TO 950 01430 375 CONTINUE 01440 NUMPUT = 0 01450 IF (IEND.EQ.1) GO TO 420 01460 GO TO 400 01470 380 CONTINUE 01480 ASSIGN 385 TO IRTN 01490 GO TO 700 01500 385 CALL CCSMVA(DAYS,1,3,ACCRC1(IPT),35,3) 01510 GO TO 400 01520 390 CONTINUE 01530 CALL CCSMVA(RSWB,1,3,ACCRC1(IPT),35,3) 01540 RSWF = 1 01550 395 IFIRST = 1 01560 400 CONTINUE 01570 CALL UPDREC(ACCREQ,ACCRC1,ISTAT) 01580 IF (ISTAT.GE.0) GO TO 410 01590 CALL FILERR(ACDATA,15,ISTAT,LUNIT) 01600 GO TO 950 01610 410 CONTINUE 01620 IF (IOF.NE.1) GO TO 240 01630 IEND = 1 01640 IF (NUMPUT.GT.0) GO TO 370 01650 420 CONTINUE 01660 IF (RSWF.NE.1) GO TO 950 016701 01680C*** UPDATE HEADER RECORD TO REFLECT INACTIVE RECORDS ENCOUNTERED. 016901 01700 ACCKEY(1) = 0 01710 ACCKEY(2) = 1 017201 01730 CALL READR(ACCREQ,ACCRC1,ACCKEY,ISTAT) 01740 IF (ISTAT.GE.0) GO TO 430 01750 CALL FILERR(ACDATA,13,ISTAT,LUNIT) 01760 GO TO 950 01770 430 CONTINUE 01780 CALL CCSMVA(RSWB,1,3,ACCRC1,50,3) 01790 CALL UPDREC(ACCREQ,ACCRC1,ISTAT) 01800 IF (ISTAT.GE.0) GO TO 950 01810 CALL FILERR(ACDATA,15,ISTAT,LUNIT) 01820 GO TO 950 01830 DEL/ 287,310 01840 500 CONTINUE 01850 CALL GETS(DELREQ,DELQRC,DELKEY,ISTAT) 01860 IF(AND(ISTAT,$100).EQ.$100) IOF = 1 01870 IF (IOF.EQ.1) GO TO 530 01880 IF (ISTAT.GE.0) GO TO 530 01890 CALL FILERR(DDATA,14,ISTAT,LUNIT) 01900 GO TO 950 01910 530 CONTINUE 01920 NUMRED = DELREQ(15) 01930 IF (NUMRED.EQ.0) GO TO 590 01940 DO 590 IL = 1,NUMRED 01950 IPT = IL*1000-999 01960 IF(DELQRC(IPT).EQ.FDEL) GO TO 590 01970 CALL CCSBLK(ACCREC,82) 01980 DEL/ 315,319 01990 CALL CCSMVA(DELQRC(IPT),DPOS(K),DLEN(K), 02000 + ACCREC,DPOS(K+6),DLEN(K)) 02010 540 CONTINUE 02020 CALL CCSMVA(DELQRC(IPT),875,6,DELQDT,1,6) 02030 CALL CCSMVA(DELQRC(IPT),1,16,ACCREC,1,16) 020401 02050 CALL CCSGET(DELQRC(IPT),306,MSTC) 02060 DO 545 I1 = 1,4 02070 CALL CCSGET(RSWB,I1,ICH) 02080 IF (ICH.NE.MSTC) GO TO 545 02090 GO TO 547 02100 545 CONTINUE 02110 547 IF (I1.LT.4) GO TO 570 02120 DEL/ 334,356 02130 570 CONTINUE 02140 NUMPUT = NUMPUT+1 02150 IP1 = NUMPUT*41-40 02160 CALL CCSMVA(RSW9(1,I1),1,3,ACCREC,35,3) 02170 CALL CCSMVA(ACCREC,1,82,RSWREC(IP1),1,82) 02180 IF (NUMPUT.LT.NUMHI) GO TO 590 02190 575 CALL PUTS(RSWREQ,RSWREC,NUMPUT,ISTAT) 02200 IF (ISTAT.GE.0) GO TO 580 02210 CALL FILERR(RDATA,11,ISTAT,LUNIT) 02220 GO TO 950 02230 580 CONTINUE 02240 NUMPUT = 0 02250 IF (IEND.EQ.1) GO TO 600 02260 590 CONTINUE 02270 IF (IOF.NE.1) GO TO 500 02280 IEND = 1 02290 IF (NUMPUT.GT.0) GO TO 575 02300 600 CONTINUE 02310 GO TO 950 02320TRENDU DCK/ I,H TRHDT1 DCK/ I,H TRNPLY DCK/ I,H 00010 DEL/ 2 00020 1 /C28 F CCS CCS 3.0 .LA - LKL07 SL-149 00030 DEL/ 7,12 00040 INS/ 103 00050C***************************************************************???*0022 00060C 00070C SET UP UTILITY FILE DATA TO BE USED FOR RETRIEVING COLLECTORS 00080C LAST NAME AND PUTTING IT IN ACTIVITY STRING INSTEAD OF COLLECTOR 00090C LOG ON ID 001001 00110 INTEGER UDATA(15),UTIREQ(24),UTIREC(40),HST(2),ID(4) 00120 DATA UDATA/'LAUTIFIL',8*$2020,1,1,0/ 00130 DATA UTIREQ/24*0/, HST/'HOST'/,IFG/0/ 00140C***************************************************************???*0022 00150 DEL/ 107,109 00160 INTEGER DDAT(4),CDAT(4),SDAT(4),IN1(4) 00170 DATA DDAT/'DELQMST '/,CDAT/'COSIGNER'/,SDAT/'SCRNFILE'/ 00180 DATA DDATA/'LADLQMST',8*$2020,1,1,1/ 00190 DATA CDATA/'LACOSIGN',8*$2020,1,1,1/ 00200 DATA TDATA/'LATRANFL',8*$2020,0,1,0/ 00210 DEL/ 113,114 00220 DATA SDATA/'LASCNFIL',8*$2020,1,1,0/ 00230 DATA ADATA/'LAADDACT',8*$2020,0,1,0/ 00240 DEL/ 161 00250 1 (TRNBUF(20),RESULT), 00260 INS/ 164 002701 00280 CALL PGMIN(ID,ISTAT,ISTAT,ISTAT) 00290 CALL CCSCST(UDATA,1,2,ID,1,8,ISTAT) 00300 IF(ISTAT.EQ.0) GO TO 5 00310 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00320 CALL CCSMVA(TDATA,3,6,TDATA,1,8) 00330 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00340 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00350 CALL CCSMVA(CDAT ,1,8,CDATA,1,8) 00360 CALL CCSMVA(SDAT ,1,8,SDATA,1,8) 00370 5 CONTINUE 00380 WRITE(5,6)ID 00390 6 FORMAT(/,'USERID =',4A2,' TYPE OK TO CONTINUE, OR EX TO EXIT',/) 00400 CALL WTREAD(5,-1,0,0,-1,IN1,6,ITC) 00410 IF(ITC.NE.2) GO TO 5 00420 IF(IN1.EQ.2HEX) GO TO 991 00430 IF(IN1.NE.2HOK) GO TO 5 00440 DEL/ 187 00450C***************************************************************???*0022 00460 IF(ISTAT.GE.0) GO TO 45 00470C***************************************************************???*0022 00480 INS/ 189 00490C***************************************************************???*0022 005001 00510 45 CALL OPENFL(UTIREQ,UDATA,ISTAT) 00520 IF(ISTAT.GE.0) GO TO 50 00530 CALL FILERR(UDATA,3,ISTAT,LU) 00540 GO TO 991 00550C***************************************************************???*0022 00560 DEL/ 224 00570 IF(AND(ISTAT,$100).EQ.$100) GO TO 99 00580 INS/ 226 00590 CALL CCSMVA(TRNBUF,1,16,ACCT,1,16) 00600 DEL/ 235 00610 DEL/ 240,242 00620C ****************************************************** ???*A020 00630 105 COUNT1 = COUNT1 + 1 00640 CALL READR (DEQREQ, SDEF, ACCT, ISTAT) 00650 IF(AND(ISTAT,$100).EQ.$100.OR.AND(ISTAT,WRONKY).EQ.WRONKY)GOTO 996 00660 IF(ISTAT.LT.0) GOTO 990 00670C INCREMENT COUNT OF ACTIVITIES PROCESSED 00680C ****************************************************** ???*A020 00690 DEL/ 247 00700C***************************************************************???*0022 00710C READ UTIFIL AND MOVE IN FIRST 4 CHARACTERS OF LAST NAME 00720C INSTEAD OF COLLECTOR ID 007301 00740 CALL CCSMVA(TRNBUF,17,4,UTIREC,1,4) 00750 CALL READR(UTIREQ,UTIREC,UTIREC,ISTAT) 00760 IF(ISTAT.LT.0.OR.AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 993 00770C RECORD RETRIEVED-MOVE IN THE NAME 00780 107 CALL CCSMVA(UTIREC,5,4,STRING,13,4) 00790C***************************************************************???*0022 00800 DEL/ 278 00810 205 CONTINUE 00820 INS/ 316 00830 COUNT2 = COUNT2 + 1 00840 INS/ 322 00850 COUNT2 = COUNT2 + 1 00860 DEL/ 339,340 00870 450 COUNT2 = COUNT2 + 1 00880 CALL READR(DEQREQ,SDEF,ACCT,ISTAT) 00890 IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,$100).EQ.$100)GOTO 996 00900 IF(ISTAT.LT.0) GO TO 990 00910 DEL/ 390,394 00920 GO TO 991 00930C ****************************************************** ???*0022 00940 996 COUNTB = COUNTB+1 00950 IF(IFG.EQ.0)WRITE(12,551) 00960 551 FORMAT( 1H1,/,20X,'TRANSACTION REPLAY -- REPORT',/, 00970 + 39X,'NEW DATA OR',/,5X,'ACCOUNT #',7X, 00980 + 'TYPE UPCD AC RC LT COMMENT') 00990 IFG = 1 01000 IF(KEY.EQ.2H01) GO TO 997 01010 WRITE(12,555)(TRNBUF(L),L=1,8),KEY,UPDCOD,(TRNBUF(M),M=17,31) 01020 555 FORMAT(2X,8A2,4X,A2,6X,A2,5X,15A2,4X,' NOT UPDATED***') 01030 COUNT2 = COUNT2 - 1 01040 GO TO 100 01050 997 WRITE(12,552)(TRNBUF(L),L=1,8),KEY,(TRNBUF(M),M=19,21), 01060 + (TRNBUF(N),N=22,50) 01070 552 FORMAT(2X,8A2,4X,A2,11X,3(2X,A2),3X,28A2,4X,' NOT UPDATED***') 01080 COUNT1 = COUNT1 - 1 01090 GO TO 100 01100C ****************************************************** ???*0022 01110 DEL/ 402 01120 557 FORMAT(' ...PROGRAM ABORTED. - RUN NOT COMPLETE') 01130 DEL/ 406 01140 GOTO 991 01150 DEL/ 409 01160 GOTO 991 01170C***************************************************************???*0022 01180C FILE ERROR ON READ OF UTIFIL 01190 993 WRITE(5,559) TRNBUF(9),TRNBUF(10) 01200 559 FORMAT(' COID : ',2A2,' NOT IN UTIFIL - USING HOST ID ') 01210 CALL CCSMVA(HST,1,4,UTIREC,5,4) 01220 GO TO 107 01230C***************************************************************???*0022 01240 INS/ 414 01250C***************************************************************???*0022 01260 CALL CLOSFL(UTIREQ,ISTAT) 01270C***************************************************************???*0022 01280 DEL/ 417 01290 1 ',I4,/,'TOTAL OTHER RECORDS ',I4,/, 01300TVPDT1 DCK/ I,H UIDMTN DCK/ I,H USEMTN DCK/ I,H 00010 DEL/ 2 00020 1 /C50 F CCS CCS 3.0 PSR CCS/LA 02/83 SL-149 00030 DEL/ 18 00040 DATA ADATA /'LAACTIVE',8*$2020,1,1,1/ 00050 INS/ 21 00060C**** SET FILENAME ACCORDING TO OWNER ID. 00070 CALL CCSCST(ADATA,1,2,USER,1,8,ICM) 00080 IF ( ICM.NE.0 )CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00090 DEL/ 30 00100 100 ICLR=$1820 00110 WRITE(LU,4000)ICLR 00120 4000 FORMAT(A2) 00130 DEL/ 41 00140 250 CONTINUE 00150UTFMTN DCK/ I,H 00010 DEL/ 2 00020 1 /F51 F CCS CCS 3.1 LKL07 02-84 SL-149 00030 DEL/ 70 00040 DATA CS / $1820 / 00050 INS/ 158 00060C ADD 'HOST,TRND,LTR3&4 RECORDS TO UTIFIL AND MAKE THEM PROTECTED... 00070 DATA KEY18 / 'LTR3' , -1, 0 / 00080 DATA KEY19 / 'LTR4' , -1, 0 / 00090 DATA KEY20 / 'HOST' , 0, 2 / 00100 DATA KEY21 / 'TRND' , 0, 2 / 00110 DATA KEY22 / '** ' , 0, 0 / 00120 DEL/ 162,166 00130C **** 00140 DEL/ 236,243 00150 100 CALL CCSBLK( INBUF, 76 ) 00160 CALL WTREAD( LU, -1, INOPER, 74, -1, INBUF, 76, TC ) 00170C ** CHECK FOR RUBOUT IF IT IS REPEAT REQUEST. 00180 IF ( TC.EQ.04 ) GO TO 100 00190C ** CHECK IF NO CHARS ENTERED 00200 IF ( INCHAR.EQ.0 ) GO TO 900 00210 DEL/ 258,262 00220 125 CALL CCSBLK( INBUF, 76 ) 00230 CALL WTREAD( LU, -1, INKEY, 38, -1, INBUF,76, TC ) 00240 IF ( TC.EQ.04 ) GO TO 125 00250 CALL CCSMVA( INBUF,1,4,KEY,1,4 ) 00260 DEL/ 424,425 00270 900 PGINOU(19) = $4F55 00280 PGINOU(20) = $5420 00290UTHEAD DCK/ I,H 00010 DEL/ 2 00020 1 /C52 F CCS CCS 3.0 .LA SL-149 00030 DEL/ 22,23 00040 DATA UDATA / 'LAUTIFIL', 8*$2020, 1, 1, 0 / 00050 DATA I1PS /0/ 000601 00070 IF( I1PS.NE.0 ) RETURN 00080 I1PS = 1 00090 CALL PGMIN(UREC,ISTAT,ISTAT,ISTAT) 00100 CALL CCSCST(UDATA,1,2,UREC,1,8,ISTAT) 00110 IF(ISTAT.NE.0) CALL CCSMVA(UDATA,3,6,UDATA,1,8) 001201 00130VALDT1 DCK/ I,H WRTOFE DCK/ I,H 00010 DEL/ 2 00020 1 /C54 F CCS CCS 3.0 PSR(08-22-84) SL-149 00030 DEL/ 18,19 00040 INTEGER DATE(3),NDAYS,DDAYS,EOF,FDEL,FMRDEL 00050 INTEGER IBUF(6),IDUSER(4),MDLDT(3),MSTDT(3),MLEN(11) 00060 DEL/ 24,25 00070 INTEGER DELQBF(24),DELQRC(10000),DDATA(15) 00080 INTEGER WOEFBF(24),WOEFRC(60),WDATA(15),WEFREC(874) 00090 DEL/ 37,38 00100 INTEGER DDAT(4) 00110 DATA DDATA/'LADLQMST',8*$2020,0,10,0/,SUB/0/,IFG/0/,NUMPUT/0/ 00120 DATA WDATA/'LAWOEF ',8*$2020,0,1,0/,DDAT/'DELQMST '/ 00130 DEL/ 83 00140 CALL CCSCST(WDATA,1,2,IDUSER,1,8,ICM) 00150 IF(ICM.EQ.0) GO TO 5 00160 CALL CCSMVA(WDATA,3,6,WDATA,1,8) 00170 CALL CCSMVA(DDAT ,1,8,DDATA,1,8) 00180 5 CONTINUE 00190 ASSIGN 1000 TO CREATE 00200 ASSIGN 1500 TO COUNT 00210 DEL/ 99,100 00220 CALL WTREAD(LUNIT,-1,DSP1,18,-1,IBUF,10,ITC) 00230 IF(IBUF(6).NE.1) GO TO 120 00240 DEL/ 107,129 00250 220 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00260 IF(WFG1.NE.$32)CALL WTREAD(LUNIT,-1,DSP2,30,-1,IBUF,10,ITC) 00270 IF(WFG1.EQ.$32)CALL WTREAD(LUNIT,-1,DSP4,40,-1,IBUF,10,ITC) 002801 00290 IF(ITC.NE.2) GO TO 220 00300 IF(IBUF(6).NE.6) GO TO 220 00310 CALL CCSMVA(IBUF,1,6,ASOFDT,1,8) 00320 IF(IDATVR(ASOFDT,1).LT.0) GO TO 220 00330 IF(WFG1.EQ.$32) GO TO 300 00340 DEL/ 132,139 00350 260 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00360 CALL WTREAD(LUNIT,-1,DSP3,42,-1,IBUF,10,ITC) 00370 IF(ITC.NE.2) GO TO 260 00380 NCH = IBUF(6) 00390 IF(NCH.LT.1 .OR. NCH.GT.3) GO TO 260 004001 00410C CHECK FOR NUMERICS 00420 DO 280 II=1,NCH 00430 DEL/ 146,151 00440 290 CALL INTGR(IBUF,NCH,NDAYS) 00450 DEL/ 160,162 00460 320 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00470 CALL WTREAD(LUNIT,-1,DSP5,20,-1,IBUF,10,ITC) 00480 IF(ITC.NE.2) GO TO 300 00490 IF(IBUF(6).NE.1)GO TO 300 00500 DEL/ 168,171 00510 340 CALL CCSMVA(IBUF,1,0,IBUF,1,12) 00520 CALL WTREAD(LUNIT,-1,DSP6,34,-1,IBUF,10,ITC) 00530 IF(ITC.NE.2) GO TO 340 00540 DEL/ 210 00550 420 CONTINUE 00560 DEL/ 229 00570 450 CONTINUE 00580 DEL/ 240,249 005901 00600 500 CALL DAYS(DELQRC(JW+1),875,ASOFDT,1,ADAYS,0) 00610 CALL CCSGET( ADAYS,1,ICM ) 00620 CALL INTGR(ADAYS(2),4,DDAYS) 00630 IF( ICM.EQ.$2D ) DDAYS = -1 00640 DEL/ 253 00650 540 IF(DDAYS.LT.NDAYS) GO TO 580 00660 DEL/ 258 00670 DEL/ 264 00680 DEL/ 269 00690 DEL/ 286 00700 700 CONTINUE 00710 DEL/ 305 00720 730 CONTINUE 00730 DEL/ 316,331 00740 CALL DAYS(DELQRC(JW+1),857,ASOFDT,1,ADAYS,0) 00750 CALL CCSGET( ADAYS,1,ICM ) 00760 IF(ICM.NE.$2D) GO TO 780 007701 00780 DEL/ 340 00790 DEL/ 345,346 00800 780 ASSIGN 800 TO RETURN 00810 DEL/ 379,382 00820C IF BUFFER IS FULL. 008301 00840 1060 CONTINUE 00850 NUMPUT = NUMPUT + 1 00860 IWW = NUMPUT * 58 - 57 008701 00880 CALL CCSMVA(WOEFRC,1,115,WEFREC(IWW),1,115) 00890 IF(NUMPUT.LT.15) GO TO 1070 009001 00910 1065 CALL PUTS(WOEFBF,WEFREC,NUMPUT,ISTAT) 00920 IF(ISTAT.GE.0) GO TO 1068 00930 CALL FILERR(WDATA,11,ISTAT,LUNIT) 00940 GO TO 9500 009501 00960 1068 NUMPUT = 0 00970 IF(IFG.EQ.1) GO TO 9000 00980 DEL/ 410,429 00990 9000 CONTINUE 01000 IFG = 1 01010 IF(NUMPUT.NE.0) GO TO 1065 01020XLAT DCK/ I,H MON03 DCK/ I,H CMPACC DCK/ I=13,H 00010CMPACC HOL/ 00020 PROGRAM CMPACC 00010 1 / TREND-COMPRESS ACCAGE OR CLEAR SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 09/20/83 ************ PROGRAMMER : RWE 000901 001001 00110C*** CMPACC - CHECKS THE UTIFIL FOR THE 'TRND' KEY IF IT IS NOT 00120C FOUND, IT ASSUMES THAT TREND IS BEING RUN. 00130C ** IF IT IS FOUND AND THE RECORD EQUALS 'NO ' THEN 00140C IT CLEARS ACCAGE & RSWFIL FILES, OTHERWISE IT ASSUMES 00150C TREND ANALYSIS IS BEING RUN. 00160C ** WHEN TREND IS BEING RUN CMPACC READS ACCAGE AND DELETES 00170C ANY RECORDS WITH 'RSW' IN POSITION 35. CMPACC ALSO 00180C CHECKS FOR DELETED RECORDS WHILE READING ACCAGE. 00190C ** IF ANY RECORDS WERE DELETED OR ANY DELETED RECORDS 00200C WERE FOUND DURING THE READ IT THEN COMPRESS'S ACCAGE. 002102 00220 EXTERNAL FMRDEL 002301 00240 INTEGER UDATA(15),UREQ(24),UREC(45),UKEY(15) 00250 INTEGER ADATA(15),AREQ(24),NO(2),TRNDKY(2),CMPRS(14) 00260 INTEGER RDATA(15),RREQ(24),RSW(2),DELETE,FIRST 00270 INTEGER FMRDEL,FDEL,ID(4),LA(4) 002801 00290 DATA UDATA/'LAUTIFIL ',1,1,0/,UREQ/24*0/ 00300 DATA ADATA/'LAACCAGE ',1,1,1/,AREQ/24*0/ 00310 DATA RDATA/'LARSWFIL ',0,1,0/,RREQ/24*0/ 00320 DATA NO/'NO '/,TRNDKY/'TRND'/,RSW/'RSW '/,LA/'LA '/ 00330 DATA CMPRS/$D0A,$1716,'COMPRESSING ACCAGE FILE '/ 00340 DATA UKEY/15*0/,FIRST/0/ 003502 00360C**** BEGIN ************************************** 003701 00380 ASSEM $C000,FMRDEL,$6800,FDEL 003901 00400 CALL PGMIN(ID,LU,MO,NP) 004101 00420C*** IF USERID NOT LA CHANGE TO CCS FILES ! 00430 CALL CCSCST(ID,1,8,LA,1,8,ICM) 00440 IF (ICM.EQ.0) GO TO 100 00450 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00460 CALL CCSMVA(ADATA,3,6,ADATA,1,8) 00470 CALL CCSMVA(RDATA,3,6,RDATA,1,8) 004801 00490 100 CALL OPENFL(UREQ,UDATA,ISTAT) 00500 IF (ISTAT.GE.0)GO TO 120 00510 CALL FILERR(UDATA,3,ISTAT,LU) 00520 GO TO 920 00530 120 CONTINUE 00540 CALL READR(UREQ,UREC,TRNDKY,ISTAT) 00550 CALL CLOSFL(UREQ,ISTA1) 00560 IF(AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 300 00570 IF(ISTAT.GE.0) GO TO 140 00580 CALL FILERR(UDATA,13,ISTAT,LU) 00590 GO TO 920 00600 140 CALL CCSCST(UREC,5,3,NO,1,3,ICM) 00610 IF (ICM.NE.0) GO TO 300 006201 00630C******* TREND ANALYSIS IS NOT BEING RUN CLEAR - ACCAGE & RSWFIL. 006401 00650 CALL CLEAR(AREQ,ADATA,ISTAT) 00660 IF(ISTAT.GE.0) GO TO 160 00670 CALL FILERR(ADATA,1,ISTAT,LU) 00680 GO TO 920 00690 160 CALL CLEAR(RREQ,RDATA,ISTAT) 00700 IF (ISTAT.GE.0) GO TO 180 00710 CALL FILERR(RDATA,1,ISTAT,LU) 00720 GO TO 920 007301 00740 180 CONTINUE 00750 DO 185 I = 1,24 00760 185 AREQ(I) = 0 00770 ADATA(13) = 1 00780 CALL OPENFL(AREQ,ADATA,ISTAT) 00790 IF (ISTAT.GE.0) GO TO 190 00800 CALL FILERR(ADATA,3,ISTAT,LU) 00810 GO TO 900 008201 00830 190 CALL CCSBLK(UREC,82) 00840 CALL WRITER(AREQ,UREC,UREC,ISTAT) 00850 IF (ISTAT.GE.0) GO TO 900 00860 CALL FILERR(ADATA,11,ISTAT,LU) 00870 GO TO 900 00880. 008901 00900C*** READ ACCAGE CHECKING FOR 'RSW' OR DELETED RECORDS 009101 00920 300 CONTINUE 00930 CALL WTREAD(LU,-1,CMPRS,28,0,0,0,ITC) 009401 00950 310 CALL OPENFL(AREQ,ADATA,ISTAT) 00960 IF (ISTAT.GE.0) GO TO 320 00970 CALL FILERR(ADATA,3,ISTAT,LU) 00980 GO TO 900 00990 320 CALL GETS(AREQ,UREC,UKEY,ISTAT) 01000 IF(AND(ISTAT,$100).EQ.$100) GO TO 500 01010 IF(ISTAT.GE.0) GO TO 340 01020 CALL FILERR(ADATA,14,ISTAT,LU) 01030 GO TO 900 01040 340 CONTINUE 01050 IF (FIRST.EQ.1) GO TO 350 01060 FIRST = 1 01070 CALL CCSCST(UREC,50,3,RSW,1,3,ICM) 01080 IF (ICM.EQ.0) GO TO 350 01090 DELETE = 1 01100 GO TO 500 01110 350 CONTINUE 01120 IF(UREC(1).EQ.FDEL) DELETE = 1 01130 IF(UREC(1).EQ.FDEL) GO TO 320 01140 CALL CCSCST(UREC,35,3,RSW,1,3,ICM) 01150 IF(ICM.NE.0) GO TO 320 01160 360 CONTINUE 01170 CALL DELREC(AREQ,UREC,ISTAT) 01180 IF(ISTAT.GE.0) GO TO 370 01190 CALL FILERR(ADATA,16,ISTAT,LU) 01200 GO TO 900 01210 370 DELETE = 1 01220 GO TO 320 01230. 012401 01250C****** COMPRESS ACCAGE IF ANY DELETES 012601 01270 500 CONTINUE 01280 CALL CLOSFL(AREQ,ISTAT) 01290 IF(ISTAT.GE.0) GO TO 520 013001 01310 GO TO 900 013201 01330 520 CONTINUE 01340 IF (DELETE.NE.1) GO TO 920 013501 01360 ADATA(13) = -1 01370 ADATA(15) = 0 013801 01390 DO 530 I = 1,24 01400 530 AREQ(I) = 0 01410 CALL OPENFL(AREQ,ADATA,ISTAT) 01420 IF (ISTAT.GE.0) GO TO 540 01430 CALL FILERR(ADATA,3,ISTAT,LU) 01440 GO TO 900 014501 01460 540 CALL COMFIL(AREQ,UREC,ISTAT) 01470 IF(AND(ISTAT,$100).EQ.$100) GO TO 900 01480 IF(ISTAT.GE.0) GO TO 540 01490 CALL FILERR(ADATA,17,ISTAT,LU) 01500 GO TO 900 015102 01520 900 CALL CLOSFL(AREQ,ISTAT) 01530 920 CALL PGMOUT 01540 END 01550 END/ 00040COLSTS DCK/ I=13,H 00010COLSTS HOL/ 00020 PROGRAM COLSTS 00010 1 /CCS3.0 COLLECTOR STATISTICS REPORT SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/30/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : 001101 00120C THE COLLECTOR STATISTICS REPORT PROCESSOR PRINTS A REPORT OF THE 00130C ACTIONS & RESULTS CODE ACTIVITY ON A DAILY, WEEKLY OR MONTHLY 00140C BASIS. IT MAY ALSO ZERO OUT THE DAILY OR WEEKLY ACTIVITY 00150C COUNTS AS REQUESTED VIA THE RPG SWITCH. IT USES THE FILE 'UTIFIL' 00160C TO ACQUIRE THE ACTION AND RESULT CODES AND THE COLLECTOR NAMES 00170C AND INITIALS. IT PROCESSES THE FILE 'COLSTATS' WHICH HAS BEEN 00180C PREVIOUSLY GENERATED OR UPDATED BY THE TIME USAGE PROCESSOR. 001901 00200C THE RPG SWITCH IS USED TO DETERMINE WHICH PROCESSING IS TO BE 00210C DONE AS FOLLOWS: 00220C - DAILY COLLECTOR STATISTICS REPORT (U1 ON) 00230C - WEEKLY COLLECTOR STATISTICS REPORT (U2 ON) 00240C - MONTHLY COLLECTOR STATISTICS REPORT (U3 ON) 00250C - ZERO THE DAILY COUNTS (U4 ON) 00260C - ZERO THE WEEKLY COUNTS (U5 ON) 00270C ( NOTE - THE MONTHLY COUNTS ARE ZEROED BY CLEARING THE 'COLSTATS' 00280C FILE IN THE PROCEDURE STREAM) 002901 00300C THE REPORTS PRINT THE COLLECTOR STATISTICS FROM THE VARIOUS 00310C ACTION AND RESULTS CODES COUNT. THERE IS MAXIMUM 32 CODES EACH. 00320C ONLY 16 CODES ARE PRINTED ON A LISTING PAGE. THUS IF THE SYSTEM H 00330C MORE THAN 16 CODES DEFINED, THE REPORT PAGE CONSISTS OF TWO LISTIN 00340C PAGES. COLLECTOR TOTALS ARE PRINTED ONLY ON THE SECOND PAGE IN TH 00350C CASE. THE TWO PAGES ARE NUMBERED A & B. 00360C ACCURACY IS AS FOLLOWS: 00370C TOTAL EACH CODE - 4 DIGITS 00380C COLLECTOR TOTALS- 6 DIGITS 00390C CODE TOTALS - 6 DIGITS 00400C GRAND TOTAL - 6 DIGITS 004101 00420 INTEGER BYPASS,CNTNDX,CODE,CODEX,CODSUM(32),CODSUL(32) 00430 +, COLSUM(128),COLSUL(128),COLID(2),COUNT(128,32) 00440 +, INAME(9,128),ZEROS(2) 004501 00460 INTEGER DAILY(3),MONTHY(4),WEEKLY(3),ACTC(2),RESC(2) 00470 +, EORMSG(11),GOTHDR,GRANDM,GRANDL,TOTL(3),IASCII(3) 00480 +, ICNT(4),IVAL,IVAL2,JCNT,KEYCOL(4),NOCODE 00490 +, PAGE,PAGEAB,PRT,RECUTI(40),RESULT(4) 00500 +, OCOLID(2),UTKEY(2),UTCODB(40),UTCODE(32) 005101 00520 EQUIVALENCE ( UTCODE,UTCODB(3) ) 005301 00540 DATA DAILY/'DAILY '/,MONTHY/'MONTHLY '/,WEEKLY/'WEEKLY'/ 00550 +, TOTL/'TOTALS'/,RESULT/'RESULTS '/ 00560 +, ACTC/'ACTC'/,RESC/'RESC'/ 00570 +, BYPASS/0/,KEYCOL/4*0/,NOCODE/32/,ZEROS/'0000'/ 00580 DATA EORMSG/'*** END OF REPORT ***'/ 005901 00600 INTEGER HDLIN5(66),HDLINX(66),HDLN6A(66),HDLN6B(66) 006101 00620 DATA HDLIN5/33*$2020,'ACTIONS ',29*$2020/ 00630 +, HDLINX/66*$2020/ 00640 +, HDLN6A/' COLLECTOR NAME ',58*$2020/ 00650 +, HDLN6B/' COLLECTOR NAME ',55*$2020,'TOTAL '/ 006601 00670 INTEGER DAT1(15),LD1(4),REQ1(24),REC1(0012) 006801 00690 INTEGER UTFILE(4),SYPFIL(4) 00700 DATA UTFILE/'UTIFIL '/,SYPFIL/'SYSPRT '/ 007101 00720 EQUIVALENCE ( REQ1(15), NUMRD ) 00730 INTEGER HEAD(18) 007401 00750 DATA HEAD/$0D0A,$0A17,'EXECUTING COLSTS ',$0F16/ 00760 DATA DAT1 /'LACOLSTSLA ',01,01,00/,REQ1/24*0/ 007701 00780 DATA LD1/'COLSTATS'/ 007901 00800 INTEGER USER(4),U(8),GRPBUF(10),DATE(3),HDR(20,3) 00810 +, LU,PLU,NPORT,IWAY,IMODE,IALL,IOPT,ITF 00820 +, IPAGE,MTOT(6),LTOT(6),TOT14(7),TEMP(8) 008301 00840 DATA PLU/12/,IPAGE/0/,MTOT/'000000000000'/ 00850 +, IFOUND/0/,LTOT/'000000000000'/ 00860 +, IWAY/3/,IMODE/3/,TOT14/'00000000000000'/ 008701 00880C**** SYSPRT PARAMETERS........ 008901 00900 INTEGER SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 009101 00920 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 00930 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 00940 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 009501 00960 DATA PLN/132/,NLU/05/,IPF/00/,NLINE/0/,ISERR/0/,NU/1/ 009701 00980 INTEGER L01(66),L02(66),L03(66),L04(66),L14(66) 009901 01000C POS. 01 +------------------ THRU ------------------+ 44 01010 DATA L01/'1---------- HDR1 GOES HERE -------------- ' 01020 +, ' COLLECTOR STATISTICS REPORT ' 01030 +, ' PAGE '/ 010401 01050C POS. 01 +------------------ THRU ------------------+ 44 01060 DATA L02/' ---------- HDR2 GOES HERE -------------- ' 01070 +, ' AS OF: ' 01080 +, ' '/ 010901 01100C POS. 01 +------------------ THRU ------------------+ 44 01110 DATA L03/' ---------- HDR3 GOES HERE -------------- ' 01120 +, ' ' 01130 +, ' '/ 011401 01150C POS. 01 +------------------ THRU ------------------+ 44 01160 DATA L04/' ' 01170 +, ' ' 01180 +, ' '/ 01190C POS. 01 +------------------ THRU ------------------+ 44 01200 DATA L14/' **COLSTS** ERROR IN FILE : XXXXXXXX ' 01210 +, ' RUN ABORTED ********** ' 01220 +, ' '/ 01230. 012401 01250C**** 01260C**** BEGIN PROGRAM ....... 012701 01280C*** GET EXTERNAL SWITCHS, USER INFO, HEADINGS, AND OTHER PARAMETERS 012901 01300 CALL GETSW ( U(1) ) 01310 CALL PGMIN ( USER,LU,MODE,NPORT ) 013201 01330C*** CCS/LA LOOK-ALIKE..... 013401 01350 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 01360 IF ( ICM.EQ.0 ) GO TO 5 01370 CALL CCSMVA( LD1,1,8,DAT1,1,16 ) 01380 5 CONTINUE 013901 01400 CALL CCSMVA( USER,1,8,HEAD,23,8 ) 01410 CALL WTREAD( LU,-1,HEAD,36,0,0,0,ITC ) 01420 CALL UTHEAD( HDR,DATE ) 014301 01440 CALL GTSYSP( IWAY, 17 ) 01450 CALL GTSYSP( IMODE, 18 ) 01460 CALL PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 01470 CALL GETGRP( GRPBUF,IALL,IMODE ) 014801 01490C ..CHECK SWITCH SETTING 01500C .. NOTE - ONLY FIRST BIT SET IN SWITCH IS PROCESSED. 015101 01520 DO 110 IU = 1,3 01530 IF (U(IU) .EQ. 1) GO TO 100 01540 110 CONTINUE 015501 01560 DO 120 IU = 4,5 01570 IF (U(IU) .EQ. 1) GO TO 700 01580 120 CONTINUE 015901 01600C .. NO SWITCHES SET, EXIT. 01610 GO TO 9900 016201 01630C**** OPEN FILES AND GET UTIFIL RECORDS 016401 01650 100 CONTINUE 01660 CALL SYSPRT( L01,0,SYSPRM,0 ) 01670 IF( ISERR.LT.0 ) CALL CCSMVA( SYPFIL,1,8,UTFILE,1,8 ) 01680 IF( ISERR.LT.0 ) GO TO 9820 016901 01700 CALL OPENFL( REQ1,DAT1,ISTAT ) 01710 IF ( ISTAT.LT.0 ) GO TO 9800 01720 REQ1(23) = 1 017301 01740 CALL EDIT( DATE,1,L02,70,1) 01750C--- CALL CCSTIM( L02(40) ) 01760 CALL CCSMVA( HDR(01,01),1,40,L01,2,40 ) 01770 CALL CCSMVA( HDR(01,02),1,40,L02,2,40 ) 01780 CALL CCSMVA( HDR(01,03),1,40,L03,2,40 ) 01790 IF(NPORT.NE.0 .AND.IPF.NE.1) CALL CCSPUT( $0C,1,L01 ) 018001 01810C ..SET FOR PROCESSING ACTION CODE REPORT (ACTC) 018201 01830 130 CONTINUE 01840 IBYTE = 8+(IU-1)*4 018501 01860 CALL CCSMVA( ACTC ,1,4,UTKEY,1,4 ) 01870 140 CALL GETUTI( UTKEY,UTCODB,IFOUND,IFER,0 ) 01880 IF( IFER.LT.0 ) GO TO 9820 01890 IF( IFOUND.NE.0 ) GO TO 9820 019001 01910C ..CLEAR COUNT MATRIX AND COLLECTOR TOTALS 01920 DO 230 I = 1,128 01930 DO 225 J = 1,32 01940 COUNT(I,J) = 0 01950 225 CONTINUE 01960 COLSUM(I) = 0 01970 COLSUL(I) = 0 01980 230 CONTINUE 019901 02000C ..INITIALIZE GRAND TOTAL 02010 GRANDL = 0 02020 GRANDM = 0 02030C ..SET COLLECTOR INDEX = 0 (INITIALIZATION) 02040 ICOLX = 0 02050 CALL CCSMVA( INAME,1,0,INAME,1,40 ) 020601 02070C .. BEGIN PROCESSING OF COLSTATS RECORD 02080C ..READ COLSTATS RECORD (UNLESS PREVIOUS REC. NOT PROCESSED YET) 02090 235 IF (BYPASS .NE. 0) GO TO 240 02100 CALL GETS ( REQ1, REC1, KEYCOL, ISTAT) 02110C ..CHECK FOR EOF 02120 IF (AND(ISTAT,$8100) .EQ. $8100) GO TO 300 02130 IF( ISTAT.LT.0 ) GO TO 9800 02140C ..CHECK FOR CHANGE IN CODE TYPE(ACTION TO RESULT); GO 02150C .. PRINT REPORT. 02160 240 IF (AND(REC1,$FF00) .NE. AND(UTKEY,$FF00)) GO TO 300 02170C ..CLEAR BYPASS READ OF COLSTATS RECORD FLAG 02180 BYPASS = 0 02190C ..IF ICOLX(COLLECTOR INDEX) = 0(FIRST TIME) 02200C .. DO NOT CHECK FOR NEW COLLECTOR 02210 IF (ICOLX .NE. 0) GO TO 245 02220C ..FIRST TIME PROCESSING 02230C .. SET UP COLLECTOR ID 02240 CALL CCSMVA (REC1, 2, 4, COLID, 1, 4) 02250C ..SET COLLECTOR INDEX TO FIRST 02260 ICOLX = 1 02270C ..GO GET NAME,INITIAL FOR FIRST COLLECTOR 02280 GO TO 255 02290C ..IF NO CHANGE IN COLLECTOR, BYPASS PROCESSING FOR 02300C .. LAST COLLECTOR 02310 245 CALL CCSMVA (REC1, 2, 4, COLID, 1, 4) 02320 IF (COLID(1) .EQ. OCOLID(1) .AND. COLID(2) .EQ. OCOLID(2)) 02330 1 GO TO 260 02340C ..NEW COLLECTOR LOGIC 02350C ..SUM COLLECTOR CODES OF LAST COLLECTOR 02360 ASSIGN 250 TO IRTN 02370 GO TO 980 02380C ..BUMP COLLECTOR INDEX 02390 250 ICOLX = ICOLX + 1 02400C ..GET COLLECTOR NAME, INITIAL FROM UTIFIL FILE. 024101 02420 255 CALL GETUTI( COLID,RECUTI,IFOUND,IFER,0 ) 02430 IF( IFER.LT.0 ) GO TO 9820 02440 IF( IFOUND.NE.0 ) CALL CCSMVA( COLID,1,4,RECUTI,5,4 ) 024501 02460C ..SAVE NAME AND INITIAL 02470 CALL CCSMVA (RECUTI, 5, 15, INAME(1,ICOLX), 3, 16) 02480 CALL CCSMVA (RECUTI, 20, 1, INAME(1,ICOLX), 1, 2) 02490C ..UPDATE CURRENT COLLECTOR ID 02500 OCOLID(1) = COLID(1) 02510 OCOLID(2) = COLID(2) 02520C ..SEARCH CODE ARRAY FOR MATCHING CODE TO GENERATE INDEX 02530C .. FOR COUNT STORE IN COUNT MATRIX 02540 260 CALL CCSMVA (REC1, 6, 2, CODE, 1, 2) 02550 DO 270 I = 1,NOCODE 02560 IF (UTCODE(I) .EQ. CODE) GO TO 280 02570 270 CONTINUE 02580C ..IF NO CODE FOUND, IQNORE COLSTATS RECORD 02590 GO TO 295 02600C ..CALC. CODE INDEX TO COUNT MATRIX 02610 280 CONTINUE 02620 CODEX = I 026301 02640C ..REMOVE FROM RECORD FOR PROCESSING 02650 CALL CCSMVA (REC1, IBYTE, 4, ICNT, 1, 4) 02660C ..CONVERT TO HEX 02670 JCNT = (AND(ICNT(1),$0F00)/$100) * 10 02680 JCNT = (JCNT + AND(ICNT(1),$F)) * 10 02690 JCNT = (JCNT + (AND(ICNT(2),$0F00))/$100) * 10 02700 JCNT = JCNT + AND(ICNT(2),$F) 02710C ..ADD TO COUNT MATRIX 02720 COUNT(ICOLX,CODEX) = COUNT(ICOLX,CODEX) + JCNT 02730C ..ADD TO GRAND TOTAL 02740C .. (2 WORD ARITHMETIC MODULE 10**4) 02750 GRANDL = GRANDL + JCNT 02760 IF (GRANDL .LT. 10000) GO TO 290 02770 GRANDM = GRANDM + 1 02780 GRANDL = GRANDL-10000 02790 290 CONTINUE 02800C .. END OF PROCESSING OF ONE COLSTATS RECORD 02810 295 GO TO 235 02820C ..SUM LAST COLLECTOR'S CODES 02830 300 CONTINUE 02840 IF( ICOLX.EQ.0 ) ICOLX = 1 02850 ASSIGN 305 TO IRTN 02860 GO TO 980 028701 02880C ..BEGIN CODE TOTALS PROCESSING 02890C ..CALC. CODES TOTALS(2 WD ARITHMETIC MODULO 10**4) 02900 305 DO 320 I=1,NOCODE 02910 CODSUL(I) = 0 02920 CODSUM(I) = 0 02930 DO 310 J = 1,ICOLX 02940 CODSUL(I) = CODSUL(I) + COUNT(J,I) 02950 IF (CODSUL(I) .LT. 10000) GO TO 310 02960 CODSUM(I) = CODSUM(I) + 1 02970 CODSUL(I) = CODSUL(I)-10000 02980 310 CONTINUE 02990 320 CONTINUE 030001 03010C ..BEGIN REPORT GENERATION AND PRINT 03020 400 CONTINUE 030301 03040C ..SET UP TYPE REPORT PER U1,U2,U3 03050 422 GOTO (430, 440, 450), IU 03060 430 CALL CCSMVA (DAILY, 1, 5, L01, 55, 5) 03070 GO TO 460 03080 440 CALL CCSMVA (WEEKLY, 1, 6, L01, 54, 6) 03090 GO TO 460 03100 450 CALL CCSMVA (MONTHY, 1, 7, L01, 53, 7) 03110C ..RESET PAGE COUNTER 03120 460 PAGE = 0 03130C ..MOVE IN 'RESULTS' TEXT IF RESULT REPORT 03140 IF (UTKEY .NE. $5245) GO TO 470 03150 CALL CCSMVA (RESULT, 1, 7, HDLIN5, 67, 7) 03160C ..SET UP FIRST 16 CODES 03170 470 DO 480 I = 1,16 03180 J = I*2 - 1 03190 JJ = 26 + (I-1)*6 03200 CALL CCSMVA (UTCODE, J, 2, HDLN6A, JJ, 2) 03210 480 CONTINUE 03220C ..BLANK FIELD FOR 'TOTAL' TEXT 03230 CALL CCSMVA(I, 1, 0, HDLN6A, 127, 5) 03240C .. NOTE - EACH PAGE OF REPORT MAY CONSIST OF 1 OR 2 LISTING 03250C .. PAGES. IF TWO PAGES, THEY ARE CALLED PAGE A & B. 03260C ..INITIALIZE PAGE TYPE(A OR BLANK IF 1 LISTING PAGE) 03270C .. (DOUBLE * IS USED TO INDICATE FIRST NON-CODE ENTRY) 03280 PAGEAB = $2020 03290 IF (UTCODE(17) .NE. $2A2A) PAGEAB = $4120 03300C ..IF MORE THAN 16 CODES, SET UP 2ND 16 CODES 03310 IF (PAGEAB .EQ. $2020) GO TO 494 03320 DO 490 I = 17,32 03330 J = I*2 -1 03340 JJ = 26 + (I-17)*6 03350 CALL CCSMVA (UTCODE, J, 2, HDLN6B, JJ, 2) 03360 490 CONTINUE 03370 GO TO 500 03380C ..MOVE 'TOTAL' TEXT FOR COLLECTOR TOTALS HEADING 03390 494 CALL CCSMVA (TOTL, 1, 5, HDLN6A, 127, 5) 03400C ..INITIALIZE INDICIES TO COUNT MATRIX 03410 500 ICOLX = 0 03420C 03430C .. BEGIN PRINT PAGE LOGIC 03440C ..SAVE ICOLX(COLLECTOR INDEX) FOR PAGE B PROCESSING 03450 505 ICOLXV = ICOLX 03460C ..BUMP PAGE COUNT 03470 PAGE = PAGE + 1 03480 IVAM = 0 03490 IVAL = PAGE 03500 ASSIGN 507 TO IRTN2 03510 GO TO 990 035201 03530C*** PRINT HEADER LINES 1-5. RESENT LINE COUNT, SET PAGE TYPE. 035401 03550 507 CONTINUE 03560 CALL CCSMVA (IASCII, 3, 4, L01, 125, 4) 03570 510 CALL CCSMVA (PAGEAB, 1, 1, L01, 129, 1) 03580 ICOLX = ICOLXV 03590 LNCNT = 0 03600 ASSIGN 520 TO IRTN 03610 GO TO 900 03620C ..PRINT HEADER LINES 6,7 PER PAGE TYPE (A OR B) 03630 520 ASSIGN 530 TO IRTN 03640 IF (PAGEAB .EQ. $4220) GO TO 904 03650 GO TO 902 03660C ..BUMP COLLECTOR INDEX 03670 530 ICOLX = ICOLX + 1 03680C ..CHECK FOR END 03690 IF (ICOLX .GT. 128) GO TO 550 03700C ..CHECK FOR ANY CODES; IF NONE, GO TO NEXT COLLECTOR 03710 IF (COLSUM(ICOLX) .EQ. 0 .AND. COLSUL(ICOLX) .EQ. 0) GO TO 530 03720C ..PRINT 1 LINE OF COLLECTOR ACTIVITY 03730 ASSIGN 535 TO IRTN 03740 IF (PAGEAB .EQ. $2020) GO TO 908 03750 IF (PAGEAB .EQ. $4220) GO TO 910 03760 GO TO 906 03770C ..BUMP LINE COUNT (DOES NOT INCLUDE HEADER LINES) 03780 535 LNCNT = LNCNT + 1 03790C ..CHECK FOR ENOUGH LINES THIS PAGE 03800 IF (LNCNT .LE. 40) GO TO 530 03810C 03820C ..END OF PAGE PROCESSING 03830C ..IF SINGLE PAGE PER CODES, GO START NEXT PAGE OF REPORT 03840 IF (PAGEAB .EQ. $2020) GO TO 505 03850C ..FOR TWO PAGES PER CODES, SET TO PAGE B OR GO START 03860C .. NEW REPORT PAGE 03870 IF (PAGEAB .EQ. $4120) GO TO 540 03880 PAGEAB = $4120 03890 GO TO 505 03900 540 PAGEAB = $4220 03910 GO TO 510 03920C ..PRINT TOTALS LINE 03930C ..IF SINGLE PAGE PER CODES, PRINT TOTALS & EXIT 03940 550 IF (PAGEAB .NE. $2020) GO TO 560 03950C ..PRINT TOTALS FOR SINGLE PAGE PER CODES, SET RETURN TO 03960C .. END REPORT PRINTING 03970 ASSIGN 570 TO IRTN 03980 GO TO 930 03990C ..FOR TWO PAGES PER CODES, 04000C ..PRINT TOTALS PAGE A, SET RETURN FOR PAGE B 04010C ..OR PRINT TOTALS PAGE B, SET RETURN TO END REPORT PRINTING 04020 560 ASSIGN 570 TO IRTN 04030 IF (PAGEAB .EQ. $4220) GO TO 940 04040 ASSIGN 540 TO IRTN 04050 GO TO 920 04060C ..IF THIS WAS ACTION REPORT, SET TO PROCESS RESULTS REPORT 04070 570 IF (UTKEY(1) .NE. $4143) GO TO 580 04080C ..SET FOR PROCESSING RESULTS REPORT(RESC) 040901 04100 CALL CCSMVA( RESC,1,4,UTKEY,1,4 ) 041101 04120 BYPASS = 1 04130 GO TO 140 04140C ..PRINT 'END OF REPORT' LINE, SET RETURN TO EXIT 04150 580 ASSIGN 9900 TO IRTN 04160 GO TO 970 04170C 04180C ..END OF REPORT LOGIC 04190. 04200C ..BEGIN CLEAR COUNT LOGIC 04210C 04220C ..OPEN COLSTATS FILE 042301 04240 700 CONTINUE 04250 DAT1(13) = 0 04260 DAT1(14) = 400 04270 DAT1(15) = -1 04280 CALL OPENFL ( REQ1, DAT1 , ISTAT) 04290 IF (ISTAT .LT. 0) GO TO 9800 043001 04310 710 CALL GETS ( REQ1,COUNT,KEYCOL,ISTAT ) 043201 04330 IF( AND( ISTAT,$8100).EQ.$8100 ) GO TO 9900 04340 IF( ISTAT.LT.0 ) GO TO 9800 043501 04360C ..CLEAR COUNTS PER SWITCH(U4,U5); IU = 4,5 04370 720 J = REQ1(15) 04380 JJ = 8 + (IU-4)*4 - 20 04390 DO 730 I = 1,J 04400 JJ = JJ + 20 04410 CALL CCSMVA (ZEROS, 1, 4, COUNT, JJ, 4) 04420 730 CONTINUE 044301 04440 CALL UPDREC ( REQ1,COUNT,ISTAT ) 04450 IF (ISTAT .LT. 0) GO TO 9800 044601 04470 GO TO 9900 04480. 04490C .. PSEUDO SUBROUTINES 04500C 04510C ..PRINT HEADER LINES 1-5 04520 900 CONTINUE 04530 CALL SYSPRT( L01,1,SYSPRM,0 ) 04540 CALL SYSPRT( L02,1,SYSPRM,0 ) 04550 CALL SYSPRT( L03,1,SYSPRM,0 ) 04560 CALL SYSPRT( L04,1,SYSPRM,0 ) 04570 CALL SYSPRT( HDLIN5,1,SYSPRM,0 ) 04580 GO TO IRTN 045901 04600C ..PRINT LINES 6,7 PAGE A 04610 902 CALL SYSPRT( HDLN6A,1,SYSPRM,0 ) 04620 GO TO 905 046301 04640C ..PRINT LINE 6,7 PAGE B 04650 904 CALL SYSPRT( HDLN6B,1,SYSPRM,0 ) 04660 905 CALL SYSPRT( L04,1,SYSPRM,0 ) 04670 GO TO IRTN 046801 04690C ..PRINT 1 LINE OF COLLECTOR STATISTICS 04700C ..ENTRY FOR PAGE A 04710C ..BLANK FILL COLLECTOR TOTAL FIELD 04720 906 CALL CCSMVA (I, 1, 0, HDLINX, 127, 5) 04730 IB = 1 04740 GO TO 914 04750C .. ENTRY FOR SINGLE PAGE REPORT PAGE 04760 908 IB = 1 04770 GO TO 912 04780C .. ENTRY FOR PAGE B 04790 910 IB = 17 04800C ..CONVERT & STORE COLLECTOR TOTAL 04810 912 CONTINUE 04820 IVAM = COLSUM(ICOLX) 04830 IVAL = COLSUL(ICOLX) 04840 ASSIGN 913 TO IRTN2 04850 GO TO 990 048601 04870 913 CONTINUE 04880 CALL CCSMVA( IASCII,01,06,HDLINX,126,06 ) 048901 04900 914 CONTINUE 049101 04920C ..CONVERT COUNTS & STORE IN LINE 04930 ASSIGN 915 TO IRTN2 04940 DO 916 I = 1,16 04950 IF( UTCODE(IB).EQ.$2A2A ) GO TO 916 04960 IVAM = 0 04970 IVAL = COUNT(ICOLX,IB) 04980C ..CONVERT 04990 GO TO 990 05000 915 JX = 24 + (I-1)*6 05010 CALL CCSMVA (IASCII, 3, 4, HDLINX, JX, 4) 05020 IB = IB + 1 05030 916 CONTINUE 05040C ..MOVE INITIAL, NAME TO LINE 05050 CALL CCSMVA (INAME(1,ICOLX), 1, 17, HDLINX, 2, 17) 05060C ..PRINT LINE 05070 CALL SYSPRT( HDLINX,1,SYSPRM,0 ) 05080 GO TO IRTN 050901 05100C ..PRINT TOTALS LINE LOGIC 05110C .. ENTRY FOR PAGE A (NO GRAND TOTAL) 05120C ..BLANK FILL GRAND TOTAL FIELD 05130 920 CALL CCSMVA (I, 1, 0, HDLINX, 126, 6) 05140 IB = 1 05150 GO TO 960 05160C .. ENTRY FOR SINGLE PAGE REPORT PAGE 05170 930 IB = 1 05180 GO TO 950 05190C .. ENTRY FOR PAGE B 05200 940 IB = 17 052101 05220C ..PLACE GRAND TOTAL IN LINE 052301 05240 950 CONTINUE 05250 IVAM = GRANDM 05260 IVAL = GRANDL 05270 ASSIGN 955 TO IRTN2 05280 GOTO 990 052901 05300 955 CONTINUE 05310 CALL CCSMVA( IASCII,1,6,HDLINX,126,6 ) 053201 05330C ..MOVE 'TOTALS' TEXT TO LINE 05340 960 CALL CCSMVA (TOTL , 1, 00, HDLINX, 1, 22) 05350 CALL CCSMVA( TOTL , 1, 06, HDLINX,14, 06 ) 053601 05370C ..CONVERT TOTAL & STORE IN LINE 05380 DO 965 I = 1,16 05390 JX = 22 + (I-1)*6 05400 IF( UTCODE(IB).EQ.$2A2A ) GO TO 965 05410 IVAM = CODSUM(IB) 05420 IVAL = CODSUL(IB) 05430 ASSIGN 962 TO IRTN2 05440 GO TO 990 054501 05460 962 CONTINUE 05470 CALL CCSMVA (IASCII, 1, 6, HDLINX, JX, 6) 05480 IB = IB + 1 05490 965 CONTINUE 055001 05510 CALL SYSPRT( L04,1,SYSPRM,0 ) 05520 CALL SYSPRT( HDLINX,1,SYSPRM,0 ) 055301 05540 CALL CCSMVA( HDLINX,1,0,HDLINX,1,132 ) 05550 GO TO IRTN 055601 05570C ..PRINT 'END OF REPORT' LINE 05580 970 CALL CCSMVA (EORMSG, 1, 21, HDLINX, 59, 21) 05590 CALL SYSPRT( L04,5,SYSPRM,0 ) 05600 CALL SYSPRT( HDLINX,1,SYSPRM,0 ) 05610 GO TO IRTN 056201 05630C ..SUM COLLECTOR'S CODES(2 WD ARITMETIC MODULO 10**4) 05640 980 COLSUM(ICOLX) = 0 05650 COLSUL(ICOLX) = 0 05660 DO 982 I2 = 1,NOCODE 05670 COLSUL(ICOLX) = COLSUL(ICOLX) + COUNT(ICOLX,I2) 05680 IF (COLSUL(ICOLX) .LT. 10000) GO TO 982 05690 COLSUM(ICOLX) = COLSUM(ICOLX) + 1 05700 COLSUL(ICOLX) = COLSUL(ICOLX)-10000 05710 982 CONTINUE 05720 GO TO IRTN 057301 05740C ..CONVERT 'IVAL' TO 'ASCII' WITH ZERO SUPPRESSION 05750 990 CONTINUE 05760 CALL HXDEC( IVAM,MTOT(2) ) 05770 CALL HXDEC( IVAL,LTOT(4) ) 057801 05790 CALL CCSADD( MTOT,4,LTOT,1,TOT14,1 ) 05800 CALL EDIT ( TOT14,6,TEMP,1,3 ) 05810 CALL CCSMVA( TEMP,2,6,IASCII,1,6 ) 058201 05830 GO TO IRTN2 058401 05850C**** ERROR SECTION FILE 1 05860 9800 CONTINUE 05870 IREQ = AND(REQ1(4),$FF) 05880 IF (IREQ.LT.11) IREQ = IREQ-1 05890 IF (IREQ.EQ.18) IREQ = 10 05900 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 05910 CALL CCSMVA( DAT1,1,8,L14,32,8 ) 05920 IERR = 1 05930 GO TO 9900 059401 05950C**** ERROR SECTION FILE 3 05960 9820 CONTINUE 05970 CALL CCSMVA( UTFILE,1,8,L14,32,8 ) 05980 IERR = 1 05990 GO TO 9900 060001 06010C**** CLOSE THE FILES AND EXIT........ 06020 9900 CONTINUE 06030 IF (IERR.EQ.1) CALL SYSPRT( L14,1,SYSPRM,0 ) 060401 06050 CALL CLOSFL( REQ1,ISTAT ) 06060 CALL GETUTI( UTKEY,REC1,IFOUND,IFER,2 ) 06070 CALL SYSPRT( L04,0,SYSPRM,1 ) 060801 06090 CALL PGMOUT 06100 END 06110 END/ 00040DAYS DCK/ I=13,H 00010DAYS HOL/ 00020 SUBROUTINE DAYS( BUF1,BYT1,BUF2,BYT2,ASCDAY,DCALC ) 00010 + /CALCULATE DAYS DIFFERENCE FOR TWO DATES (RWE) 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 01/13/84 ************ PROGRAMMER : RWE 000901 00100C**** THIS SUBROUTINE WILL CALCULATE THE NUMBER OF DAYS DIFFERENCE 00110C**** FOR TWO DATES. 001201 00130C**** PARAMETERS... 00140C**** 00150C**** BUF1 - BUFFER CONTAINING THE FIRST DATE (PAST DATE) 00160C**** BYT1 - CHARACTER INDEX OF DATE STARTING POSITION IN BUF1 00170C**** BUF2 - BUFFER CONTAINING THE SECOND DATE (LATEST DATE) 00180C**** BYT2 - CHARACTER INDEX OF DATE STARTING POSITION IN BUF2 00190C**** ASCDAY- 3 WORD BUFFER TO RECEIVE # OF DAYS IN ASCII 00200C**** ZERO FILLED RIGHT ADJUSTED. 00210C**** DCALC- FLAG FOR # OF DAYS DIFFERENCE CALCULATION 00220C**** 0 = TOTAL DAYS DIFFERENCE 00230C**** NOT 0 = TOTAL WEEKDAYS DIFFERENCE - NO WEEKEND DAYS 002402 00250 INTEGER BUF1(1),BYT1,BUF2(1),BYT2,ASCDAY(3),DCALC 00260 1, DATE1(3),DATE2(3),DELTA,T1,T2,T3,NDAYS 00270 2, INYR1,INMO1,INDY1,IDYYR1,IDYWK1 00280 3, INYR2,INMO2,INDY2,IDYYR2,IDYWK2 002901 00300 REAL DYCT1,DYCT2 003102 00320C****** START PROGRAM 003301 00340 NDAYS = 0 003501 00360C**** GET FIRST DATE & DO CALC 00370 CALL CCSMVA(BUF1,BYT1,06,DATE1,01,06) 00380 IF ( IDATVR( DATE1, 1 ) .LT. 0 ) GO TO 200 00390C 00400 INMO1 = ICCSAD(DATE1(1)) 00410 INDY1 = ICCSAD(DATE1(2)) 00420 INYR1 = ICCSAD(DATE1(3)) 004301 00440 CALL YMD1 (INYR1,INMO1,INDY1,DYCT1,IDYYR1,IDYWK1) 004501 00460C**** GET SECOND DATE & DO CALC 00470 CALL CCSMVA(BUF2,BYT2,06,DATE2,01,06) 00480 IF ( IDATVR( DATE2, 1 ) .LT. 0 ) GO TO 200 00490C 00500 INMO2 = ICCSAD(DATE2(1)) 00510 INDY2 = ICCSAD(DATE2(2)) 00520 INYR2 = ICCSAD(DATE2(3)) 005301 00540 CALL YMD1 (INYR2,INMO2,INDY2,DYCT2,IDYYR2,IDYWK2) 005502 00560C******* CALCULATE DAYS DIFFERENCE 005701 00580 DELTA = DYCT2 - DYCT1 00590 T1 = DELTA/7 00600 T2 = DELTA - ( T1 * 7 ) 00610 T2 = T2+IDYWK1 00620 IF( DCALC.EQ.2 .AND. IDYWK1.GE.6 ) T2 = T2+1 00630 T3 = 0 00640 DO 150 IL = IDYWK1,T2 00650 IF (IL.EQ.06. OR .IL.EQ.07) T3=T3+1 00660 150 CONTINUE 00670 NDAYS = DELTA - ( T1*2 )-T3 00680 IF ( DCALC .EQ. 0 ) NDAYS = DYCT2 - DYCT1 00690C*** IF ( NDAYS .LT. 0 ) NDAYS = 0 007001 00710C**** NOW CONVERT DAYS TO ASCII 007201 00730 200 CALL HXDEC(NDAYS,ASCDAY) 007401 00750 RETURN 00760 END 00770 END/ 00040FIXINA DCK/ I=13,H 00010FIXINA HOL/ 00020 PROGRAM FIXINA 00010 1 /FIX INACCT FILE (NYGSBC) 10/81. LKL07 01/84 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 12/21/83 ************ PROGRAMMER : RWE 000901 00100C*** REBUILD INACCT FILE : 00110C FIRST CLEAR THE INACCT FILE THEN 00120C READ THE DELQMST FILE AND CREATE A NEW 00130C RECORD FOR EVERY INACTIVE ACCOUNT AND STORE 00140C IT IN THE INACCT FILE. IF THE DATE THE ACCT. 00150C WENT INACTIVE IS INVALID THEN USE TODAYS DATE. 001601 00170 EXTERNAL FMRDEL,FMEOFC 00180 INTEGER FMRDEL,FDEL,FMEOFC,FEOF 001901 00200 INTEGER DLQREC(11004),DLQREQ(24),DDATA(15),DATE(6),KEY(15) 00210 +, INAREC(292),INAREQ(24),IDATA(15),IDUSER(4),FREQ 00220 +, RSWCT(3), RSW(3),DST,IST,EOF,STATCD,DQ(4),LA(4) 00230 +, MSBCT(3), MSG(8) 002401 00250 EQUIVALENCE ( DLQREQ(15), NUMREC ) 002601 00270 DATA RSW/$0052,$0053,$0057/, RSWCT/3*0/,DQ/'DELQMST '/ 00280 +, DLQREQ, INAREQ/48*0/,LA/'LA '/,EOF/0/ 00290 +, DDATA/'LADLQMST',' ',4*$2020,0,11,0/ 00300 +, IDATA/'LAINACCT',' ',4*$2020,0,1,-1/ 00310 +, MSBCT/ 3*0/, MSG/$0D0A,' X - '/ 003202 00330C**** BEGIN REBIULD OF THE INACCT FILE ....... 003401 00350 ASSEM $C000,FMRDEL,$6800,FDEL 00360 ASSEM $C000,FMEOFC,$6800,FEOF 003701 00380 CALL PGMIN(IDUSER,LUNIT,IMODE,NOPORT) 00390 CALL CCSCST(IDUSER,1,8,LA,1,8,ICM) 00400 IF(ICM.EQ.0) GO TO 5 00410 CALL CCSMVA(DQ,1,8,DDATA,1,8) 00420 CALL CCSMVA(IDATA,3,6,IDATA,1,8) 00430 5 CONTINUE 00440 ASSIGN 9000 TO IABORT 00450 CALL PGMINT(IABORT,KK) 004601 00470C*** FIRST PICK UP THE SYSTEM DATE. 00480 CALL UTHEAD( DLQREC, DATE ) 004901 00500 FREQ=1 00510 CALL CLEAR(INAREQ,IDATA,ISTAT) 00520 IF(ISTAT.LT.0)GO TO 7100 00530 DO 50 IZ=1,24 00540 50 INAREQ(IZ)=0 00550 FREQ = 3 00560 CALL OPENFL(INAREQ,IDATA,ISTAT) 00570 IF (ISTAT .LT. 0) GOTO 7100 00580 CALL OPENFL(DLQREQ,DDATA,ISTAT) 00590 IF (ISTAT .LT. 0) GOTO 7000 00600 DLQREQ(23) = 1 00610 CALL LOKFIL(DLQREQ,JSTAT) 006201 00630 100 CONTINUE 00640 CALL GETS(DLQREQ,DLQREC,KEY ,ISTAT) 00650 IF(AND(ISTAT,$8100).EQ.$8100) GO TO 9000 00660 IF (AND(ISTAT,$0100) .EQ. $0100) EOF = 1 00670 IF (AND(ISTAT,$0100) .EQ. $0100) GO TO 150 00680 FREQ = 14 00690 IF (ISTAT .LT. 0) GOTO 7000 007001 00710 150 CONTINUE 00720 INRECS = 0 00730 DO 500 LOOP = 1,NUMREC 00740 DST = 1000*LOOP-999 00750 IF (DLQREC(DST) .EQ. FDEL) GO TO 500 00760 IF (DLQREC(DST) .EQ. FEOF) GO TO 500 007701 00780 CALL CCSGET(DLQREC(DST),306,STATCD) 007901 00800C CHECK STATUS CODE FOR R,S, OR W 00810 DO 200 I = 1,3 00820 IF (STATCD .EQ. RSW(I)) GOTO 300 00830 200 CONTINUE 00840 GOTO 500 00850 300 CONTINUE 00860 INRECS=INRECS+1 00870 IST = 12*INRECS-11 008801 00890 RSWCT(I) = RSWCT(I)+1 009001 00910C*** MSB MODULO 30,000 FOR DOUBLE PRECISION 00920 IF ( RSWCT(I).LT.30000 ) GO TO 310 00930 RSWCT(I) = 0 00940 MSBCT(I) = MSBCT(I) + 1 00950 310 CONTINUE 009601 00970 CALL CCSBLK(INAREC(IST),24) 00980 CALL CCSMVA(DLQREC(DST),1,16,INAREC(IST),1,16) 00990 CALL CCSPUT(STATCD,17,INAREC(IST)) 01000 CALL CCSPUT( $50 ,18,INAREC(IST)) 01010 CALL CCSMVA(DLQREC(DST),857,6,INAREC(IST),19,6) 010201 01030C**** VERIFY DATE ACCOUNT LAST UPDATED FROM HOST 01040 IOK = IDATVR( DLQREC(DST), 857 ) 01050 IF ( IOK.LT.0 ) CALL CCSMVA(DATE,1,6,INAREC(IST),19,6) 01060 IF ( IOK.LT.0 ) CALL CCSMVA(DATE,1,6,DLQREC(DST),857,6) 010701 01080 500 CONTINUE 01090 IF (INRECS.EQ.0)GO TO 550 01100 CALL PUTS(INAREQ,INAREC,INRECS,ISTAT) 01110 FREQ = 11 01120 IF (ISTAT.LT.0) GO TO 7100 01130 550 CONTINUE 01140 IF(JSTAT.LT.0) GO TO 560 01150 CALL UPDREC(DLQREQ,DLQREC,ISTAT) 01160 IF (ISTAT.GE.0) GO TO 560 01170 FREQ = 15 01180 GO TO 7000 011901 01200 560 CONTINUE 01210 IF (EOF.EQ.1)GO TO 9000 01220 GO TO 100 012301 01240C**** ERROR REPORTING......... 01250 7000 CONTINUE 01260 CALL FILERR(DDATA,FREQ,ISTAT,LUNIT) 01270 GOTO 9500 01280 7100 CONTINUE 01290 CALL FILERR(IDATA,FREQ,ISTAT,LUNIT) 01300 GOTO 9500 013101 01320C**** DISPLAY TOTALS AND THEN END..... 013301 01340 9000 CONTINUE 01350 DO 9050 I = 1,3 013601 01370 CALL CCSPUT( RSW(I), 4, MSG ) 01380 CALL HXDEC ( RSWCT(I), MSG(5)) 01390 IF ( MSBCT(I).EQ.0 ) GO TO 9010 01400 MSG(5) = $2030 + MSBCT(I)*3 + AND( MSG(5), $F ) 01410 9010 CONTINUE 01420 CALL WTREAD(05,-1,MSG,16,0,0,0,ITC) 01430 9050 CONTINUE 01440 CALL WTREAD(05,-1,MSG,02,0,0,0,ITC) 014501 01460 9500 CONTINUE 01470 CALL CLOSFL(DLQREQ,ISTAT) 01480 CALL CLOSFL(INAREQ,ISTAT) 01490 CALL PGMOUT 01500 END 01510 END/ 00040QCST DCK/ I=13,H 00010QCST HOL/ 00020 SUBROUTINE QCST(TS,S1,P1,L1,S2,P2,L2,COMPIN) 00010 1 /C56 F CCS CCS 3.1 .PSRD 03/83 SL-173 00020C 00030C COMPARE STRING ONE WITH STRING TWO; INDICATE WHETHER STRING ONE 00040C IS LESS-THAN, EQUAL-TO, OR GREATER-THAN STRING TWO. 00050C 00060C TS: TYPE OF STRINGS -- 00070C N = NUMERIC, T = TOTAL; ALL OTHERS CONSIDERED ALPHANUMERIC. 00080C IF EITHER STRING HAS LENGTH ZERO, BOTH STRINGS ARE ASSUMED 00090C TO BE ALPHANUMERIC. 00100C 00110C S1: ARRAY CONTAINING STRING ONE 00120C P1: STARTING BYTE NUMBER OF STRING ONE 00130C L1: NUMBER OF BYTES IN STRING ONE 00140C 00150C S2: ARRAY CONTAINING STRING TWO 00160C P2: STARTING BYTE NUMBER OF STRING TWO 00170C L2: NUMBER OF BYTES IN STRING TWO 00180C 00190C COMPIN: COMPARE INDICATOR -- 00200C <0 STRING ONE IS LESS-THAN STRING TWO 00210C =0 STRING ONE EQUALS STRING TWO 00220C >0 STRING ONE IS GREATER-THAN STRING TWO 00230C 00240C 00250 INTEGER TS,S1,P1,L1,S2,P2,L2,COMPIN 00260 1 , DIGIT1, DIGIT2 00270 2 , SMAP(10), DMAP(10) 00280C 00290 DATA SMAP/$7D, $4A, $4B, $4C, $4D, $4E, $4F, $50, $51, $52/ 00300 DATA DMAP/$30, $31, $32, $33, $34, $35, $36, $37, $38, $39/ 00310C 00320C--- IF STRING TYPE IS ALPHA, JUST DO STRAIGHT COMPARE. 00330 IF(.NOT.(TS.EQ.$4E.OR.TS.EQ.$54)) GO TO 110 00340C 00350C--- SEE IF EITHER STRING HAS LENGTH ZERO. 00360 IF(L1.EQ.0.OR.L2.EQ.0) GO TO 110 00370C 00380C--- COMPUTE BYTE INDEX TO LAST DIGIT OF EACH STRING. 00390 LAST1 = P1 + L1 - 1 00400 LAST2 = P2 + L2 - 1 00410C 00420C--- FETCH LAST DIGIT OF EACH STRING. 00430 CALL CCSGET(S1,LAST1,DIGIT1) 00440 CALL CCSGET(S2,LAST2,DIGIT2) 00450C 00460C--- SEE IF STRING ONE IS NON-NEGATIVE. 00470 IF(DIGIT1.LT.$41 .OR. DIGIT1.GT.$49) GO TO 45 00471 DIGIT1 = DIGIT1 - $10 00472 CALL CCSPUT(DIGIT1,LAST1,S1) 00473 45 CONTINUE 00474 IF(DIGIT1.GE.$30.AND.DIGIT1.LE.$39) GO TO 100 00480C 00490C--- STRING ONE IS NEGATIVE; SEE IF STRING TWO IS NON-NEGATIVE. 00500 IF(DIGIT2.GE.$30.AND.DIGIT2.LE.$39) GO TO 200 00510C 00520C--- BOTH STRINGS ARE NEGATIVE; MAKE THEM POSITIVE. 00530 DO 50 I = 1,10 00540 IF(DIGIT1.EQ.SMAP(I)) CALL CCSPUT(DMAP(I),LAST1,S1) 00550 IF(DIGIT2.EQ.SMAP(I)) CALL CCSPUT(DMAP(I),LAST2,S2) 00560 50 CONTINUE 00570C 00580C--- NOW COMPARE THESE POSITIVE STRINGS. 00590 CALL CCSCST(S1,P1,L1,S2,P2,L2,COMPIN) 00600C 00610C--- COMPLEMENT THE COMPARISON INDICATOR IF IT IS NON-ZERO. 00620 IF(COMPIN.NE.0) COMPIN = -COMPIN 00630C 00640C--- RESTORE LAST DIGIT OF EACH STRING, THEREBY MAKING THEM NEGATIVE. 00650 CALL CCSPUT(DIGIT1,LAST1,S1) 00660 CALL CCSPUT(DIGIT2,LAST2,S2) 00670 GO TO 30000 00680C 00690C--- STRING ONE IS NON-NEGATIVE; SEE IF STRING TWO IS NON-NEGATIVE. 00700 100 CONTINUE 00710 IF(DIGIT2.LT.$41 .OR. DIGIT2.GT.$49) GO TO 105 00711 DIGIT2 = DIGIT2 - $10 00712 CALL CCSPUT(DIGIT2,LAST2,S2) 00713 105 CONTINUE 00714 IF(DIGIT2.GE.$30.AND.DIGIT2.LE.$39) GO TO 110 00720C 00730C--- STRING ONE IS GREATER-THAN STRING TWO. 00740 COMPIN = 1 00750 GO TO 30000 00760C 00770C--- BOTH STRINGS ARE NON-NEGATIVE. 00780 110 CONTINUE 00790 CALL CCSCST(S1,P1,L1,S2,P2,L2,COMPIN) 00800 GO TO 30000 00810C 00820C--- STRING ONE IS LESS-THAN STRING TWO. 00830 200 CONTINUE 00840 COMPIN = -1 00850C 00860C 0087030000 RETURN 00880 END 00890 END/ 00040REALN DCK/ I=13,H 00010REALN HOL/ 00020 SUBROUTINE REALN ( INBF, NCH, ROUT, I2WRD ) 00010 1 /CONVERT ASCII TO REAL - 2 WORD INTEGER SL-*** 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 06/03/83 ************ PROGRAMMER : RWE 000901 00100 INTEGER INBF(1),I2WRD(1),R9SW,RPGSW 00110 DOUBLE PRECISION IDBL,JWK,JXP,J,J10,R2 00120 DATA R9SW /$E3/ 001301 00140C**** CLEAR FTN SCRATCH - DUE TO FTN BUG. 06/83 00150C** 00160C** ENA 0 / STA $C9 00170 ASSEM $0A00, $60C9 00180C*** LDQ LDA STA 00190 ASSEM $E400,+R9SW,$C622,$6400,+RPGSW 002001 00210 J = 0 00220 J10 = 10 00230 ROUT = 0.0 00240 IDBL = 0 00250 DO 100 I = NCH, 1, -1 00260 CALL CCSGET (INBF, I, IWK) 00270 IWK = AND (IWK, $F) 00280 JWK = IWK 00290 JXP = J10**J 00300 IDBL = (JWK * JXP) + IDBL 00310 J = J + 1 00320 100 CONTINUE 00330 ROUT = IDBL 00340 I2WRD(1) = 0 00350 I2WRD(2) = 0 00360 RTMP = ROUT 00370 200 IF ( RTMP.LT.32768.0 ) GOTO 300 00380 IDIV = RTMP/32767.0 00390 I2WRD(1) = IDIV 00400 R2 = IDIV*32767.0 00410 RTMP = RTMP - R2 00420 300 CONTINUE 00430 I2WRD(2) = RTMP 004401 00450C**** RESTORE RPG EXTERNAL SWITCH SETTINGS !! 004601 00470 ASSEM $C400,+RPGSW,$E400,+R9SW,$6622 004801 00490 RETURN 00500 END 00510 END/ 00040RSWCHG DCK/ I=13,H 00010RSWCHG HOL/ 00020 PROGRAM RSWCHG 00010 1 /XXX F CCS CCS3.0 .LA LKL07 SL-XXX 000201 00030C THIS PROGRAM IS TO CHECK EVERY RECORD IN THE TRANSACTION FILE 00040C FOR ANY CHANGE OF AN ACCOUNT'S STATUS CODE. FOR THOSE ACCOUNTS 00050C WHOSE STATUS CODES ARE CHANGED, THE DELQMST RECORD IS UPDATED 00060C WITH THE SYSTEM DATE IN LAST HOST UPDATE FIELD. 00070C 00080C THE SCAN OF THE TRANSACTION FILE WILL LOOK FOR NON-FINANCIAL 00090C UPDATE RECORDS (TYPE = '02') AND CHECK FOR UPDATE CODES MATCH- 00100C ING THE CODE ASSIGNED TO STATUS CODE ON THE SUPERVISOR'S 00110C CHANGE SCREEN. THE UPDATE CODE FOR STATUS CODE CHANGES IS 00120C DETERMINED VIA THE SYSTEM MODULE 'GETCHF' (IN PROGRAM LIBRARY 00130C IN RELOCATABLE FORM). THIS ROUTINE HAS THE FOLLOWING CALLING 00140C SEQUENCE: 00150C CALL GETCHF(SCREEN,XXXCHG) 00160C WHERE 00170C SCREEN = CHANGE SCREEN TEMPLATE RETRIEVED FROM THE SCREEN 00180C FILE ('SCRNFILE'). 00190C XXXCHG = IS A 3*N+1 ARRAY WHERE N IS THE MAXIMUM NUMBER OF 00200C ITEMS THAT CAN APPEAR ON THE CHANGE SCREEN. INI- 00210C TIALLY, XXXCHG MUST BE SET AS FOLLOWS: 00220C WORD 1 = -N 00230C ALL OTHER WORDS ARE TO BE SET TO ZERO. 00240C ON RETURN, XXXCHG HAS THE FOLLOWING MEANING: 00250C WORD 1 = N 00260C WITH REMAINING WORDS GROUPED INTO THREES: 00270C WORD 1 = X-Y POSITION OF CHANGE FIELD ON 00280C SCREEN. 00290C WORD 2 = LENGTH OF CHANGE ITEM (BITS 15 THR 00300C 4) AND FIELD TYPE (BITS 3 THRU 0) 00310C WORD 3 = STARTING POSITION IN FILE RECORD. 00320C THE THREE WORDS DESCRIBING CHANGE ITEM 'XX' (THE NUMBER 00330C KEYED TO CHANGE THE FIELD) ON THE CHANGE SCREEN IS FOUND 00340C IN THE FOLLOWING WORDS IN XXXCHG: 00350C WORD 3* 'XX' -1 = X-Y POSITION. 00360C 3* 'XX' = LENGTH AND FIELD TYPE. 00370C 3* 'XX' +1 = FILE POSITION. 00380C TO OBTAIN THE UPDATE CODE USED TO REPORT ANY TRANSACTION TO 00390C THE TRANSACTION FILE, TAKE THE ITEM NUMBER ASSIGNED TO THE 00400C FIELD ON THE CHANGE SCREEN AND ADD THE FOLLOWING BIAS 00410C (DEPENDENT ON SCREEN): 00420C SCREEN BIAS 00430C CUSTOMER CHANGE 0 00440C COSIGNER CHANGE 30 00450C SUPERVISOR CHANGE 60 00460C THE FOLLOWING RESTRICTIONS APPLY ON THE MAXIMUM NUMBER OF 00470C ITEMS (AND MAXIMUM ITEM NUMBER IN CASE OF NON-SEQUENTIAL NUM- 00480C BERING OF ITEMS ON CHANGE SCREEN) THAT CAN APPEAR ON THE 00490C CHANGE SCREENS: 00500C SCREEN MAX (N) 00510C CUSTOMER CHANGE 30 00520C COSIGNER CHANGE 30 00530C SPERVISOR CHANGE 20 005402 00550C FILE MANAGER REQUEST AND DATA BUFFERS. 005603 00570C SCREEN FILE. 005801 00590 INTEGER REQBFS(24) , IDATAS(15) , SRNREC(1002) 006001 00610 DATA REQBFS / 24*0 / 00620C FILE ACCESS BY KEY 1, ONE RECORD PER RETRIEVE AND NO LOCKING. 00630 DATA IDATAS / 'LASCNFIL' , 8*$2020 , 1 , 1 , 0 / 006402 00650C TRANSACTION FILE. 006601 00670 INTEGER REQBFT(24) , IDATAT(15) , TRNREC(03452) , TRECLN 00680C*NOTE: RECORD SIZE = 69 WORDS. SPACE ALLOCATED FOR 50- 02/83*** 006901 00700 DATA REQBFT / 24*0 / 00710C FILE ACCESS SEQUENTIAL BY RELATIVE RECORD NUMBER, 50 RECORDS 00720C PER RETRIEVE AND NO LOCKING. 00730 DATA IDATAT / 'LATRNSFL' , 8*$2020 , 0 , 50, 0 / 00740C RECORD LENGTH = 69 WORDS. 00750 DATA TRECLN / 69 / 007602 00770C*************************************************** RSWFIL MODS 9/80 ** 00780 INTEGER DEQREQ(24),DEQDAT(15),DEQREC(1004),KEY1(9),WRSB(2) 00790 INTEGER ACCREQ(24),ACCDAT(15),ACCREC(44),A99X(2,3),A999(2) 00800 INTEGER RSWREQ(24),RSWDAT(15),RSWREC(44),A998(2),A997(2) 008101 00820 EQUIVALENCE (A997(1),A99X(1,1)),(A998(1),A99X(1,2)) , 00830 + (A999(1),A99X(1,3)),(ACCREC(1),RSWREC(1)) 00840 DATA WRSB / 'WRS ' / , A997 /'997 '/ , A998 /'998 '/ ,A999/'999 '/ 00850 DATA DEQREQ/24*0/,DEQDAT/'LADLQMST ',1,1,0/ 00860 DATA ACCREQ/24*0/,ACCDAT/'LAACCAGE ',1,1,0/ 00870 DATA RSWREQ/24*0/,RSWDAT/'LARSWFIL ',0,1,0/ 008801 00890 INTEGER SCNDAT(4),DLQDAT(4) 00900 DATA SCNDAT/'SCRNFILE'/,DLQDAT/'DELQMST '/ 00910C 00920C 00930C*************************************************** ---------------- ** 009403 00950C SUPERVISOR SCREEN NUMBER. 00960 INTEGER SUPSCN 00970 DATA SUPSCN / 35 / 009801 00990C SUPERVISOR SCREEN CHANGE ITEM DESCRIPTION ARRAY. 01000 INTEGER SUPCHG(61) 01010 DATA SUPCHG / -20 , 60*0 / 010201 01030C STATUS CODE FILE POSITION IN MASTER FILE. 01040 INTEGER STCDFP 01050 DATA STCDFP / 306 / 010601 01070C NON-FINANCIAL RECORD TYPE CODE. 01080 INTEGER NFUPCD 01090 DATA NFUPCD / '02' / 011001 01110C BIAS FOR TRANSACTIONS FROM SUPERVISOR CHANGE SCREEN. 01120 INTEGER SUPBAS 01130 DATA SUPBAS / 60 / 011401 01150C STARTING WORD POSITION (RELATIVE TO WORD 1) IN TRANSACTION 01160C FILE FOR RECORD TYPE AND UPDATE CODE. 01170 INTEGER RECTYP , UPDCOD 01180 DATA RECTYP / 14 / , UPDCOD / 15 / 01190C STARTING BYTE POSITION IN TRANSACTION FILE RECORD FOR NEW DATA 01200C ON NON-FINANCIAL UPDATE TRANSACTIONS. 01210 INTEGER NEWDAT 01220 DATA NEWDAT / 33 / 012301 01240C FIELD POSITIONS INACTIVE ACCOUNTS FILE FOR 01250C STATUS CODE AND DATE. 01260 INTEGER STATPS, DATPOS 01270 DATA STATPS / 17 /, DATPOS / 19 / 012801 01290C NUMERIC CONSTANTS. 01300 INTEGER ZERO , ONE , TWO , SIX , NUMLEN 01310 DATA ZERO / 0 / , ONE / 1 / , TWO / 2 / , SIX / 6 / , 01320 1 NUMLEN / 16 / 013301 01340C FILE MANAGER STATUS CONIDERATIONS ON RETRIEVES. 01350 INTEGER EOF , WRONKY 01360 DATA EOF / $100 / , WRONKY / $200 / 013701 01380C DUMMY VARIABLE. 01390 INTEGER DUMMY 014001 01410C CONSOLE MESSAGE FOR STATUS CODE NOT FOUND ON SUPERVISOR 01420C SCREEN. 01430 INTEGER XYN , NOSTAT(29) , MESLEN 01440 DATA XYN / -1 / 01450 DATA NOSTAT / 'ERROR - STATUS CODE NOT FOUND ON SUPERVISOR CHANGE 01460 1SCREEN.' / 01470 DATA MESLEN / 58 / 014803 01490C EQUIVALENCES FOR NUMBER OF RECORDS RETRIEVED PER 'GETS' 01500C REQUESTS FROM TRANSACTION FILE, MAXIMUM NUMBER OF RECORDS TO 01510C RETRIEVE, AND NUMBER OF ITEMS ON SUPERVISOR CHANGE SCREEN. 01520 INTEGER NUMREC , MAXREC , NITEM 01530 EQUIVALENCE ( NUMREC , REQBFT(15) ) , ( MAXREC , IDATAT(14) ) , 01540 1 ( NITEM , SUPCHG(1) ) 015503 01560C OTHER DECLARATIONS. 01570 INTEGER ID(4) , TUPCOD , DATE(3) , AMONTO , ADAYTO , AYERTO 01580 EXTERNAL AMONTO , ADAYTO , AYERTO 01590. 01600C RETRIEVE SYSTEM DATE. 01610 DATE(1) = AND($FFFF,AMONTO) 01620 DATE(2) = AND($FFFF,ADAYTO) 01630 DATE(3) = AND($FFFF,AYERTO) 016403 01650C CCS LOGIN. PROGRAM USAGE RESTRICTED TO MASTER CONSOLE. EXIT 01660C IF USER NOT ON MASTER CONSOLE. 01670 100 CALL PGMIN(ID,LU,I,J) 01680 IF(J.NE.0) GO TO 900 01690 CALL CCSCST(IDATAT,1,2,ID,1,8,ICM) 01700 IF(ICM.EQ.0) GO TO 105 01710 CALL CCSMVA(SCNDAT,1,8,IDATAS,1,8) 01720 CALL CCSMVA(DLQDAT,1,8,DEQDAT,1,8) 01730 CALL CCSMVA(IDATAT,3,6,IDATAT,1,8) 01740 CALL CCSMVA(ACCDAT,3,6,ACCDAT,1,8) 01750 CALL CCSMVA(RSWDAT,3,6,RSWDAT,1,8) 01760 105 CONTINUE 017701 01780C LOGIN VERIFIED. OPEN SCREEN FILE AND RETRIEVE SUPERVISOR 01790C SCREEN TEMPLATE. 01800 CALL OPENFL(REQBFS,IDATAS,ISTAT) 01810C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF ERROR. 01820 IF(ISTAT.LT.0) GO TO 300 01830C NO ERROR, RETRIEVE TEMPLATE. 01840 CALL READR(REQBFS,SRNREC,SUPSCN,ISTAT) 01850C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF ERROR. 01860 IF(ISTAT.LT.0 .OR. AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 310 01870C NO ERROR, CLOSE FILE AND RETRIEVE SUPERVISOR CHANGE SCREEN 01880C ITEM FIELD DESCRIPTIONS. 01890 CALL CLOSFL(REQBFS,ISTAT) 019001 01910 CALL GETCHF(SRNREC,SUPCHG) 019202 01930C SCAN 'SUPCHG' ARRAY CHECKING EVERY THIRD WORD (FILE POSITION 01940C OF CHANGE ITEM) STARTING WITH WORD FOUR FOR MATCH WITH START- 01950C ING POSITION OF STATUS CODE. 01960 DO 120 I=1,NITEM 01970C CALCULATE POINTER TO NEXT WORD CONTAINING FILE POSITION. 01980 J = 3*I + 1 01990C CHECK FOR MATCH WITH STATUS CODE POSITION. CONTINUE TO NEXT 02000C FIELD IF NO MATCH. 02010 IF(SUPCHG(J).NE.STCDFP) GO TO 120 020201 02030C MATCH FOUND. ADD BIAS TO CHANGE ITEM NUMBER AND CONVERT THAT 02040C NUMBER TO ASCII DECIMAL REPRESENTATION FOR CHECKING WITH 02050C TRANSACTION FILE RECORD FIELD 'TYPE UPDATE CODE'. 02060 TUPCOD = I + 60 02070 TUPCOD = (TUPCOD/10)*$100 + TUPCOD-( (TUPCOD/10)*10 ) + $3030 02080C GO SCAN TRANSACTION FILE. 02090 GO TO 200 021001 02110C CONTINUE SCAN OF 'SUPCHG' ARRAY. 02120 120 CONTINUE 021302 02140C STATUS CODE NOT FOUND ON SUPERVISOR SCREEN. EXIT PROGRAM 02150 GO TO 800 02160. 02170C PROCESS ALL RECORDS FROM TRANSACTION FILE AND FOR A CHANGE 02180C TO THE STATUS CODE ON AN ACCOUNT, IF FOUND CHANGE DATE LAST 02190C UPDATE FROM HOST TO SYSTEM DATE.(DATE ACCOUNT WENT INACTIVE) 022003 02210C OPEN TRANSACTION FILE AND INACTIVE ACCOUNTS FILE. 02220 200 CALL OPENFL(REQBFT,IDATAT,ISTAT) 02230C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF ERROR. 02240 IF(ISTAT.LT.0) GO TO 330 02250C*************************************************** RWSFIL MODS 9/80 ** 02260C 02270 CALL OPENFL(DEQREQ,DEQDAT,ISTAT) 02280 IF (ISTAT.GE.0)GO TO 201 02290 CALL FILERR(DEQDAT,3,ISTAT,LU) 02300 GO TO 800 02310 201 CALL OPENFL(ACCREQ,ACCDAT,ISTAT) 02320 IF (ISTAT.GE.0)GO TO 202 02330 CALL FILERR(ACCDAT,3,ISTAT,LU) 02340 GO TO 800 02350 202 CALL OPENFL(RSWREQ,RSWDAT,ISTAT) 02360 IF (ISTAT.GE.0)GO TO 203 02370 CALL FILERR(RSWDAT,3,ISTAT,LU) 02380 GO TO 800 02390 203 CONTINUE 02400C 02410C 02420C*************************************************** ---------------- ** 024301 02440C RETRIEVE NEXT BLOCK OF RECORDS FROM TRANSACTION FILE. 02450 210 CALL GETS(REQBFT,TRNREC,DUMMY,ISTAT) 02460C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF FATAL ERROR. 02470 IF(ISTAT.LT.0) GO TO 340 024801 02490C NO ERROR. LOOP THRU ALL RECORDS RETRIEVED (NUMBER RETRIEVED 02500C RETURNED IN WORD 15 OF REQUEST BUFFER). LOOK FOR TRANSACTIONS 02510C CHANGING AN ACCOUNT'S STATUS CODE. 02520 DO 220 I=1,NUMREC 02530C CALCULATE POINTER TO START WORD OF NEXT TRANSACTION RECORD. 02540 J = TRECLN*(I-1) + 1 025501 02560C BYPASS RECORD IF RECORD TYPE IS NOT '02'. (BYPASSES ALL COL- 02570C LECTOR ACTIVITIES). 02580 K = J + RECTYP 02590 IF(TRNREC(K).NE.NFUPCD) GO TO 220 02600C FOUND NON-FINANCIAL UPDATE RECORD. BYPASS IF CHANGE WAS NOT TO 02610C STATUS CODE OF ACCOUNT. 02620 K = J + UPDCOD 02630 IF(TRNREC(K).NE.TUPCOD) GO TO 220 02640C*************************************************** RSWFIL MODS 9/80 ** 026501 02660 500 CONTINUE 02670 CALL CCSMVA(TRNREC(J),1,16,KEY1,1,16) 02680 CALL READR (DEQREQ,DEQREC,KEY1,ISTAT) 02690 IF (AND(ISTAT,$300).NE.0 ) GO TO 215 02700 IF (ISTAT.GE.0)GO TO 520 02710 CALL FILERR(DEQDAT,13,ISTAT,LU) 02720 GO TO 800 02730 520 CONTINUE 02740 DO 530 KP=1,4 02750 CALL CCSCST(DEQREC,306,1,WRSB,KP,1,IC) 02760 IF (IC.EQ.0) GO TO (550,550,550,540),KP 02770 530 CONTINUE 02780 GO TO 215 027901 02800 540 CONTINUE 02810 CALL CCSMVA(DEQREC,1,16,ACCREC,1,82) 02820 CALL WRITER(ACCREQ,ACCREC,ACCREC,ISTAT) 02830 IF (ISTAT.GE.0.OR.AND(ISTAT,$10).EQ.$10)GO TO 215 02840 CALL FILERR(ACCDAT,12,ISTAT,LU) 02850 GO TO 800 02860C*** UPDATE DELQMST RECORD WITH SYSTEM DATE IN POS. 857 02870 550 CONTINUE 02880 CALL CCSMVA( DATE, 1, 6, DEQREC, 857, 6 ) 02890 CALL UPDREC( DEQREQ, DEQREC, ISTAT ) 02900 IF ( ISTAT.GE.0 ) GO TO 555 02910 CALL FILERR( DEQDAT, 15, ISTAT, LU ) 029201 02930 555 CALL CCSMVA(DEQREC,1,16,ACCREC,1,82) 02940 CALL READR (ACCREQ,ACCREC,ACCREC,ISTAT) 02950 IF (AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 215 02960 IF (ISTAT.GE.0)GO TO 560 02970 CALL FILERR(ACCDAT,13,ISTAT,LU) 02980 GO TO 800 02990 560 CONTINUE 03000 CALL DELREC(ACCREQ,ACCREC,ISTAT) 03010 IF(ISTAT.GE.0)GO TO 570 03020 CALL FILERR(ACCDAT,16,ISTAT,LU) 03030 GO TO 800 03040 570 ACCREC(1) = DEQREC(1) 03050C*** 03060C UPDATE PREVIOUS FEILDS 03070 CALL CCSMVA(ACCREC,17,4,ACCREC,21,4) 03080 CALL CCSMVA(ACCREC,35,3,ACCREC,38,3) 03090 CALL CCSMVA(ACCREC,41,9,ACCREC,50,9) 03100 CALL CCSMVA(ACCREC,59,9,ACCREC,68,9) 03110C*** 03120C NEW VALUES FROM MASTER RECORD 03130 CALL CCSMVA(DEQREC,271,4,ACCREC,17,4) 03140 CALL CCSMVA(A99X(1,KP),1,3,ACCREC,35,3) 03150 CALL CCSMVA(DEQREC,905,9,ACCREC,41,9) 03160 CALL CCSMVA(DEQREC,887,9,ACCREC,59,9) 03170 CALL CCSMVA(DEQREC,963,4,ACCREC,25,4) 03180 CALL CCSPUT(WRSB(KP),77,ACCREC) 03190C 03200 CALL PUTS (RSWREQ,ACCREC,ONE,ISTAT) 03210 IF (ISTAT.GE.0) GO TO 215 03220 CALL FILERR(RSWDAT,11,ISTAT,LU) 03230 GO TO 800 03240 215 CONTINUE 032501 03260C*************************************************** ---------------- ** 032701 03280C*** PSR 12/83 REMOVE CODE TO CREATE INACCT RECORD 032901 03300C*** INACCT FILE IS NOW HANDLED BY FIXINA WHICH SHOULD BE 03310C RUN BEFORE RUNNING MHUPDT. 033201 03330C*** CARDS DELETED HERE.... 033401 03350C PROCESS NEXT TRANSACTION. 03360 220 CONTINUE 033703 03380C ALL TRANSACTIONS FROM THIS BLOCK PROCESSED. CHECK IF THIS IS 03390C THE LAST BLOCK FROM TRANSACTION FILE. IF NOT, GET NEXT BLOCK. 03400 IF(NUMREC.GE.MAXREC) GO TO 210 034101 03420C LAST BLOCK PROCESSED. ALL TRANSACTIONS FROM TRANSACTION FILE 03430C HAVE BEEN CHECKED. CLOSE ALL FILES AND EXIT. 03440 GO TO 800 03450. 03460C*********************************************************************** 03470C FILE ERROR PROCESSING ROUTINES. * 03480C*********************************************************************** 034903 03500C FILE ERROR USING 'SCRNFILE'. 035102 03520C OPEN FILE REQUEST. 03530 300 J = 3 03540 GO TO 320 035501 03560C READR REQUEST. 03570 310 J = 13 035801 03590C REPORT ERROR, CLOSE ALL FILES AND EXIT. 03600 320 CALL FILERR(IDATAS,J,ISTAT,LU) 03610 GO TO 800 036203 03630C FILE ERROR USING 'TRNSFL'. 036402 03650C OPEN FILE REQUEST. 03660 330 J = 3 03670 GO TO 350 036801 03690C GETS REQUEST. CHECK FOR END-OF-FILE INDICATING ALL TRANS- 03700C ACTIONS HAVE BEEN PROCESSED AND JOB IS COMPLETE. IF END- 03710C OF-FILE, CLOSE ALL FILES AND EXIT. 03720 340 IF(AND(ISTAT,EOF).EQ.EOF) GO TO 800 03730C NO END-OF-FILE, FATAL ERROR. 03740 J = 14 037501 03760C REPORT ERROR, CLOSE ALL FILES AND EXIT. 03770 350 CALL FILERR(IDATAT,J,ISTAT,LU) 03780 GO TO 800 037903 03800C*** PSR 12/83 CARDS DELETED HERE..... 03810. 03820C EXIT SECTION. CLOSE ALL FILES 038302 03840C 'SCRNFILE'. 03850 800 CALL CLOSFL(REQBFS,ISTAT) 03860C*************************************************** RSWFIL MODS 9/80 ** 03870C 'DELQMST' 03880 CALL CLOSFL(DEQREQ,ISTAT) 03890C 'ACCAGE' 03900 CALL CLOSFL(ACCREQ,ISTAT) 03910C 'RSWFIL' 03920 CALL CLOSFL(RSWREQ,ISTAT) 03930C 03940C*************************************************** ---------------- ** 03950C 'TRNSFL'. 03960 CALL CLOSFL(REQBFT,ISTAT) 03970C*** PSR 12/83 CARD DELETED HERE..... 039802 03990C RETURN CONTROL TO CCS EXECUTIVE. 04000 900 CALL PGMOUT 040101 04020 END 04030 END/ 00040SRREQ DCK/ I=13,H 00010SRREQ HOL/ 00020 PROGRAM SRREQ 00010 1 /XXX F CCS CCS 3.0 .LA PSR 02/83 SL-149 000201 00030C COPYRIGHT CONTROL DATA CORPORATION 00040C CYBERCREDIT SYSTEM 00050C 000601 00070C THIS PROGRAM HANDLES THE SUPERVISOR REQUESTS INSTEAD OF IN 00080C TIMUSE. IT IS EXECUTED IN LD/M 000901 00100 INTEGER LU,MODE,ID(4),PORT 001101 00120 INTEGER IOBUF(41),XYN,TC,COMPIN,ISTAT 00130 DATA XYN/-1/ 001401 00150 INTEGER SR(2),BLANK(2),COID(2),SRID(2),ACTREC 00160 DATA SR/'SR '/,BLANK/' '/,ACTREC/'01'/ 001701 00180 INTEGER ERRMSG(50),ERRLEN 00190 DATA ERRLEN/100/ 00200 DATA ERRMSG / 00210 1 $D0A,'THE RECORD FOR COLLECTOR IS NOT IN THE UTILITY FI 00220 2LE',$D0A,'THIS SR REQUEST WILL NOT BE PROCESSED ',$D0A/ 002301 00240 INTEGER DDATA(15),TDATA(15),UDATA(15),NUMREC,MAXREC 00250 DATA DDATA/'LADLYWRK',8*$2020,0,1,0/ 00260 DATA TDATA/'LATRNSFL',8*$2020,0,10 ,0/ 00270 DATA UDATA/'LAUTIFIL',8*$2020,1,1,1/ 002801 00290 INTEGER DLYREQ(24),TRNREQ(24),UTIREQ(24) 00300 DATA DLYREQ/24*0/,TRNREQ/24*0/,UTIREQ/24*0/ 003101 00320 INTEGER DLYWRK(20),TRNREC(690),UTIREC(40) 00330 DATA DLYWRK/20*$2020/,TRNREC/690*$2020/,UTIREC/40*$2020/ 003401 00350C EQUIVALENCES FOR NUMBER OF RECORDS RETRIEVED PER 'GETS' 00360C REQUEST FROM TRANSACTION FILE AND MAXIMUM NUMBER OF RECORDS 00370C TO RETRIEVE 00380 EQUIVALENCE (NUMREC,TDATA(15)) 00390 EQUIVALENCE (MAXREC,TRNREQ(15)) 004001 00410 INTEGER AMONTO,ADAYTO,AYERTO,DATE(3) 00420 EXTERNAL AMONTO,ADAYTO,AYERTO 004301 00440C RETRIEVE SYSTEM DATE 00450 DATE(1) = AND($FFFF,AMONTO) 00460 DATE(2) = AND($FFFF,ADAYTO) 00470 DATE(3) = AND($FFFF,AYERTO) 004801 00490C BEGIN PROCESSING 005001 00510 CALL PGMIN(ID,LU,MODE,PORT) 00520 CALL CCSCST(DDATA,1,2,ID,1,8,ICM) 00530 IF(ICM.EQ.0) GO TO 5 00540 CALL CCSMVA(DDATA,3,6,DDATA,1,8) 00550 CALL CCSMVA(TDATA,3,6,TDATA,1,8) 00560 CALL CCSMVA(UDATA,3,6,UDATA,1,8) 00570 5 CONTINUE 005801 00590C OPEN FILES 00600 50 CALL OPENFL(UTIREQ,UDATA,ISTAT) 00610 IF(ISTAT.GE.0) GO TO 100 00620 CALL FILERR(UDATA,3,ISTAT,LU) 00630 GO TO 900 006401 00650 100 CALL OPENFL(TRNREQ,TDATA,ISTAT) 00660 IF(ISTAT.GE.0) GO TO 150 00670 CALL FILERR(TDATA,3,ISTAT,LU) 00680 GO TO 900 006901 00700C**** FIRST CLEAR THE DLYWRK FILE 007101 00720 150 CONTINUE 00730 CALL CLEAR(DLYREQ,DDATA,ISTAT) 00740 DO 151 I = 1,24 00750 151 DLYREQ(I) = 0 007601 00770 CALL OPENFL(DLYREQ,DDATA,ISTAT) 00780 IF(ISTAT.GE.0) GO TO 200 00790 CALL FILERR(DDATA,3,ISTAT,LU) 00800 GO TO 900 008101 00820C READ THE TRANSACTION FILE BLOCK 00830 200 CALL GETS(TRNREQ,TRNREC,TRNREC,ISTAT) 00840 IF(AND(ISTAT,$8100).EQ.$8100) GO TO 800 00850 IF(ISTAT.GE.0) GO TO 250 00860 CALL FILERR(TDATA,14,ISTAT,LU) 00870 GO TO 900 008801 00890C PROCESS THE BLOCK 00900 250 DO 700 I = 1, MAXREC 009101 00920 J = 138*I-137 009301 00940C SEE IF THIS WAS AN ACTION RECORD 00950 CALL CCSCST(TRNREC,J+28,2,ACTREC,1,2,COMPIN) 00960 IF(COMPIN.NE.0) GO TO 700 009701 00980C SEE IF IT WAS A SUPERVISOR REQUEST 00990 CALL CCSCST(TRNREC,J+36,2,SR,1,2,COMPIN) 01000 IF(COMPIN.NE.0) GO TO 700 010101 010201 01030C READ THE UTILITY FILE RECORD WITH COID TO GET SUPERVISOR 01040 260 CALL CCSMVA(TRNREC,J+16,4,COID,1,4) 01050 CALL READR(UTIREQ,UTIREC,COID,ISTAT) 01060 IF(AND(ISTAT,$100).EQ.$100.OR.ISTAT.EQ.$200) GO TO 300 01070 IF(ISTAT.GE.0) GO TO 270 01080 CALL FILERR(UDATA,13,ISTAT,LU) 01090 GO TO 800 011001 01110C FOUND RECORD LOOK FOR SUPERVISOR 01120 270 CALL CCSMVA(UTIREC, 37 ,4,SRID,1,4) 01130 CALL CCSCST(SRID,1,4,BLANK,1,4,COMPIN) 01140 IF(COMPIN.EQ.0) CALL CCSMVA(SR,1,4,SRID,1,4) 011501 01160C NOW BUILD DLYWRK FILE 01170 CALL CCSMVA(TRNREC,J,16,DLYWRK,1,16) 01180 CALL CCSMVA(SRID,1,4,DLYWRK,17,4) 01190 CALL CCSMVA(DATE,1,6,DLYWRK,21,6) 01200C IS COMPLETE WRITE IT AND GO GET NEXT RECORD 01210 CALL PUTS(DLYREQ,DLYWRK,1,ISTAT) 01220 IF(ISTAT.GE.0) GO TO 290 01230 CALL FILERR(DDATA,11,ISTAT,LU) 01240 GO TO 900 012501 01260 290 CALL CCSBLK(DLYWRK,40) 01270 GO TO 700 012801 01290C ERROR ON READING THE COLLECTOR ID IN UTILITY FILE-REPORT IT 01300C AND CONTINUE 01310 300 CALL CCSMVA(TRNREC,J+16,4,ERRMSG,28,4) 01320 CALL WTREAD(LU,XYN,ERRMSG,ERRLEN,0,0,0,TC) 013301 01340 700 CONTINUE 013501 01360C ALL TRANSACTIONS FROM THIS BLOCK PROCESSED, CHECK IF THIS IS 01370C THE LAST BLOCK FROM TRANSACTION FILE, IF NOT GET NEXT BLOCK 01380 710 GO TO 200 013901 01400C LAST BLOCK PROCESSED CLOSE FILES AND EXIT 01410 800 CALL CLOSFL(UTIREQ,ISTAT) 01420 CALL CLOSFL(TRNREQ,ISTAT) 01430 CALL CLOSFL(DLYREQ,ISTAT) 014401 01450 900 CALL PGMOUT 01460 END 01470 END/ 00040SWITCH DCK/ I=13,H 00010SWITCH HOL/ 00020 PROGRAM SWITCH 00001 1 /S12 F RPG CCS 3.0 SL-149 00002C*** RPG UTILITIES- MAIN PROGRAM FOR SWITCH 00003C CREDIT COLLECTION SYSTEM VERSION 3.0 00004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C COPYRIGHT CONTROL DATA CORPORATION 1979 00006C 00007C THIS IS A UTILITY PROGRAM TO SET PSEUDO EXTERNAL SWITCHES 00008C FOR USE WITH RPG II (OR FORTRAN) PROGRAMS 00009C EXECUTING UNDER ITOS 00010C 00011C CALLING SEQUENCE (FROM ITOS) 00012C SWITCH 00013C XXXXXXXX 00014C 00015C WHERE X IS EITHER 1 (SET) OR 0 (RESET) FOR SWITCH 1 TO 8 00016C 00017 INTEGER R9SWCH 00018C R9SWCH IS THE LOCATION IN SYSDAT THAT CONTAINS THE 00019C STATUS OF THE RPG INDICATORS U1 TO U8. 00020C R9SWCH MUST BE AN UNPROTECTED LOCATION 00021 INTEGER MSG(4),Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8 00022 INTEGER STATUS,U1,U2,U3,U4,U5,U6,U7,U8 00023 INTEGER X1,X2,X3,X4,X5,X6,X7,X8 00024 INTEGER STSMSG(10),STSERR(12) 00025 INTEGER ENTMSG(30),STSBUF(10) 00026 EQUIVALENCE (STSMSG(7),MSG(1)) 00027 BYTE (U1, STATUS(01=01)), (X1, STSBUF(1)(8=8)), (Y1, MSG(1)(8=8)) 00028 BYTE (U2, STATUS(02=02)), (X2, STSBUF(1)(0=0)), (Y2, MSG(1)(0=0)) 00029 BYTE (U3, STATUS(03=03)), (X3, STSBUF(2)(8=8)), (Y3, MSG(2)(8=8)) 00030 BYTE (U4, STATUS(04=04)), (X4, STSBUF(2)(0=0)), (Y4, MSG(2)(0=0)) 00031 BYTE (U5, STATUS(05=05)), (X5, STSBUF(3)(8=8)), (Y5, MSG(3)(8=8)) 00032 BYTE (U6, STATUS(06=06)), (X6, STSBUF(3)(0=0)), (Y6, MSG(3)(0=0)) 00033 BYTE (U7, STATUS(07=07)), (X7, STSBUF(4)(8=8)), (Y7, MSG(4)(8=8)) 00034 BYTE (U8, STATUS(08=08)), (X8, STSBUF(4)(0=0)), (Y8, MSG(4)(0=0)) 00035 INTEGER Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8 00036 BYTE (Z1, STSBUF(1) (15=09)) 00037 BYTE (Z2, STSBUF(1) (07=01)) 00038 BYTE (Z3, STSBUF(2) (15=09)) 00039 BYTE (Z4, STSBUF(2) (07=01)) 00040 BYTE (Z5, STSBUF(3) (15=09)) 00041 BYTE (Z6, STSBUF(3) (07=01)) 00042 BYTE (Z7, STSBUF(4) (15=09)) 00043 BYTE (Z8, STSBUF(4) (07=01)) 00044 EQUIVALENCE (NENT, STSBUF(5)) 00045C LOCATION NENT CONTAINS THE ACTUAL NO OF CHARS READ 00046 DATA ENTMSG/$D0A,' ENTER SWITCH VALUES ',$D15,12*$1515/ 00047 DATA STSBUF / 'XXXXXXXX ' / 00048 DATA STSMSG /$0D0A,' SWITCH = 00000000' / 00049 DATA STSERR /$0D0A,' INVALID SWITCH ENTRY' / 00050 INTEGER IDUSER(4),TERMLU 00051C CURSOR COORDINATES 00052 INTEGER W1 00053 DATA W1 / -1 / , R9SWCH / $E3 / 00054C---- SET FIRST TWO CHARS OF DISPLAY MSG TO 'CLEAR' AND 'E' 00055C---- ENTMSG = $1845 00056C CALL EXEC TO GET USER ID, LOGICAL UNIT, MODE AND PORT 00057 CALL PGMIN (IDUSER,TERMLU,MODE,NOPORT) 00058C INITIAL PICK-UP OF STATUS 00059C LDA+ R9SWCH 00060C STA STATUS 00061 ASSEM $C400,$00E3 ,$6800,STATUS 00062C DISPLAY SWITCH ENTER REQUEST (IF INTERACTIVE) AND READ VALUES 00063 CALL WTREAD (TERMLU, W1, ENTMSG, 57, W1, STSBUF, 18, ICODE) 00064C CHECK FOR VALID CHARACTERS IN INPUT BUFFER 00065 DO 100 I = 1,4 00066 LSB = AND ($FF,STSBUF(I)) 00067 MSB = AND ($FF,STSBUF(I)/$100) 00068 IF (MSB .EQ. $20) GO TO 110 00069 IF (MSB .EQ. $30) GO TO 110 00070 IF (MSB .EQ. $31) GO TO 110 00071 IF (MSB .EQ. $FF) GO TO 110 00072 IF (MSB .EQ. $58) GO TO 110 00073C INVALID CHARACTER 00074 GO TO 900 00075 110 CONTINUE 00076 IF (LSB .EQ. $20) GO TO 100 00077 IF (LSB .EQ. $30) GO TO 100 00078 IF (LSB .EQ. $31) GO TO 100 00079 IF (LSB .EQ. $58) GO TO 100 00080 IF (LSB .EQ. $FF) GO TO 100 00081C INVALID CHARACTER 00082 GO TO 900 00083 100 CONTINUE 00084C DECODE ASCII INPUT - REQD SWITCH SETTING 00085C IF ENTERED VALUE IS 0 ($30) OR 1 ($31) SET BIT ACCORDINGLY 00086C FOR ANY OTHER ENTERED CHARACTER, LEAVE SWITCH UNCHANGED 00087 IF (Z1 .EQ. $18) U1 = X1 00088 IF (Z2 .EQ. $18) U2 = X2 00089 IF (Z3 .EQ. $18) U3 = X3 00090 IF (Z4 .EQ. $18) U4 = X4 00091 IF (Z5 .EQ. $18) U5 = X5 00092 IF (Z6 .EQ. $18) U6 = X6 00093 IF (Z7 .EQ. $18) U7 = X7 00094 IF (Z8 .EQ. $18) U8 = X8 00095C STORE DESIRED STATUS 00096C LDA STATUS 00097C STA+ R9SWCH 00098 ASSEM $C800,STATUS,$60E3 00099 200 CONTINUE 00100C---- PICK UP PRESENT STATUS 00101C---- LDA+ R9SWCH 00102C---- STA STATUS 00103 ASSEM $C400,$00E3 ,$6800,STATUS 00104C SET UP ASCII MESSAGE TO DISPLAY SWITCH STATUS 00105 Y1 = U1 00106 Y2 = U2 00107 Y3 = U3 00108 Y4 = U4 00109 Y5 = U5 00110 Y6 = U6 00111 Y7 = U7 00112 Y8 = U8 00113C DISPLAY SWITCH VALUES 00114 CALL WTREAD (TERMLU, W1, STSMSG, 20, 0, 0, 0, ICODE ) 00115C EXIT TO ITOS 00116 999 CALL PGMOUT 00117C ERROR MESSAGE 00118 900 CONTINUE 00119C DISPLAY SWITCH ERROR MESSAGE 00120 CALL WTREAD (TERMLU, W1, STSERR, 24, 0, 0, 0, ICODE) 00121C EXIT TO ITOS 00122 GO TO 999 00123 END 00124 END/ 00040UPD500 DCK/ I=13,H 00010UPD500 HOL/ 00020 PROGRAM UPD500 00010 1 /QSS000 CCS 3.0 UPD500 SL-149 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 03/08/83 ************ PROGRAMMER : RWE 000901 00100C****** IF A UPD500 PROGRAM IS REQUIRED... 00110C****** THEN PROGRAM UPD400 CAN PROBABLY BE MODIFIED 00120C****** TO HANDLE THE FINANCIAL DATA AND THEN BE RENAMED TO UPD500 001301 00140 INTEGER MSG1(22) 001501 00160 DATA MSG1 /$D0A,$720,'UPD500 REQUIRES A QSS FROM CONTROL DATA.'/ 001701 00180 10 CALL WTREAD(5,-1,MSG1,44,0,0,0,ITC) 00190 CALL PGMOUT 00200 END 00210 END/ 00040VFYACF DCK/ I=13,H 00010VFYACF HOL/ 00020 SUBROUTINE VFYACF(BUF) 00010 1 /ROUTINE TO VERIFY ACTIVITY BLOCK LENGTH 000202 00030C REVISED 08/05/82 00040C THIS ROUTINE VERIFIES THE LENGTH PORTION OF THE ON-LINE ACTIVITY 00050C BLOCK. IF THE LENGTH EXCEEDS 360 OR CONTAINS AN INVALID CHAR, 00060C THEN THE BLOCK IS BLANKED OUT. 000701 00080 INTEGER BUF(1) 000902 00100C SKIP TEST IF BLOCK IS BLANK 00110 IF(BUF(154).EQ.$2020.AND.BUF(155).EQ.$2020) GO TO 15 001201 00130C VERIFY THAT ALL CHAR OF LENGTH ARE NUMERICS. 00140 DO 10 I = 1,4 00150 CALL CCSGET(BUF(154),I,J) 00160 IF(J.LT.$30.OR.J.GT.$39) GO TO 20 00170 IF(I.EQ.1.AND.J.NE.$30) GO TO 20 00180 10 CONTINUE 001901 00200C VERIFY LENGTH DOES NOT EXCEED MAX OF 360 00210 I = AND(BUF(154),$F) * 100 + ICCSAD(BUF(155)) 00220 IF (I.GT.360) GO TO 20 00230 15 RETURN 002401 00250C ERROR - CLEAR BLOCK & CONTINUE 00260 20 CALL CCSBLK(BUF(154),360) 00270 RETURN 00280 END 00290 END/ 00040YMD1 DCK/ I=13,H 00010YMD1 HOL/ 00020 SUBROUTINE YMD1(IYR,IMO,IDYMO,DYCT,IDYYR,IDYWK) 00010C-----INPUTS IYR - YEAR ( 1 TO 99 ) 00020C IMO - MONTH( 1 TO 12 ) 00030C IDYMO - DAY OF MONTH ( 1 TO 31 ) 00040C-----OUTPUTS DYCT - DAY OF CENTURY (FROM JAN 1, 1901) 00050C IDYYR - DAY OF YEAR ( 1 TO 366 ) 00060C IDYWK - DAY OF WEEK ( 1 TO 7, MON IS 1 ) 00070C 00080 LEAPYR = 2 00090 IF ((IYR/4*4).EQ.IYR) LEAPYR = 1 00100 IMT = IMO*275 00110 IMT = IMT/9 00120 IDYYR = IMT+IDYMO-30 00130 IF (IMO.GT.2) IDYYR = IDYYR-LEAPYR 00140 YR=IYR-1 00150 DYYR=IDYYR 00160 TDYCT=YR*1461 00170 DYCT = TDYCT/4+DYYR 00180 DYCT2= DYCT 00190 DNUM=05*1000 00200 DMINUS=7*343 00210 IL = 0 00220 5 IF(DYCT2.LT.DNUM )GO TO 6 00230 IL = IL+1 00240 DYCT2=DYCT2-DMINUS 00250 GO TO 5 00260 6 CONTINUE 00270 IDYCT=DYCT2 00280 DYCT = IL * DMINUS + IDYCT 00290 IDYWK = IDYCT-IDYCT/7*7+1 00300 RETURN 00310 END 00320 END/ 00040YMD3 DCK/ I=13,H 00010YMD3 HOL/ 00020 SUBROUTINE YMD3(IYR,IMO,IDYMO,DYCT,IDYYR,IDYWK) 00010C-----INPUTS DYCT - DAY OF CENTURY (FROM JAN 1, 1901) 00020C-----OUTPUTS IYR - YEAR ( 1 TO 99 ) 00030C IMO - MONTH( 1 TO 12 ) 00040C IDYMO - DAY OF MONTH ( 1 TO 31 ) 00050C IDYYR - DAY OF YEAR ( 1 TO 366 ) 00060C IDYWK - DAY OF WEEK ( 1 TO 7, MON IS 1 ) 000701 00080 IMD = DYCT/1461 00090 TDYCT= DYCT-IMD+364 00100 IYR = TDYCT/365 00110 YR = IYR-1 00120 TYDCT = YR*1461 00130 DYCT2 = TYDCT/4 -0.5 00140 DYYR = DYCT - DYCT2 00150 IDYYR = DYYR 00160 LEAPYR = 2 00170 IF ((IYR/4*4).EQ.IYR) LEAPYR = 1 00180 IF (LEAPYR.EQ.1) IDYYR = IDYYR+1 00190 ITEMP = IDYYR 00200 IF (ITEMP.GT.(61-LEAPYR)) ITEMP=ITEMP+LEAPYR 00210 IMO =(ITEMP*9+269)/275 00220 IDYMO= ITEMP-IMO*275/9+30 00230 DYCT2 = DYCT 00240 DNUM = 20*1000 00250 DMINUS= 7*343 00260 5 IF(DYCT2.LT.DNUM) GO TO 10 00270 DYCT2 = DYCT2-DMINUS 00280 GO TO 5 00290 10 CONTINUE 00300 IDYCT = DYCT2 00310 IDYWK= IDYCT-IDYCT/7*7+1 00320 RETURN 00330 END 00340 END/ 00040COLMAC DCK/ I,H BLKDAT DCK/ I,H ACTEDT DCK/ I,H CHSCRN DCK/ I,H CLANEX DCK/ I,H DAAASC DCK/ I,H DISPLY DCK/ I,H EACTSQ DCK/ I,H EATRNG DCK/ I,H FCOLEC DCK/ I,H GETCHF DCK/ I,H ICHEKQ DCK/ I,H ICHENT DCK/ I,H NMSRCH DCK/ I,H PCPROC DCK/ I,H PIKAMT DCK/ I,H SAVTRN DCK/ I,H MON04 DCK/ I,H UPDMAC DCK/ I,H ADDIT DCK/ I,H CHNGNF DCK/ I,H CONUPD DCK/ I,H COSUPD DCK/ I,H FORMLN DCK/ I,H FUPDAT DCK/ I,H GETMAS DCK/ I,H LABHAN DCK/ I,H NXTRAN DCK/ I,H PRTLIN DCK/ I,H REACIT DCK/ I,H RSWIT DCK/ I,H TOTALP DCK/ I,H UNCUPD DCK/ I,H UPDBLK DCK/ I,H UPDEND DCK/ I,H UPDIT DCK/ I,H UPINIT DCK/ I,H MON05 DCK/ I,H UP4MAC DCK/ I,H UP4BLK DCK/ I,H FUPD4X DCK/ I,H UP4INI DCK/ I,H UP4LAB DCK/ I,H UP4NXT DCK/ I,H UP4TOT DCK/ I,H UP4END DCK/ I,H UP4GTM DCK/ I,H UP4GTC DCK/ I,H UP4PRT DCK/ I,H UP4FML DCK/ I,H MON06 DCK/ I,H BHXDEC DCK/ I=13,H 00010BHXDEC HOL/ 00020 SUBROUTINE BHXDEC (NUM,IOUT) * /HEX TO DECIMAL W/LEADING BLANKS C  BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. N=NUM DO 8 JK=1,3 8 IOUT(JK)= $2020 IF(N.EQ.0) IRIGHT(3)=$30 IF(N.GE.0) GO TO 50 C MINUS NUMBER N=-N ILEFT(1)=$2D 50 CONTINUE I=5 55 CONTINUE IF(N.EQ.0) GO TO 200 N1=(N/10)*10 N2=N-N1+$30 I1=I/2+1 IF(AND(I,1).EQ.0) GO TO 100 IRIGHT(I1)=N2 GO TO 110 100 ILEFT(I1)=N2 110 CONTINUE N=N/10 I=I-1  IF(I.GT.0) GO TO 55 200 CONTINUE RETURN END END/ 00040GETGRP DCK/ I=13,H 00010GETGRP HOL/ 00020 SUBROUTINE GETGRP( GRPBUF,IALL,IMODE ) 00010 1 /CCS3.0 SUBROUTINE GETGRP SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/06/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : SELECT WHICH ACCOUNT GROUPS TO USE 001101 00120C*** CALLING SEQUENCE : CALL GETGRP( GRPBUF,IALL,IMODE ) 001301 00140C PARAMETERS 001501 00160C GRPBUF : 10 WORD ARRAY RETURNED TO PROGRAM WITH FROM 1 00170C TO 10 VALID ACCOUNT GROUPS 00180C ( FOR USE WITH FUNCTION 'ICKGRP' ) 00190C IALL : FLAG RETURNED DESIGNATING USE OF ACCOUNT GROUPS 00200C 0 = USE ALL ACCOUNT GROUPS 00210C 1 = USE ONLY ACCOUNT GROUPS IN GRPBUF ARRAY 00220C IMODE : FLAG TO DETERMINE WHICH ACTION TO TAKE : 00230C 0 = USE ALL ACCOUNT GROUPS 00240C 1 = USE ACCOUNT GROUPS 0-4 ONLY 00250C 2 = USE ACCOUNT GROUPS 5-9 ONLY 00260C 3 = PROMPT FROM SCREEN, WHICH OF (0-9) GROUPS TO USE 00270C 4 = PROMPT FROM SCREEN, EITHER ALL, OR 0-4, OR 5-9. 00280C 5 = GET 'IMODE' FLAG FROM UTIFIL 002901 00300 INTEGER GRPBUF(1),IALL,IMODE 00310 +, INP(41),MSGY(18),AGRPS(10),MINUS(10),ALL 00320 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 00330 +, MSGA(18),MSGB(18),MSGC(18),MSGD(18),MSGE(18),MSGF(20) 003401 00350 DATA MSG1/$180A,$0A0D,'** SELECT ACCOUNT GROUP OPTION',$160A/ 00360 +, MSG2/$0D0A,' 0 = ALL ACCOUNT GROUPS ',$1616/ 00370 +, MSG3/$0D0A,' 1 = ACCOUNT GROUPS 0-4 ONLY ',$1616/ 00380 +, MSG4/$0D0A,' 2 = ACCOUNT GROUPS 5-9 ONLY ',$160A/ 00390 +, MSG5/$0D0A,' PLEASE ENTER SELECTION(0,1,2) :',$1616/ 004001 00410 DATA MSGA/$180A,$0A0D,'* SELECT ACCOUNT GROUPS TO USE',$160A/ 00420 +, MSGB/$0D0A,' SEPARATE GROUPS BY COMMAS, ',$1616/ 00430 +, MSGC/$0D0A,' (I.E. 0,1,2,3, ETC...) OR ',$1616/ 00440 +, MSGD/$0D0A,' ENTER A FOR ALL GROUPS ',$160A/ 00450 +, MSGE/$0D0A,' PLEASE ENTER SELECTION -- :',$1616/ 004601 00470 DATA MSGF/$180A,'INVALID ENTRY : ',$160A/ 004801 00490 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 00500 +, AGRPS/'0,1,2,3,4,5,6,7,8,9,'/,MINUS/10*$FFFF/,ALL/'A,'/ 005101 00520C**** BEGIN PROGRAM ....... 005301 00540 MODE = IMODE 00550 IALL = 0 00560 CALL CCSMVA( MINUS,1,20,GRPBUF,1,20 ) 005701 00580 10 CONTINUE 00590 IF ( MODE.EQ.0 ) GO TO 50 00600 IF ( MODE.EQ.1 ) GO TO 100 00610 IF ( MODE.EQ.2 ) GO TO 200 00620 IF ( MODE.EQ.3 ) GO TO 300 00630 IF ( MODE.EQ.4 ) GO TO 400 00640 IF ( MODE.EQ.5 ) GO TO 500 006501 00660C**** SET AND USE ALL ACCOUNT GROUPS 006701 00680 50 CONTINUE 00690 IALL = 0 00700 CALL CCSMVA( AGRPS,1,20,GRPBUF,1,20 ) 00710 GO TO 800 007201 00730C**** SET AND USE GROUPS 0-4 ONLY 007401 00750 100 CONTINUE 00760 IALL = 1 00770 CALL CCSMVA( AGRPS,1,10,GRPBUF,1,10 ) 00780 GO TO 800 007901 00800C**** SET AND USE GROUPS 5-9 ONLY 008101 00820 200 CONTINUE 00830 IALL = 1 00840 CALL CCSMVA( AGRPS,11,10,GRPBUF,1,10 ) 00850 GO TO 800 008601 00870C**** ASK OPERATOR FROM SCREEN WHICH ACCOUNT GROUPS..... 008801 00890 300 CONTINUE 00900 CALL CCSMVA( MSG2,8,18,MSG2,4,30 ) 00910 CALL CCSMVA( MSG3,16,6,MSG3,4,30 ) 009201 00930 305 CONTINUE 00940 ASSIGN 305 TO IRTN 00950 ASSIGN 10 TO IRTN2 00960 CALL WTREAD(05,-1,MSGA ,36,0,0,0,ITC) 00970 CALL WTREAD(05,-1,MSGB ,36,0,0,0,ITC) 00980 CALL WTREAD(05,-1,MSGC ,36,0,0,0,ITC) 00990 CALL WTREAD(05,-1,MSGD ,36,0,0,0,ITC) 01000 MSGA = MSG1 010101 01020 310 CONTINUE 01030 CALL CCSMVA(INP,1,0,INP,1,82) 01040 CALL WTREAD(05,-1,MSGE ,36,-1,INP,80,ITC) 01050 IF (ITC.EQ.4) GO TO 310 01060 NCH = INP(41) 01070 NCH = (NCH+1)/2 01080 N2H = NCH*2 01090 CALL CCSPUT( $2C,N2H,INP ) 01100 IF ( INP.EQ.ALL ) GO TO 320 01110 GO TO 330 011201 01130C**** VERIFY ALL GROUPS TO BE USED... 011401 01150 320 CONTINUE 01160 MODE = 0 01170 CALL WTREAD( 05,-1,MSG2,36,0,0,0,ITC ) 01180 GO TO 425 011901 01200C**** VALIDATE INPUT FOR VALID GROUPS..... 012101 01220 330 CONTINUE 012301 01240 K = 1 01250 MELM= NCH-1 01260 IF (MELM.LE.1) GO TO 370 01270 DO 360 I=1,MELM 012801 01290 IF(INP(I).LT.INP(I+1))GO TO 360 01300 340 TEMP = INP(I) 01310 INP(I) = INP(I+1) 01320 INP(I+1) = TEMP 01330 DO 350 J=I,2,-K 01340 IF(INP(J).GT.INP(J-1))GO TO 360 01350 TEMP = INP(J) 01360 INP(J) = INP(J-1) 01370 INP(J-1) = TEMP 01380 350 CONTINUE 01390 360 CONTINUE 014001 01410C*** CHECK FOR DUPLICATE NUMBERS 014201 01430 JJ = NCH-1 01440 DO 365 I = 1,JJ 01450 IF ( INP(I).EQ.INP(I+1) ) GO TO 390 01460 365 CONTINUE 014701 01480C*** DISPLAY CHOICES AND VERIFY... 014901 01500 370 CONTINUE 01510 IF( INP(1).EQ.INP(2) ) GO TO 390 01520 DO 375 I = 1,NCH 01530 L = ( AND(INP(I),$FF00) )/256 01540 IF ( L.LT.$30 .OR. L.GT.$39 ) GO TO 390 01550 375 CONTINUE 01560 CALL CCSMVA( INP,1,N2H,MSG4,1,N2H ) 01570 CALL CCSMVA( INP,1,N2H-1,MSG3,11,20 ) 01580 CALL WTREAD( 05,-1,MSG3,36,0,0,0,ITC ) 01590 ASSIGN 380 TO IRTN2 01600 GO TO 425 016101 01620C*** SET GROUPS..... 016301 01640 380 CONTINUE 01650 IALL = 1 01660 CALL CCSMVA( MSG4,1,N2H,GRPBUF,1,N2H ) 01670 GO TO 800 016801 01690C*** ERROR IN NUMBER ENTRY ..... REPEAT PROMPT 017001 01710 390 CONTINUE 01720 MSGA = MSGB 01730 CALL CCSMVA( INP,1,N2H-1,MSGF,19,20 ) 01740 CALL WTREAD( 05,-1,MSGF,40,0,0,0,ITC ) 01750 GO TO IRTN 017601 01770C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 017801 01790 400 CONTINUE 01800 ASSIGN 400 TO IRTN 01810 ASSIGN 10 TO IRTN2 01820 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 01830 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 01840 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 01850 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 018601 01870 410 CONTINUE 01880 CALL CCSMVA(INP,1,0,INP,1,82) 01890 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 01900 IF (ITC.EQ.4) GO TO 410 019101 01920C*** VALIDATE SELECTION.... 019301 01940 CALL CCSGET( INP,1,ICH ) 019501 01960 IF( INP(41).EQ.0 ) GO TO 420 01970 IF ( ICH.LT.$30 .OR. ICH.GT.$32 ) GO TO IRTN 019801 01990 420 MODE = AND( ICH,$F ) 02000 IF( MODE.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,35,0,0,0,ITC) 02010 IF( MODE.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,35,0,0,0,ITC) 02020 IF( MODE.EQ.2 ) CALL WTREAD(05,-1,MSG4 ,35,0,0,0,ITC) 020301 02040 425 CONTINUE 02050 CALL CCSMVA(INP,1,0,INP,1,82) 02060 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 02070 CALL CCSGET(INP,1,ICH) 02080 IF ( INP(41).EQ.0 ) GO TO 430 02090 IF ( ICH.NE.$59 ) GO TO IRTN 02100 430 CONTINUE 02110 GO TO IRTN2 021201 02130C**** GET 'IMODE' WHAT TO DO FLAG FROM UTIFIL... 021401 02150 500 CONTINUE 02160 CALL GTSYSP( MODE,77 ) 02170 IF ( MODE.LT.0 .OR. MODE.GT.4 ) MODE = 0 02180 GO TO 10 021901 02200 800 RETURN 02210 END 02220 END/ 00040GETSW DCK/ I=13,H 00010GETSW HOL/ 00020 SUBROUTINE GETSW ( U ) 00010 1 /CCS3.0 SUBROUTINE GETSW SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/06/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : RETRIEVE RPG EXTERNAL SWITCH SETTINGS 001101 00120C*** CALLING SEQUENCE : CALL GETSW( U ) 001301 00140C PARAMETERS 001501 00160C U : AN 8 WORD ARRAY, WHERE EACH WORD CORRESPONDS 00170C TO AN RPG EXTERNAL SWITCH 00180C RPG ARRAY 00190C U1 = U(1) 00200C U2 = U(2) 00210C ETC... 00220C RETURNED VALUES ARE 0 = SWITCH IS OFF, 1 = SWITCH IS ON 002301 00240 INTEGER U(1),I,J,SWITCH 002501 00260C**** 00270C**** BEGIN PROGRAM ....... 002801 00290C*** PICK UP LOCATION $E3 IN CORE WHICH IS RPG EXTERNAL SWITCH 003001 00310 ASSEM $C400,$00E3,$6800,SWITCH 003201 00330 J = 2 003401 00350C*** CRACK THE SWITCHS 003601 00370 DO 100 I = 1,8 00380 U(I) = AND( SWITCH,J )/J 00390 J = J*2 00400 100 CONTINUE 00410 RETURN 00420 END 00430 END/ 00040GETUTI DCK/ I=13,H 00010GETUTI HOL/ 00020 SUBROUTINE GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 00010 1 /CCS3.0 SUBROUTINE GETUTI SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/06/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : RETRIEVE RECORD BY KEY FROM UTIFIL. 001101 00120C*** CALLING SEQUENCE : CALL GETUTI( KEYB,REC,IFOUND,IFER,NOPT ) 001301 00140C PARAMETERS 001501 00160C KEYB : KEY OF UTIFIL RECORD TO BE RETRIEVED ( 2 WORDS ) 00170C REC : BUFFER TO RECIEVE THE RETRIEVED RECORD(40 WORDS ) 00180C BUFFER WILL BE BLANKS IF RECORD IS NOT FOUND. 00190C IFOUND : RETURNED VALUE DESIGNATING IF RECORD WAS FOUND. 00200C 0 = RECORD FOUND , 1 = RECORD NOT FOUND 00210C IFER : ISTAT OF FILE MANAGER CALL. (FROM UTIFIL) 00220C NOPT : PASSED. OPTION OF WHAT TO DO. 00230C 0 = RETRIEVE RECORD (LEAVE FILE OPEN) 00240C 1 = RETRIEVE RECORD (CLOSE FILE WHEN DONE) 00250C 2 = CLOSE FILE. 002601 00270 INTEGER KEYB(1),REC(1),IFOUND,IFER,NOPT 00280 +, DAT1(15),REQ1(24),R1KY(15),REC1(0042) 00290 +, USER(4),LU,NPORT,MODE 003001 00310 DATA DAT1 /'LAUTIFIL ',01,01,00/,REQ1/24*0/ 00320 DATA IOPN/0/ , IDUN/0/ 003301 00340C**** 00350C**** BEGIN PROGRAM ....... 003601 00370 IF ( NOPT.EQ.2 ) GO TO 500 00380 IF ( IOPN.EQ.1 ) GO TO 100 003901 00400C*** CHECK FOR LA LOOK-ALIKE 004101 00420 IF( IDUN.EQ.1 ) GO TO 5 00430 IDUN = 1 00440 CALL PGMIN( USER,LU,MODE,NPORT ) 00450 CALL CCSCST( DAT1,1,2,USER,1,8,ICM ) 00460 IF ( ICM.EQ.0 ) GO TO 5 00470 CALL CCSMVA( DAT1,3,6,DAT1,1,16 ) 004801 00490 5 CONTINUE 00500 DO 20 I = 1,24 00510 REQ1(I) = 0 00520 20 CONTINUE 005301 00540 CALL OPENFL( REQ1,DAT1,ISTAT ) 00550 IF( ISTAT.LT.0 ) GO TO 800 00560 REQ1(23) = 1 00570 IOPN = 1 005801 00590 100 CONTINUE 00600 CALL CCSMVA( KEYB,1,4,R1KY,1,30 ) 00610 CALL READR ( REQ1,REC1,R1KY,ISTAT ) 00620 IF ( AND(ISTAT,$300).NE.0 ) GO TO 200 00630 IF ( ISTAT.LT.0 ) GO TO 800 006401 00650C*** RECORD FOUND PASS INFO BACK TO CALLER 006601 00670 120 CONTINUE 00680 IFER = ISTAT 00690 IFOUND = 0 00700 CALL CCSMVA( REC1,1,80,REC,1,80 ) 00710 IF( NOPT.EQ.1 ) GO TO 500 00720 GO TO 900 007301 00740C**** RECORD NOT FOUND RETURN BLANKS 007501 00760 200 CONTINUE 00770 IFER = AND( ISTAT,$7FFF ) 00780 IFOUND = 1 00790 CALL CCSMVA( REC1,1,0,REC,1,40 ) 00800 IF( NOPT.EQ.1 ) GO TO 500 00810 GO TO 900 008201 00830C**** CLOSE FILE AND RETURN 008401 00850 500 CONTINUE 00860 CALL CLOSFL( REQ1,ISTAT ) 00870 IOPN = 0 00880 GO TO 900 008901 00900C**** ERROR SECTION FOR FILE 009101 00920 800 CONTINUE 00930 IFOUND = 1 00940 IFER = ISTAT 00950 IF( AND(ISTAT,$8002).EQ.$8002 ) GO TO 900 00960 IREQ = AND(REQ1(4),$FF) 00970 IF(IREQ.LT.11) IREQ = IREQ-1 00980 IF(IREQ.EQ.18) IREQ = 10 00990 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 01000 GO TO 900 010101 01020 900 CONTINUE 01030 RETURN 01040 END 01050 END/ 00040GTSYSP DCK/ I=13,H 00010GTSYSP HOL/ 00020 SUBROUTINE GTSYSP( IPARM,IPOS ) 00010 1 /CCS3.0 SUBROUTINE GTSYSP SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/06/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : GET SYSTEM PARAMETER FROM THE 00110C EXTERNAL FLAG RECORD IN THE UTIFIL. 001201 00130C*** CALLING SEQUENCE : CALL GTSYSP( IPARM,IPOS ) 001401 00150C PARAMETERS 001601 00170C IPARM : RETURNED VALUE ($0 TO $F WHICH IS 0 TO 15 DECIMAL) 00180C WHICH IS RETRIEVED FROM THE 'EXTERNAL FLAG RECORD' 00190C IN THE UTIFIL. 00200C IPOS : THE STARTING BYTE OF THE FLAG IN THE FLAG RECORD. 00210C ( SEE LAYOUT OF 'EXTERNAL FLAG RECORD' ) 002201 00230C EXAMPLE : CALL GTSYSP( IMODE,30 ) 00240C THIS WOULD RETRIEVE THE FLAG 2 FOR THE 00250C LTRSTA PROGRAM AND SET THE IMODE FLAG FOR 00260C SUBROUTINE GETGRP 00270C LTRSTA FLAGS START IN POS. 29, THERE ARE 4 FLAGS 00280C FLAG 1 = IWAY FOR SUBROUTINE PRTORF 00290C FLAG 2 = IMODE FOR SUBROUTINE GETGRP 00300C FLAG 3 = 00310C FLAG 4 = 003201 00330 INTEGER IPARM,IPOS 00340 +, SYSREC(42),SYSP(2),IGOT 003501 00360 DATA SYSP /'SYSP'/, IGOT / 0/ 003701 00380C**** 00390C**** BEGIN PROGRAM ....... 004001 00410 IF ( IGOT.NE.0 ) GO TO 100 00420 CALL GETUTI( SYSP,SYSREC,IFOUND,IFER,1 ) 00430 IF( IFOUND.NE.0 ) CALL CCSMVA( SYSREC,1,0,SYSREC,1,80 ) 00440 IGOT = 1 004501 00460 100 CONTINUE 00470 CALL CCSGET( SYSREC,IPOS,IFLG ) 004801 00490 IPARM = AND( IFLG,$F ) 00500 RETURN 00510 END 00520 END/ 00040HXDEC DCK/ I=13,H 00010HXDEC HOL/ 00020 SUBROUTINE HXDEC (NUM,IOUT) 00010 * /DECK-ID E27 ITOS 2.0 SUMMARY-132 00020C CONVERT HEX TO DECIMAL ASCII 00030C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 2.0 00040C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00050C COPYRIGHT CONTROL DATA CORPORATION 1978 00060C 00070C** FUNCTION 00080C -------- 00090CS3 HXDEC CONVERTS A HEXADECIMAL NUMBER INTO AN ASCII 00100C DECIMAL NUMBER. 00110CS5 GENERAL DESCRIPTION 00120C ------------------- 00130CS3 HXDEC BLANKS OUT THE OUTPUT BUFFER, IOUT. THE 00140C SUBROUTINE THEN TESTS THE HEX NUMBER FOR ZERO. IF 00150C THE NUMBER IS ZERO, AN ASCII ZERO IS MOVED TO THE 00160C RIGHT BYTE OF THE THIRD WORD OF IOUT. IF THE 00170C NUMBER IS NOT ZERO AND IS NEGATIVE AN ASCII MINUS 00180C SIGN IS PLACED IN THE LEFT BYTE OF THE FIRST WORD 00190C OF IOUT AND THE HEX NUMBER IS COMPLIMENTED. AT 00200C THIS POINT ANOTHER TEST FOR ZERO IS MADE. IF THE 00210C NUMBER IS ZERO, NO CONVERSION TAKES PLACE, 00220C OTHERWISE THE HEX NUMBER IS CONVERTED TO AN ASCII 00230C DECIMAL NUMBER. 00240CE ENTRY/EXIT 00250C ---------- 00260CS3 HXDEC IS ENTERED WITH THE HEX NUMBER IN NUM AND 00270C EXITS WITH THE CONVERTED NUMBER IN IOUT. 00280C 00290 BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) 00300 DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) 00310C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. 00320 N=NUM 00330 DO 8 JK=1,3 00335 8 IOUT(JK)= $3030 00340 IF(N.EQ.0) IRIGHT(3)=$30 00350 IF(N.GE.0) GO TO 50 00360C MINUS NUMBER 00370 N=-N 00380 ILEFT(1)=$2D 0039050 CONTINUE 00400 I=5 0041055 CONTINUE 00420 IF(N.EQ.0) GO TO 200 00430 N1=(N/10)*10 00440 N2=N-N1+$30 00450 I1=I/2+1 00460 IF(AND(I,1).EQ.0) GO TO 100 00470 IRIGHT(I1)=N2 00480 GO TO 110 00490100 ILEFT(I1)=N2 00500110 CONTINUE 00510 N=N/10 00520 I=I-1 00530 IF(I.GT.0) GO TO 55 00540200 CONTINUE 00550 RETURN 00560 END 00570 END/ 00040ICHKZB DCK/ I=13,H 00010ICHKZB HOL/ 00020 INTEGER FUNCTION ICHKZB(IBUF,ISTRT,IBYTS) 00010 1 /CHECK FIELD FOR ZERO OR BLANK (RWE) SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983 00070C** 00080C** ************ 04/28/83 ************ PROGRAMMER : RWE 000901 00100C**** THIS FUNCTION WILL CHECK A FIELD TO SEE IF IT IS ZERO 00110C**** OR BLANK, EVEN IF THE ZEROS AND BLANKS ARE INTERMIXED, 00120C**** THE FUNCTION STILL RETURNS A VALUE OF TRUE. 001301 00140C* VARIABLES : IBUF - BUFFER CONTAINING THE FIELD TO CHECK. 00150C* ISTRT - STARTING BYTE WITHIN IBUF. 00160C* IBYTS - NUMBER OF BYTES TO CHECK. 001701 00180C**** RETURN VALUES : ICHKZB = 0 IF TRUE. 00190C* ICHKZB = 1 IF FALSE. 002001 00210 INTEGER IBUF(1),ISTRT,IBYTS,IEND,ICH 002201 00230 ICHKZB = 0 00240 IF(IBYTS.EQ.0) RETURN 00250 IEND = ISTRT + IBYTS -1 002601 00270 DO 20 I = ISTRT, IEND 00280 CALL CCSGET(IBUF, I, ICH) 00290 IF ( ICH.NE.$20 .AND. ICH.NE.$30 ) GO TO 40 00300 20 CONTINUE 00310 RETURN 00320 40 ICHKZB = 1 00330 RETURN 00340 END 00350 END/ 00040ICKGRP DCK/ I=13,H 00010ICKGRP HOL/ 00020 INTEGER FUNCTION ICKGRP( GRPBUF,IALL,REC,IPOS ) 00010 1 /CCS3.0 SUBROUTINE ICKGRP SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/06/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : VALIDATE RECORD FOR MATCH OF ACCT GROUP 001101 00120C*** CALLING SEQUENCE : 00130C ITF = ICKGRP( GRPBUF,IALL,REC,IPOS ) 00140C OR... IF ( ICKGRP( GRPBUF,IALL,REC,IPOS ).EQ. 1 ) GO TO 001501 00160C PARAMETERS 001701 00180C ICKGRP : RETURNED VALUE OF 0 = TRUE, OK TO USE RECORD 00190C 1 = FALSE, DON'T USE RECORD 00200C GRPBUF : 10 WORD ARRAY PASSED, CONTAINING VALID GROUPS 00210C ( BUILT BY SUBROUTINE 'GETGRP' ) 00220C IALL : PASSED FLAG DESIGNATING 00230C 0 = USE ALL ACCOUNT GROUPS ( FORCE ICKGRP TO TRUE ) 00240C 1 = LOOK FOR MATCH OF GROUP FROM RECORD, IN THE 00250C GRPBUF ARRAY 00260C REC : PASSED BUFFER OF RECORD CONTAING ACCT GROUP. 00270C IPOS : STARTING BYTE POS. IN REC OF ACCOUNT GROUP 002801 00290 INTEGER GRPBUF(1),IALL,REC(1),IPOS,TRUE,FALSE 003001 00310 DATA TRUE / 0/, FALSE / 1/ 003201 00330C**** 00340C**** BEGIN PROGRAM ....... 003501 00360 ICKGRP = TRUE 00370 IF ( IALL.EQ.0 ) GO TO 900 003801 00390 CALL CCSGET( REC,IPOS,IGRP ) 004001 00410 DO 200 I = 1,10 00420 J = I*2-1 00430 CALL CCSGET( GRPBUF,J,ICH ) 004401 00450 IF( ICH.EQ.$FF ) GO TO 800 00460 IF( ICH.EQ.IGRP ) GO TO 900 00470 200 CONTINUE 004801 00490C*** NO MATCH SET ICKGRP TO FALSE 005001 00510 800 CONTINUE 00520 ICKGRP = FALSE 00530 GO TO 900 005401 00550 900 RETURN 00560 END 00570 END/ 00040MOD DCK/ I=13,H 00010MOD HOL/ 00020 INTEGER FUNCTION MOD( NUM,MD ) 00010 1 / MOD FUNCTION 000201 00030 INTEGER NUM,MD,I,J 000401 00050 I = NUM/MD 00060 J = I * MD 00070 MOD = NUM-J 00080 RETURN 00090 END 00100 END/ 00040PRTORF DCK/ I=13,H 00010PRTORF HOL/ 00020 SUBROUTINE PRTORF( IPF,PLU,NLU,NPORT,IWAY ) 00010 1 /CCS3.0 SUBROUTINE PRTORF SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/06/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : VALIDATE OUTPUT LOGICAL UNIT AND 00110C SET DIRECTION OF OUTPUT. 001201 00130C*** CALLING SEQUENCE : CALL PRTORF( IPF,LU,NLU,NPORT,IWAY ) 001401 00150C PARAMETERS 001601 00170C IPF : RETURNED VALUE DESIGNATING OUTPUT DIRECTION. 00180C 0 = OUTPUT TO LOCIGAL UNIT 'NLU' 00190C 1 = OUTPUT TO SYSPRT FILE 00200C LU : LOGICAL UNIT NUMBER OF REQUESTED OUTPUT DEVICE. 00210C NLU : RETURNED VALUE DESIGNATING VALIDATED LOGICAL 00220C UNIT TO OUTPUT TO. 00230C NPORT : CURRENT TERMINAL # ( FROM PGMIN ) 00240C IWAY : FLAG TO DETERMINE WHICH ACTION TO TAKE : 00250C 0 = FORCE OUTPUT TO DESIGNATED LOGICAL UNIT 00260C 1 = FORCE OUTPUT TO SYSPRT FILE 00270C 2 = NOT USED AT PRESENT TIME 00280C 3 = PROMPT OPERATOR FROM SCREEN, FOR OUTPUT DIRECTION 00290C 4 = GET 'IWAY' FLAG FROM UTIFIL 003001 00310 INTEGER IPF,PLU,NLU,NPORT,IWAY 00320 +, INP(41),CRT(4),PRINT(4),TAPE(5),MSGY(18) 00330 +, MSG1(18),MSG2(18),MSG3(18),MSG4(18),MSG5(18) 003401 00350 DATA MSG1/$180A,$0A07,'** SELECT DIRECTION OF OUTPUT ',$160A/ 00360 +, MSG2/$0D0A,' 0 = OUTPUT TO LOGICAL UNIT ',$1616/ 00370 +, MSG3/$0D0A,' 1 = OUTPUT TO SYSPRT FILE ',$1616/ 00380 +, MSG4/$0D0A,' ',$160A/ 00390 +, MSG5/$0D0A,' PLEASE ENTER SELECTION (0,1) : ',$1616/ 004001 00410 DATA MSGY/$0D0A,$0D0A,' IS THIS CORRECT ? (Y/N) : ',$1616/ 004201 00430 DATA CRT /'TERMINAL'/, PRINT /'PRINTER '/ 00440 +, TAPE /'TAPE DRIVE'/ 004501 00460C**** BEGIN PROGRAM ....... 004701 00480 MWAY = IWAY 00490 10 CONTINUE 00500 PLU = AND( PLU,$FF ) 00510 IF ( MWAY.EQ.1 ) GO TO 200 005201 00530 NLU = PLU 00540 IF ( NPORT.NE.00 ) NLU = 05 00550 IF ( NPORT.EQ.00 .AND. NLU.EQ.05 ) NLU = 04 00560 IF ( MWAY.EQ.3 ) GO TO 300 00570 IF ( MWAY.EQ.4 ) GO TO 400 005801 00590 100 CONTINUE 00600 IPF = 0 00610 IF ( MWAY.EQ.2 ) IPF = 0 00620 GO TO 800 006301 00640C*** OUTPUT FORCED TO SYSPRT FILE...... 006501 00660 200 CONTINUE 00670 IPF = 1 00680 GO TO 800 006901 00700C*** ASK OPERATOR FROM SCREEN WHICH WAY TO GO....... 007101 00720 300 CONTINUE 00730 IF(NLU.EQ.05.OR.NLU.EQ.04) CALL CCSMVA( CRT,1,8,MSG2,18,12 ) 00740 IF(NLU.EQ.09.OR.NLU.EQ.12) CALL CCSMVA( PRINT,1,8,MSG2,18,12 ) 00750 IF(NLU.EQ.06.OR.NLU.EQ.16) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 00760 IF(NLU.EQ.17.OR.NLU.EQ.18) CALL CCSMVA( TAPE,1,10,MSG2,18,12 ) 007701 00780 CALL WTREAD(05,-1,MSG1 ,36,0,0,0,ITC) 00790 CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 00800 CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 00810 CALL WTREAD(05,-1,MSG4 ,36,0,0,0,ITC) 008201 00830 310 CONTINUE 00840 CALL CCSMVA(INP,1,0,INP,1,82) 00850 CALL WTREAD(05,-1,MSG5 ,36,-1,INP,80,ITC) 00860 IF (ITC.EQ.4) GO TO 310 008701 00880C*** VALIDATE SELECTION.... 008901 00900 CALL CCSGET( INP,1,ICH ) 009101 00920 IF( INP(41).EQ.0 ) GO TO 320 00930 IF ( ICH.LT.$30 .OR. ICH.GT.$31 ) GO TO 310 009401 00950 320 IPF = AND( ICH,$F ) 00960 IF( IPF.EQ.0 ) CALL WTREAD(05,-1,MSG2 ,36,0,0,0,ITC) 00970 IF( IPF.EQ.1 ) CALL WTREAD(05,-1,MSG3 ,36,0,0,0,ITC) 009801 00990 CALL CCSMVA(INP,1,0,INP,1,82) 01000 CALL WTREAD(05,-1,MSGY ,36,-1,INP,80,ITC) 01010 CALL CCSGET(INP,1,ICH) 01020 IF ( INP(41).EQ.0 ) GO TO 330 01030 IF ( ICH.NE.$59 ) GO TO 300 01040 330 CONTINUE 01050 GO TO 800 010601 01070C**** GET 'IWAY' WHAT TO DO FLAG FROM UTIFIL... 010801 01090 400 CONTINUE 01100 CALL GTSYSP( MWAY,73 ) 01110 IF ( MWAY.LT.0 .OR. MWAY.GT.3 ) MWAY = 0 01120 GO TO 10 011301 01140 800 RETURN 01150 END 01160 END/ 00040STIME DCK/ I=13,H 00010STIME HOL/ 00020 SUBROUTINE STIME 00010 1 /CCS 3.0 TIME CHECK SUBROUTINE 00020C 00030C 00040 INTEGER ID(4),LU(1),MODE(1),PORT(1) 00050 INTEGER DY(5,7),MO(5),TU(5),WE(5),TH(5),FR(5),SA(5),SU(5) 00060 EQUIVALENCE (DY(1,1),MO(1)),(DY(1,2),TU(1)),(DY(1,3),WE(1)) 00070 EQUIVALENCE (DY(1,4),TH(1)),(DY(1,5),FR(1)) 00080 EQUIVALENCE (DY(1,6),SA(1)),(DY(1,7),SU(1)) 00090 DATA MO/'MONDAY '/,TU/'TUESDAY '/,WE/'WEDNESDAY '/ 00100 DATA TH/'THURSDAY '/,FR/'FRIDAY '/,SA/'SATURDAY '/ 00110 DATA SU/'SUNDAY '/ 00120C 00130 EXTERNAL AYERTO,AMONTO,ADAYTO,HORTO,MINTO,SECON 00140 EXTERNAL YERTO,MONTO,DAYTO 00150 IYR=AND(AYERTO,$FFFF) 00160 IMN=AND(AMONTO,$FFFF) 00170 IDY=AND(ADAYTO,$FFFF) 00180 IHR=AND(HORTO,$FFFF) 00190 IMI=AND(MINTO,$FFFF) 00200 ISC=AND(SECON,$FFFF) 00210 INYR=AND(YERTO,$FFFF) 00220 INMO=AND(MONTO,$FFFF) 00230 INDY=AND(DAYTO,$FFFF) 00240C 00250 CALL PGMIN(ID,LU,MODE,PORT) 00260C 00270 CALL YMD1(INYR,INMO,INDY,DYCT,IDYYR,IWK) 00280C 00290 WRITE(5,100)(DY(M,IWK),M=1,5),IMN,IDY,IYR,IHR,IMI,ISC, 00300 + (ID(I),I=1,4) 00310 100 FORMAT(/,5A2,X,A2,'/',A2,'/',A2,2X,I2,':',I2,':',I2,3X,'ID=',4A2) 00320C 00330C 00340 RETURN 00350 END 00360 END/ 00040SYSPRT DCK/ I=13,H 00010SYSPRT HOL/ 00020 SUBROUTINE SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 00010 1 /CCS3.0 SUBROUTINE SYSPRT SL-XXX 000201 00030C** CYBERCREDIT FINANCIAL SERVICES. 00040C** CYBERCREDIT FIELD SUPPORT GROUPS 00050C** NEW YORK, ATLANTA, CLEVELAND, CHICAGO, LA JOLLA. 00060C** COPYRIGHT CONTROL DATA CORPORATION, 1982,1983,1984 00070C** 00080C** ************ 04/06/84 ************ PROGRAMMER : RWE 000901 00100C**** PROGRAM DESCRIPTION : OUTPUT BUFFER TO LOGICAL UNIT OR 00110C TO A FILE 'SYSPRT'. 001201 00130C*** CALLING SEQUENCE : CALL SYSPRT( BUFFER,NTIMES,SYSPRM,IOPT ) 001401 00150C PARAMETERS 001601 00170C BUFFER : BUFFER CONTAINING CHARACTERS TO OUTPUT FROM. 00180C NTIMES : # OF TIMES TO OUTPUT THE BUFFER 00190C SYSPRM : 6 WORD ARRAY HOLDING PARAMETERS FOR SYSPRT 00200C SYSPRM(1) : PLN - NUMBER OF BYTES TO OUTPUT FROM BUFFER 00210C SYSPRM(2) : NLU - LOGICAL UNIT TO OUTPUT TO ( IGNORED IF 00220C OUTPUT IS TO FILE ) 00230C SYSPRM(3) : IPF - SWITCH DESIGNATING OUTPUT TO FILE OR LU 00240C 0 = LOGICAL UNIT. 1 = FILE. 2 = BOTH. 00250C SYSPRM(4) : NLINE - CURRENT LINE OR RECORD JUST OUTPUT. 00260C (INITIALIZED TO 0 BY CALLING PROGRAM) 00270C SYSPRM(5) : ISERR - ISTAT OF FILE MANAGER CALL TO FILE 00280C SYSPRM(6) : NU - NOT USED AT PRESENT TIME 00290C IOPT : WHAT TO DO FLAG. 0 = OUTPUT BUFFER TO FILE OR LU 00300C 1 = CLOSE FILE 003101 00320C**** SYSPRT PARAMETERS........ 003301 00340 INTEGER BUFFER(1),NTIMES,IOPT 00350 +, SYSPRM(6),PLN,NLU,IPF,NLINE,ISERR,NU 003601 00370 EQUIVALENCE ( SYSPRM(1),PLN ),( SYSPRM(2),NLU ) 00380 +, ( SYSPRM(3),IPF ),( SYSPRM(4),NLINE ) 00390 +, ( SYSPRM(5),ISERR ),( SYSPRM(6),NU ) 004001 00410C**** FWRITE PARAMETERS..... 00420 INTEGER IFLAG,ITEMP(8) 004301 00440 DATA IFLAG /0/, ITEMP /8*0/ 004501 00460 INTEGER DAT1(15),REQ1(24),R1KY(15),REC1(0068) 00470 +, HEDR(18) 004801 00490 DATA HEDR/$0D0A,$0717,'ABORTED--PRINT FILE IS FULL FN='/ 00500 DATA DAT1 /'SYSPRT ',00,01,-1/,REQ1/24*0/ 00510 +, IOPN/0/ 005201 00530C**** 00540C**** BEGIN PROGRAM ....... 005501 00560 IF ( ISERR.LT.0 ) GO TO 800 00570 ISERR = 0 00580 LINE = NLINE 00590 LU = AND( NLU,$FF ) 00600 LENW = (PLN+1)/2 006101 00620 IF ( IOPT.NE.0 ) GO TO 950 00630 IF ( IPF.EQ.1 ) GO TO 400 00640 IF ( NTIMES.LE.0 ) GO TO 800 006501 00660 IF ( LU.EQ.05 .OR. LU.EQ.04 ) GO TO 20 00670 IF ( LU.EQ.09 .OR. LU.EQ.12 ) GO TO 20 00680 I = LENW 00690 GO TO 40 007001 00710 20 CONTINUE 00720 DO 30 I = LENW, 2, -1 00730 IF ( BUFFER(I).NE.$2020 ) GO TO 40 00740 30 CONTINUE 007501 00760 40 CONTINUE 00770 LENB = I * 2 007801 00790C*** WRITE BUFFER TO LOGICAL UNIT..... 008001 00810 IF ( LU.EQ.05 ) GO TO 140 00820 50 CONTINUE 008301 00840 DO 80 I = 1,NTIMES 008501 00860 ASSIGN 60 TO ICOMP 00870 CALL FWRITE( LU,BUFFER,LENB,ICOMP,IFLAG,ITEMP ) 00880 CALL DISP 00890 60 CONTINUE 009001 00910 80 CONTINUE 00920 GO TO 200 009301 00940C**** WRITE OUTPUT TO TERMINAL (MAX OF 132 BYTES)......... 009501 00960 140 CONTINUE 00970 DO 150 I = 1,NTIMES 009801 00990 ILN = LENB 01000 JLN = LENB 01010 IF ( ILN.GE.80 ) JLN = 80 010201 01030 CALL WTREAD( LU,-1,HEDR,2,0,0,0,ITC ) 01040 CALL WTREAD( LU,-1,BUFFER,JLN,0,0,0,ITC ) 010501 01060 JLN = ILN-80 01070 IF( JLN.LE.0 ) GO TO 150 010801 01090 CALL WTREAD( LU,-1,BUFFER(41),JLN,0,0,0,ITC ) 011001 01110 150 CONTINUE 011201 01130C**** INCREMENT LINE COUNT....... 011401 01150 200 CONTINUE 01160 NLINE = NLINE + NTIMES 01170 GO TO 800 011801 01190C**** WRITE BUFFER TO SYSPRT FILE.......... 012001 01210 400 CONTINUE 01220 IF ( IOPN.EQ.1 ) GO TO 420 012301 01240 DO 410 I = 1,24 01250 REQ1(I) = 0 01260 410 CONTINUE 012701 01280 CALL OPENFL( REQ1,DAT1,ISTAT ) 01290 IF( ISTAT.LT.0 ) GO TO 900 01300 IOPN = 1 013101 01320C**** OUTPUT BUFFER TO SYSPRT FILE.... 013301 01340 420 CONTINUE 01350 IF( NTIMES.LE.0 ) GO TO 800 01360 ILN = PLN 01370 IF( ILN.GT.132 ) ILN = 132 01380 CALL CCSMVA( BUFFER,1,ILN,REC1,1,132 ) 013901 01400 DO 440 I = 1,NTIMES 01410 CALL PUTS( REQ1,REC1,1,ISTAT ) 01420 IF( AND(ISTAT,$9000).EQ.$9000 ) GO TO 500 01430 IF( ISTAT.LT.0 ) GO TO 900 01440 440 CONTINUE 014501 01460 NLINE = NLINE+NTIMES 01470 GO TO 800 014801 01490C**** INFORM OPERATOR FILE IS FULL..... 015001 01510 500 CONTINUE 01520 ISERR = -1 01530 CALL CCSMVA( HEDR,1,36,REC1,1,132 ) 01540 CALL CCSMVA( DAT1,1,24,REC1,37,24 ) 01550 CALL WTREAD( 05,-1,REC1,64,0,0,0,ITC ) 01560 GO TO 950 015701 01580 800 CONTINUE 01590 RETURN 016001 01610C*** ERROR SECTION.... 016201 01630 900 CONTINUE 01640 ISERR = -1 01650 IREQ = AND(REQ1(4),$FF) 01660 IF(IREQ.LT.11) IREQ = IREQ-1 01670 IF(IREQ.EQ.18) IREQ = 10 01680 CALL FILERR( DAT1,IREQ,ISTAT,LU ) 016901 01700C**** CLOSE FILE AND RETURN 017101 01720 950 CONTINUE 01730 CALL CLOSFL( REQ1,ISTAT ) 01740 IOPN = 0 01750 RETURN 01760 END 01770 END/ 00040TIMDIF DCK/ I=13,H 00010TIMDIF HOL/ 00020 SUBROUTINE TIMDIF(TRAN,RECV,DIF,TOTMIN ) 000101 00020 INTEGER TRAN(3), RECV(3), DIF(4), TOTMIN 00030 INTEGER H1,H2,H3, M1,M2,M3, S1,S2,S3 00040 INTEGER T, C 000501 00060 T(JCH)=(JCH/$0100-1R0)*10+AND(JCH-1R0,$00FF) 00070 C(NUM)=(NUM/10+1R0)*$0100+MOD(NUM,10)+1R0 000801 00090 DO 100 I=1,6 00100 CALL CCSGET(TRAN,I,ICH) 00110 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,TRAN) 00120 CALL CCSGET(RECV,I,ICH) 00130 IF ( ICH.EQ.1R ) CALL CCSPUT(1R0,I,RECV) 00140 100 CONTINUE 001501 00160 H1=T(TRAN(1)) 00170 M1=T(TRAN(2)) 00180 S1=T(TRAN(3)) 001901 00200 H2=T(RECV(1)) 00210 M2=T(RECV(2)) 00220 S2=T(RECV(3)) 002301 00240 ITIME=H1*60+M1 00250 JTIME=H2*60+M2 00260 IF ( ITIME.LT.JTIME ) GOTO 200 00270 IF ( (S1.LE.S2) .AND. (ITIME.EQ.JTIME) ) GOTO 200 00280 H2=H2+24 002901 00300 200 S3=S2-S1 00310 IF ( S3.GE.0 ) GOTO 220 00320 S3=S3+60 00330 M2=M2-1 003401 00350 220 M3=M2-M1 00360 IF ( M3.GE.0 ) GOTO 240 00370 M3=M3+60 00380 H2=H2-1 003901 00400 240 H3=H2-H1 00410 TOTMIN = H3*60+M3 00420 DIF(1)=C(H3) 00430 DIF(2)=2H: 00440 DIF(3)=2H : 00450 CALL CCSMVA( C(M3),1,2,DIF,4,2 ) 00460 DIF(4)=C(S3) 00470 RETURN 00480 END 00490 END/ 00040ZCCS56 DCK/ I,H ZCCS57 DCK/ I,H ZCCS58 DCK/ I,H ZCCS59 DCK/ I,H ZCCS60 DCK/ I,H ZCCS61 DCK/ I,H ZCCS62 DCK/ I,H ZCCS63 DCK/ I,H ZCCS64 DCK/ I,H ZCCS65 DCK/ I,H END/ *CTO, *K,I13,L14 *CLOSE *CTO,DECOSY OF CCS ASSEMBLER/FORTRAN PROGRAMS COMPLETE. *Z *Z __ DIF(1)=C(H3) 00430 DIF(2)=2H: 00440 DIF(3)=2H : 00450 CALL CCSMVA( C(M3),1,2,DIF,4,2 ) 00460 DIF(4)=C(S3) 00470 RETURN 00480 END 00490(C < I.FILERRCCS149 P(*JOB,, INSTALL CORRECTIONS 04/23/84 00010*K,L14 00020*CTO, INSTALLING FILERR FROM BNFILERR, CCS149 FILE 00030*OPEN,FN=BNFILERR,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*L,FILERR 00090*Z 00100*K,I13 00110*CLOSE 00120*CTO, SUBROUTINE FILERR HAS BEEN INSTALLED 00130*CTO, 00140*CTO, 00150*CTO, INSTALL C O M P L E T E !!! 00160*Z 00170__ __ DIF(1)=C(H3) 00430 DIF(2)=2H: 00440 DIF(3)=2H : 00450 CALL CCSMVA( C(M3),1,2,DIF,4,2 ) 00460 DIF(4)=C(S3) 00470 RETURN 00480 END 00490( M'  I.FIXINACCS149 P(*JOB,, INSTALL CORRECTIONS 08/23/84 00010*K,L14 00020*CTO, INSTALLING FIXINA FROM B.FIXINA, CCS149 FILE 00030*OPEN,FN=B.FIXINA,OW=CCS149,LU=21,R 00040*REW,21 00050*K,L14 00060*LIBEDT 00070*K,I21,P8 00080*P,F,2 00090*K,I8 00100*N,FIXINA,,,B 00110*Z 00120*K,I13 00130*CLOSE 00140*CTO, PROGRAM FIXINA HAS BEEN INSTALLED 00150*CTO, 00160*CTO, 00170*CTO, INSTALL C O M P L E T E !!! 00180*Z 00190__ DIF(2)=2H: 00440 DIF(3)=2H : 00450 CALL CCSMVA( C(M3),1,2,DIF,4,2 ) 00460 DIF(4)=C(S3) 00470 RETURN 00480 END 00490(F aX.TRENDICCS149 P032883( 00010 ***** THE FOLLOWING INSTRUCTIONS ARE FOR INSTALLING 00020 TREND ANALYSIS AND WRITE OFF REPORT ************ 00030 00040 PLEASE CALL US WHEN YOU RECIEVE THIS MATERIAL !!!!!!! 00050 ********************************************************************** 00060 ********************************************************************** 00070 *** FIRST DO A MANUAL INTERRUPT *BATCH,F TO SET THE BATCH *** 00080 *** PROCESSOR LIST THE FILES $$RPMENU AND PRFRP003 TO THE *** 00090 *** PRINTER IN CASE THEY ARE NOT THE STANDARD VERSIONS *** 00100 *** ALSO DO A UTIL LOAD UNDER $$ FOR FILE $$PROCED *** 00110 *** CARRIAGE RETURN EVERYTHING UNTIL PROMPT THEN TYPE IN *** 00120 *** PRFRP014 PRFRP014 FOLLOWED BY A (CR) THEN *** 00130 *** /! FOLLOWED BY A (CR) *** 00140 *** IF ANY QUESTIONS CALL THE C.A.L. (212)621-9922 *** 00150 ********************************************************************** 00160 ********************************************************************** 00170 00180 LOGON STEP ------------------------------------------------------------ 00190 TO LOGON IT IS ASSUMED THAT THE TERMINAL IS 00200 COMPLETLY LOGGED OFF. 00210 TO LOG ON TYPE A PLUS SIGN FOLLOWED BY A 00220 CARRIAGE RETURN : + (CR) 00230 DATE & TIME 00240 CDC CYBER-18 C C S SYSTEM - VER 3.0 00250 SYSTEM NAME 00260 TERMINAL = NN 00270 USERID = > (ENTER LOGON ID ) 00280 THIS IS THE ID THAT THE REQUEST IS TO 00290 BE PREFORMED UNDER. 00300 00310 **** NOTE: SOME STEPS REQUIRE USER TO BE LOGGED ON 00320 **** TO A CERTAIN ID. IF A FILE CANNOT BE 00330 **** LOCATED OR AN ERROR OCCURS. MAKE SURE 00340 **** YOU ARE LOGGED ON CORRECTLY TO THAT ID. 00350 **** ****** THIS IS IMPORTANT ****** 00360 00370 REQUEST = > (YOU ARE NOW LOGGED ON) 00380 00390 ---------------------------------------------------------------------- 00400 NEXT STEP ------------------------------------------------------------ 00410 *** LOGON USERID MUST BE :CCS149 00420 REQUEST = >UTIL (IF NOT ALREADY DONE) 00430 READY >DELETE 00440 DELETE 00450 FN = >B.TRENDF 00460 VL = > 00470 FILE MAY NOT BE LOCATED THIS IS OK 00480 ---------------------------------------------------------------------- 00490 NEXT STEP ------------------------------------------------------------ 00500 *** LOGON USERID MUST BE :CCS149 00510 REQUEST = >UTIL (IF NOT ALREADY DONE) 00520 READY >DELETE 00530 DELETE 00540 FN = >B.CMPACC 00550 VL = > 00560 FILE MAY NOT BE LOCATED THIS IS OK 00570 ---------------------------------------------------------------------- 00580 NEXT STEP ------------------------------------------------------------ 00590 *** LOGON USERID MUST BE :CCS149 00600 REQUEST = >UTIL (IF NOT ALREADY DONE) 00610 READY >DELETE 00620 DELETE 00630 FN = >B.WRTOFE 00640 VL = > 00650 FILE MAY NOT BE LOCATED THIS IS OK 00660 ---------------------------------------------------------------------- 00670 NEXT STEP ------------------------------------------------------------ 00680 *** LOGON USERID MUST BE :CCS149 00690 REQUEST = >UTIL (IF NOT ALREADY DONE) 00700 READY >DELETE 00710 DELETE 00720 FN = >B.FIXINA 00730 VL = > 00740 FILE MAY NOT BE LOCATED THIS IS OK 00750 ---------------------------------------------------------------------- 00760 NEXT STEP ------------------------------------------------------------ 00770 *** LOGON USERID MUST BE :LIBRARY 00780 REQUEST = >UTIL (IF NOT ALREADY DONE) 00790 READY >DELETE 00800 DELETE 00810 FN = >B.REBILD 00820 VL = > 00830 FILE MAY NOT BE LOCATED THIS IS OK 00840 ---------------------------------------------------------------------- 00850 NEXT STEP ------------------------------------------------------------ 00860 *** LOGON USERID MUST BE :CCS149 00870 REQUEST = >UTIL (IF NOT ALREADY DONE) 00880 READY >DELETE 00890 DELETE 00900 FN = >I.TRENDF 00910 VL = > 00920 FILE MAY NOT BE LOCATED THIS IS OK 00930 ---------------------------------------------------------------------- 00940 NEXT STEP ------------------------------------------------------------ 00950 *** LOGON USERID MUST BE :CCS149 00960 REQUEST = >UTIL (IF NOT ALREADY DONE) 00970 READY >DELETE 00980 DELETE 00990 FN = >I.CMPACC 01000 VL = > 01010 FILE MAY NOT BE LOCATED THIS IS OK 01020 ---------------------------------------------------------------------- 01030 NEXT STEP ------------------------------------------------------------ 01040 *** LOGON USERID MUST BE :CCS149 01050 REQUEST = >UTIL (IF NOT ALREADY DONE) 01060 READY >DELETE 01070 DELETE 01080 FN = >I.WRTOFE 01090 VL = > 01100 FILE MAY NOT BE LOCATED THIS IS OK 01110 ---------------------------------------------------------------------- 01120 NEXT STEP ------------------------------------------------------------ 01130 *** LOGON USERID MUST BE :CCS149 01140 REQUEST = >UTIL (IF NOT ALREADY DONE) 01150 READY >DELETE 01160 DELETE 01170 FN = >I.FIXINA 01180 VL = > 01190 FILE MAY NOT BE LOCATED THIS IS OK 01200 ---------------------------------------------------------------------- 01210 NEXT STEP ------------------------------------------------------------ 01220 *** LOGON USERID MUST BE :LIBRARY 01230 REQUEST = >UTIL (IF NOT ALREADY DONE) 01240 READY >DELETE 01250 DELETE 01260 FN = >I.REBILD 01270 VL = > 01280 FILE MAY NOT BE LOCATED THIS IS OK 01290 ---------------------------------------------------------------------- 01300 NEXT STEP ------------------------------------------------------------ 01310 *** LOGON USERID MUST BE :CCS149 01320 REQUEST = >UTIL (IF NOT ALREADY DONE) 01330 READY >DELETE 01340 DELETE 01350 FN = >TRTRENDP 01360 VL = > 01370 FILE MAY NOT BE LOCATED THIS IS OK 01380 ---------------------------------------------------------------------- 01390 NEXT STEP ------------------------------------------------------------ 01400 *** LOGON USERID MUST BE :CCS20 01410 REQUEST = >UTIL (IF NOT ALREADY DONE) 01420 READY >DELETE 01430 DELETE 01440 FN = >PRFRP003 01450 VL = > 01460 FILE MAY NOT BE LOCATED THIS IS OK 01470 ---------------------------------------------------------------------- 01480 NEXT STEP ------------------------------------------------------------ 01490 *** LOGON USERID MUST BE :CCS20 01500 REQUEST = >UTIL (IF NOT ALREADY DONE) 01510 READY >DELETE 01520 DELETE 01530 FN = >PRFRP014 01540 VL = > 01550 FILE MAY NOT BE LOCATED THIS IS OK 01560 ---------------------------------------------------------------------- 01570 NEXT STEP ------------------------------------------------------------ 01580 *** LOGON USERID MUST BE :$$ 01590 REQUEST = >UTIL (IF NOT ALREADY DONE) 01600 READY >DELETE 01610 DELETE 01620 FN = >$$RPMENU 01630 VL = > 01640 FILE MAY NOT BE LOCATED THIS IS OK 01650 ---------------------------------------------------------------------- 01660 NEXT STEP ------------------------------------------------------------ 01670 01680 REQUEST = >UTIL (IF NOT ALREADY DONE) 01690 READY >RELOAD 01700 RELOAD 01710 FN = >(CR) 01720 OW = >(CR) 01730 VL = >(CR) 01740 I = >TAPE0 OR TAPE1 (WHERE THE TAPE IS MOUNTED) 01750 01760 ---------------------------------------------------------------------- 01770 NEXT STEP ------------------------------------------------------------ 01780 LOGON WITH ANY ID 01790 REQUEST = >UTIL (IF NOT ALREADY DONE) 01800 READY >BATCH 01810 BATCH 01820 FN = >I.TRENDF 01830 OW = >CCS149 01840 VL = >(CR) 01850 HO = >(CR) 01860 TY = >N 01870 01880 01890 01900 ---------------------------------------------------------------------- 01910 NEXT STEP ------------------------------------------------------------ 01920 LOGON WITH ANY ID 01930 REQUEST = >UTIL (IF NOT ALREADY DONE) 01940 READY >BATCH 01950 BATCH 01960 FN = >I.CMPACC 01970 OW = >CCS149 01980 VL = >(CR) 01990 HO = >(CR) 02000 TY = >N 02010 02020 02030 02040 ---------------------------------------------------------------------- 02050 NEXT STEP ------------------------------------------------------------ 02060 LOGON WITH ANY ID 02070 REQUEST = >UTIL (IF NOT ALREADY DONE) 02080 READY >BATCH 02090 BATCH 02100 FN = >I.WRTOFE 02110 OW = >CCS149 02120 VL = >(CR) 02130 HO = >(CR) 02140 TY = >N 02150 02160 02170 02180 ---------------------------------------------------------------------- 02190 NEXT STEP ------------------------------------------------------------ 02200 LOGON WITH ANY ID 02210 REQUEST = >UTIL (IF NOT ALREADY DONE) 02220 READY >BATCH 02230 BATCH 02240 FN = >I.FIXINA 02250 OW = >CCS149 02260 VL = >(CR) 02270 HO = >(CR) 02280 TY = >N 02290 02300 02310 02320 ---------------------------------------------------------------------- 02330 NEXT STEP ------------------------------------------------------------ 02340 LOGON WITH ANY ID 02350 REQUEST = >UTIL (IF NOT ALREADY DONE) 02360 READY >BATCH 02370 BATCH 02380 FN = >I.REBILD 02390 OW = >LIBRARY 02400 VL = >(CR) 02410 HO = >(CR) 02420 TY = >N 02430 02440 02450 02460 ---------------------------------------------------------------------- 02470 NEXT STEP ------------------------------------------------------------ 02480 LOGON WITH ANY ID 02490 REQUEST = >UTIL (IF NOT ALREADY DONE) 02500 READY >BATCH 02510 BATCH 02520 FN = >TRTRENDP 02530 OW = >CCS149 02540 VL = >(CR) 02550 HO = >(CR) 02560 TY = >R 02570 02580 02590 02600 ---------------------------------------------------------------------- 02610 02620***************************************************************** 02630***************************************************************** 02640 02650**** I M P O R T A N T !!!!!!!!! **** 02660 02670 WHEN BATCHING IS COMPLETE AND THE PROGRAMS HAVE BEEN 02680 TESTED YOU MAY THEN COMPLETE THE FOLLOWING. 02690****** 02700****** 02710****** 02720 NEXT STEP ------------------------------------------------------------ 02730 *** LOGON USERID MUST BE :CCS149 02740 REQUEST = >UTIL (IF NOT ALREADY DONE) 02750 READY >DELETE 02760 DELETE 02770 FN = >B.TRENDF 02780 VL = > 02790 FILE MAY NOT BE LOCATED THIS IS OK 02800 ---------------------------------------------------------------------- 02810 NEXT STEP ------------------------------------------------------------ 02820 *** LOGON USERID MUST BE :CCS149 02830 REQUEST = >UTIL (IF NOT ALREADY DONE) 02840 READY >DELETE 02850 DELETE 02860 FN = >B.CMPACC 02870 VL = > 02880 FILE MAY NOT BE LOCATED THIS IS OK 02890 ---------------------------------------------------------------------- 02900 NEXT STEP ------------------------------------------------------------ 02910 *** LOGON USERID MUST BE :CCS149 02920 REQUEST = >UTIL (IF NOT ALREADY DONE) 02930 READY >DELETE 02940 DELETE 02950 FN = >B.WRTOFE 02960 VL = > 02970 FILE MAY NOT BE LOCATED THIS IS OK 02980 ---------------------------------------------------------------------- 02990 NEXT STEP ------------------------------------------------------------ 03000 *** LOGON USERID MUST BE :CCS149 03010 REQUEST = >UTIL (IF NOT ALREADY DONE) 03020 READY >DELETE 03030 DELETE 03040 FN = >B.FIXINA 03050 VL = > 03060 FILE MAY NOT BE LOCATED THIS IS OK 03070 ---------------------------------------------------------------------- 03080 NEXT STEP ------------------------------------------------------------ 03090 *** LOGON USERID MUST BE :LIBRARY 03100 REQUEST = >UTIL (IF NOT ALREADY DONE) 03110 READY >DELETE 03120 DELETE 03130 FN = >B.REBILD 03140 VL = > 03150 FILE MAY NOT BE LOCATED THIS IS OK 03160 ---------------------------------------------------------------------- 03170 NEXT STEP ------------------------------------------------------------ 03180 *** LOGON USERID MUST BE :CCS149 03190 REQUEST = >UTIL (IF NOT ALREADY DONE) 03200 READY >DELETE 03210 DELETE 03220 FN = >I.TRENDF 03230 VL = > 03240 FILE MAY NOT BE LOCATED THIS IS OK 03250 ---------------------------------------------------------------------- 03260 NEXT STEP ------------------------------------------------------------ 03270 *** LOGON USERID MUST BE :CCS149 03280 REQUEST = >UTIL (IF NOT ALREADY DONE) 03290 READY >DELETE 03300 DELETE 03310 FN = >I.CMPACC 03320 VL = > 03330 FILE MAY NOT BE LOCATED THIS IS OK 03340 ---------------------------------------------------------------------- 03350 NEXT STEP ------------------------------------------------------------ 03360 *** LOGON USERID MUST BE :CCS149 03370 REQUEST = >UTIL (IF NOT ALREADY DONE) 03380 READY >DELETE 03390 DELETE 03400 FN = >I.WRTOFE 03410 VL = > 03420 FILE MAY NOT BE LOCATED THIS IS OK 03430 ---------------------------------------------------------------------- 03440 NEXT STEP ------------------------------------------------------------ 03450 *** LOGON USERID MUST BE :CCS149 03460 REQUEST = >UTIL (IF NOT ALREADY DONE) 03470 READY >DELETE 03480 DELETE 03490 FN = >I.FIXINA 03500 VL = > 03510 FILE MAY NOT BE LOCATED THIS IS OK 03520 ---------------------------------------------------------------------- 03530 NEXT STEP ------------------------------------------------------------ 03540 *** LOGON USERID MUST BE :LIBRARY 03550 REQUEST = >UTIL (IF NOT ALREADY DONE) 03560 READY >DELETE 03570 DELETE 03580 FN = >I.REBILD 03590 VL = > 03600 FILE MAY NOT BE LOCATED THIS IS OK 03610 ---------------------------------------------------------------------- 03620 NEXT STEP ------------------------------------------------------------ 03630 *** LOGON USERID MUST BE :CCS149 03640 REQUEST = >UTIL (IF NOT ALREADY DONE) 03650 READY >DELETE 03660 DELETE 03670 FN = >TRTRENDP 03680 VL = > 03690 FILE MAY NOT BE LOCATED THIS IS OK 03700 ---------------------------------------------------------------------- 03710 03720 03730 *********** PLEASE CALL US IF THERE ARE ANY QUESTIONS 03740 ABOUT THESE PROCEDURES ! 03750 AT THE CUSTOMER ASSISTANCE LINE (212)621-9922 03760 ----------------------------------------------------------------------- 03770  __ ('( U.RTVDT1CCS149 P(RTVDT1 DCK/ I,H<m BNGTSYSPCCS149 x082784082784< PdGTSYSP CCS3.0 SUBROUTINE GTSYSP SL-XXX @P@P1P@P3@P,SYSP@P4 T,/0 T1 hT2l@PV H TTh\hPGTSYSPXPQ8PKUP^Q8PREP[GETUTI9CCSMVACCCSGETMP __ 00170_ __ ( U7 J.RSWCHGCCS149 P(*JOB,,TWB.JOB RSWCHG INSTALL 08/23/84 00010*K,L14 00020*CTO, RSWCHG WEAVED AS OF 08/23/84 00030*CTO, 00040*CTO, IS NOW BEING COMPILED TO B.RSWCHG , CCS149 00050*K,L2 00060*OPEN,FN=C.CCSAP,OW=CCS149,LU=20,R 00070*OPEN,FN=B.RSWCHG,OW=CCS149,LU=21,W 00080*REW,20,21,7 00090*K,I13 00100*CSY,I20,P7 00110*COSY 00120RSWCHG DCK/ I=13,H 00130RSWCHG HOL/ 00140 PROGRAM RSWCHG 00150 1 /XXX F CCS CCS3.0 .LA LKL07 SL-XXX 001601 00170C THIS PROGRAM IS TO CHECK EVERY RECORD IN THE TRANSACTION FILE 00180C FOR ANY CHANGE OF AN ACCOUNT'S STATUS CODE. FOR THOSE ACCOUNTS 00190C WHOSE STATUS CODES ARE CHANGED, THE DELQMST RECORD IS UPDATED 00200C WITH THE SYSTEM DATE IN LAST HOST UPDATE FIELD. 00210C 00220C THE SCAN OF THE TRANSACTION FILE WILL LOOK FOR NON-FINANCIAL 00230C UPDATE RECORDS (TYPE = '02') AND CHECK FOR UPDATE CODES MATCH- 00240C ING THE CODE ASSIGNED TO STATUS CODE ON THE SUPERVISOR'S 00250C CHANGE SCREEN. THE UPDATE CODE FOR STATUS CODE CHANGES IS 00260C DETERMINED VIA THE SYSTEM MODULE 'GETCHF' (IN PROGRAM LIBRARY 00270C IN RELOCATABLE FORM). THIS ROUTINE HAS THE FOLLOWING CALLING 00280C SEQUENCE: 00290C CALL GETCHF(SCREEN,XXXCHG) 00300C WHERE 00310C SCREEN = CHANGE SCREEN TEMPLATE RETRIEVED FROM THE SCREEN 00320C FILE ('SCRNFILE'). 00330C XXXCHG = IS A 3*N+1 ARRAY WHERE N IS THE MAXIMUM NUMBER OF 00340C ITEMS THAT CAN APPEAR ON THE CHANGE SCREEN. INI- 00350C TIALLY, XXXCHG MUST BE SET AS FOLLOWS: 00360C WORD 1 = -N 00370C ALL OTHER WORDS ARE TO BE SET TO ZERO. 00380C ON RETURN, XXXCHG HAS THE FOLLOWING MEANING: 00390C WORD 1 = N 00400C WITH REMAINING WORDS GROUPED INTO THREES: 00410C WORD 1 = X-Y POSITION OF CHANGE FIELD ON 00420C SCREEN. 00430C WORD 2 = LENGTH OF CHANGE ITEM (BITS 15 THR 00440C 4) AND FIELD TYPE (BITS 3 THRU 0) 00450C WORD 3 = STARTING POSITION IN FILE RECORD. 00460C THE THREE WORDS DESCRIBING CHANGE ITEM 'XX' (THE NUMBER 00470C KEYED TO CHANGE THE FIELD) ON THE CHANGE SCREEN IS FOUND 00480C IN THE FOLLOWING WORDS IN XXXCHG: 00490C WORD 3* 'XX' -1 = X-Y POSITION. 00500C 3* 'XX' = LENGTH AND FIELD TYPE. 00510C 3* 'XX' +1 = FILE POSITION. 00520C TO OBTAIN THE UPDATE CODE USED TO REPORT ANY TRANSACTION TO 00530C THE TRANSACTION FILE, TAKE THE ITEM NUMBER ASSIGNED TO THE 00540C FIELD ON THE CHANGE SCREEN AND ADD THE FOLLOWING BIAS 00550C (DEPENDENT ON SCREEN): 00560C SCREEN BIAS 00570C CUSTOMER CHANGE 0 00580C COSIGNER CHANGE 30 00590C SUPERVISOR CHANGE 60 00600C THE FOLLOWING RESTRICTIONS APPLY ON THE MAXIMUM NUMBER OF 00610C ITEMS (AND MAXIMUM ITEM NUMBER IN CASE OF NON-SEQUENTIAL NUM- 00620C BERING OF ITEMS ON CHANGE SCREEN) THAT CAN APPEAR ON THE 00630C CHANGE SCREENS: 00640C SCREEN MAX (N) 00650C CUSTOMER CHANGE 30 00660C COSIGNER CHANGE 30 00670C SPERVISOR CHANGE 20 006802 00690C FILE MANAGER REQUEST AND DATA BUFFERS. 007003 00710C SCREEN FILE. 007201 00730 INTEGER REQBFS(24) , IDATAS(15) , SRNREC(1002) 007401 00750 DATA REQBFS / 24*0 / 00760C FILE ACCESS BY KEY 1, ONE RECORD PER RETRIEVE AND NO LOCKING. 00770 DATA IDATAS / 'LASCNFIL' , 8*$2020 , 1 , 1 , 0 / 007802 00790C TRANSACTION FILE. 008001 00810 INTEGER REQBFT(24) , IDATAT(15) , TRNREC(03452) , TRECLN 00820C*NOTE: RECORD SIZE = 69 WORDS. SPACE ALLOCATED FOR 50- 02/83*** 008301 00840 DATA REQBFT / 24*0 / 00850C FILE ACCESS SEQUENTIAL BY RELATIVE RECORD NUMBER, 50 RECORDS 00860C PER RETRIEVE AND NO LOCKING. 00870 DATA IDATAT / 'LATRNSFL' , 8*$2020 , 0 , 50, 0 / 00880C RECORD LENGTH = 69 WORDS. 00890 DATA TRECLN / 69 / 009002 00910C*************************************************** RSWFIL MODS 9/80 ** 00920 INTEGER DEQREQ(24),DEQDAT(15),DEQREC(1004),KEY1(9),WRSB(2) 00930 INTEGER ACCREQ(24),ACCDAT(15),ACCREC(44),A99X(2,3),A999(2) 00940 INTEGER RSWREQ(24),RSWDAT(15),RSWREC(44),A998(2),A997(2) 009501 00960 EQUIVALENCE (A997(1),A99X(1,1)),(A998(1),A99X(1,2)) , 00970 + (A999(1),A99X(1,3)),(ACCREC(1),RSWREC(1)) 00980 DATA WRSB / 'WRS ' / , A997 /'997 '/ , A998 /'998 '/ ,A999/'999 '/ 00990 DATA DEQREQ/24*0/,DEQDAT/'LADLQMST ',1,1,0/ 01000 DATA ACCREQ/24*0/,ACCDAT/'LAACCAGE ',1,1,0/ 01010 DATA RSWREQ/24*0/,RSWDAT/'LARSWFIL ',0,1,0/ 010201 01030 INTEGER SCNDAT(4),DLQDAT(4) 01040 DATA SCNDAT/'SCRNFILE'/,DLQDAT/'DELQMST '/ 01050C 01060C 01070C*************************************************** ---------------- ** 010803 01090C SUPERVISOR SCREEN NUMBER. 01100 INTEGER SUPSCN 01110 DATA SUPSCN / 35 / 011201 01130C SUPERVISOR SCREEN CHANGE ITEM DESCRIPTION ARRAY. 01140 INTEGER SUPCHG(61) 01150 DATA SUPCHG / -20 , 60*0 / 011601 01170C STATUS CODE FILE POSITION IN MASTER FILE. 01180 INTEGER STCDFP 01190 DATA STCDFP / 306 / 012001 01210C NON-FINANCIAL RECORD TYPE CODE. 01220 INTEGER NFUPCD 01230 DATA NFUPCD / '02' / 012401 01250C BIAS FOR TRANSACTIONS FROM SUPERVISOR CHANGE SCREEN. 01260 INTEGER SUPBAS 01270 DATA SUPBAS / 60 / 012801 01290C STARTING WORD POSITION (RELATIVE TO WORD 1) IN TRANSACTION 01300C FILE FOR RECORD TYPE AND UPDATE CODE. 01310 INTEGER RECTYP , UPDCOD 01320 DATA RECTYP / 14 / , UPDCOD / 15 / 01330C STARTING BYTE POSITION IN TRANSACTION FILE RECORD FOR NEW DATA 01340C ON NON-FINANCIAL UPDATE TRANSACTIONS. 01350 INTEGER NEWDAT 01360 DATA NEWDAT / 33 / 013701 01380C FIELD POSITIONS INACTIVE ACCOUNTS FILE FOR 01390C STATUS CODE AND DATE. 01400 INTEGER STATPS, DATPOS 01410 DATA STATPS / 17 /, DATPOS / 19 / 014201 01430C NUMERIC CONSTANTS. 01440 INTEGER ZERO , ONE , TWO , SIX , NUMLEN 01450 DATA ZERO / 0 / , ONE / 1 / , TWO / 2 / , SIX / 6 / , 01460 1 NUMLEN / 16 / 014701 01480C FILE MANAGER STATUS CONIDERATIONS ON RETRIEVES. 01490 INTEGER EOF , WRONKY 01500 DATA EOF / $100 / , WRONKY / $200 / 015101 01520C DUMMY VARIABLE. 01530 INTEGER DUMMY 015401 01550C CONSOLE MESSAGE FOR STATUS CODE NOT FOUND ON SUPERVISOR 01560C SCREEN. 01570 INTEGER XYN , NOSTAT(29) , MESLEN 01580 DATA XYN / -1 / 01590 DATA NOSTAT / 'ERROR - STATUS CODE NOT FOUND ON SUPERVISOR CHANGE 01600 1SCREEN.' / 01610 DATA MESLEN / 58 / 016203 01630C EQUIVALENCES FOR NUMBER OF RECORDS RETRIEVED PER 'GETS' 01640C REQUESTS FROM TRANSACTION FILE, MAXIMUM NUMBER OF RECORDS TO 01650C RETRIEVE, AND NUMBER OF ITEMS ON SUPERVISOR CHANGE SCREEN. 01660 INTEGER NUMREC , MAXREC , NITEM 01670 EQUIVALENCE ( NUMREC , REQBFT(15) ) , ( MAXREC , IDATAT(14) ) , 01680 1 ( NITEM , SUPCHG(1) ) 016903 01700C OTHER DECLARATIONS. 01710 INTEGER ID(4) , TUPCOD , DATE(3) , AMONTO , ADAYTO , AYERTO 01720 EXTERNAL AMONTO , ADAYTO , AYERTO 01730. 01740C RETRIEVE SYSTEM DATE. 01750 DATE(1) = AND($FFFF,AMONTO) 01760 DATE(2) = AND($FFFF,ADAYTO) 01770 DATE(3) = AND($FFFF,AYERTO) 017803 01790C CCS LOGIN. PROGRAM USAGE RESTRICTED TO MASTER CONSOLE. EXIT 01800C IF USER NOT ON MASTER CONSOLE. 01810 100 CALL PGMIN(ID,LU,I,J) 01820 IF(J.NE.0) GO TO 900 01830 CALL CCSCST(IDATAT,1,2,ID,1,8,ICM) 01840 IF(ICM.EQ.0) GO TO 105 01850 CALL CCSMVA(SCNDAT,1,8,IDATAS,1,8) 01860 CALL CCSMVA(DLQDAT,1,8,DEQDAT,1,8) 01870 CALL CCSMVA(IDATAT,3,6,IDATAT,1,8) 01880 CALL CCSMVA(ACCDAT,3,6,ACCDAT,1,8) 01890 CALL CCSMVA(RSWDAT,3,6,RSWDAT,1,8) 01900 105 CONTINUE 019101 01920C LOGIN VERIFIED. OPEN SCREEN FILE AND RETRIEVE SUPERVISOR 01930C SCREEN TEMPLATE. 01940 CALL OPENFL(REQBFS,IDATAS,ISTAT) 01950C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF ERROR. 01960 IF(ISTAT.LT.0) GO TO 300 01970C NO ERROR, RETRIEVE TEMPLATE. 01980 CALL READR(REQBFS,SRNREC,SUPSCN,ISTAT) 01990C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF ERROR. 02000 IF(ISTAT.LT.0 .OR. AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 310 02010C NO ERROR, CLOSE FILE AND RETRIEVE SUPERVISOR CHANGE SCREEN 02020C ITEM FIELD DESCRIPTIONS. 02030 CALL CLOSFL(REQBFS,ISTAT) 020401 02050 CALL GETCHF(SRNREC,SUPCHG) 020602 02070C SCAN 'SUPCHG' ARRAY CHECKING EVERY THIRD WORD (FILE POSITION 02080C OF CHANGE ITEM) STARTING WITH WORD FOUR FOR MATCH WITH START- 02090C ING POSITION OF STATUS CODE. 02100 DO 120 I=1,NITEM 02110C CALCULATE POINTER TO NEXT WORD CONTAINING FILE POSITION. 02120 J = 3*I + 1 02130C CHECK FOR MATCH WITH STATUS CODE POSITION. CONTINUE TO NEXT 02140C FIELD IF NO MATCH. 02150 IF(SUPCHG(J).NE.STCDFP) GO TO 120 021601 02170C MATCH FOUND. ADD BIAS TO CHANGE ITEM NUMBER AND CONVERT THAT 02180C NUMBER TO ASCII DECIMAL REPRESENTATION FOR CHECKING WITH 02190C TRANSACTION FILE RECORD FIELD 'TYPE UPDATE CODE'. 02200 TUPCOD = I + 60 02210 TUPCOD = (TUPCOD/10)*$100 + TUPCOD-( (TUPCOD/10)*10 ) + $3030 02220C GO SCAN TRANSACTION FILE. 02230 GO TO 200 022401 02250C CONTINUE SCAN OF 'SUPCHG' ARRAY. 02260 120 CONTINUE 022702 02280C STATUS CODE NOT FOUND ON SUPERVISOR SCREEN. EXIT PROGRAM 02290 GO TO 800 02300. 02310C PROCESS ALL RECORDS FROM TRANSACTION FILE AND FOR A CHANGE 02320C TO THE STATUS CODE ON AN ACCOUNT, IF FOUND CHANGE DATE LAST 02330C UPDATE FROM HOST TO SYSTEM DATE.(DATE ACCOUNT WENT INACTIVE) 023403 02350C OPEN TRANSACTION FILE AND INACTIVE ACCOUNTS FILE. 02360 200 CALL OPENFL(REQBFT,IDATAT,ISTAT) 02370C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF ERROR. 02380 IF(ISTAT.LT.0) GO TO 330 02390C*************************************************** RWSFIL MODS 9/80 ** 02400C 02410 CALL OPENFL(DEQREQ,DEQDAT,ISTAT) 02420 IF (ISTAT.GE.0)GO TO 201 02430 CALL FILERR(DEQDAT,3,ISTAT,LU) 02440 GO TO 800 02450 201 CALL OPENFL(ACCREQ,ACCDAT,ISTAT) 02460 IF (ISTAT.GE.0)GO TO 202 02470 CALL FILERR(ACCDAT,3,ISTAT,LU) 02480 GO TO 800 02490 202 CALL OPENFL(RSWREQ,RSWDAT,ISTAT) 02500 IF (ISTAT.GE.0)GO TO 203 02510 CALL FILERR(RSWDAT,3,ISTAT,LU) 02520 GO TO 800 02530 203 CONTINUE 02540C 02550C 02560C*************************************************** ---------------- ** 025701 02580C RETRIEVE NEXT BLOCK OF RECORDS FROM TRANSACTION FILE. 02590 210 CALL GETS(REQBFT,TRNREC,DUMMY,ISTAT) 02600C CHECK FOR ERROR. JUMP TO ERROR ROUTINE IF FATAL ERROR. 02610 IF(ISTAT.LT.0) GO TO 340 026201 02630C NO ERROR. LOOP THRU ALL RECORDS RETRIEVED (NUMBER RETRIEVED 02640C RETURNED IN WORD 15 OF REQUEST BUFFER). LOOK FOR TRANSACTIONS 02650C CHANGING AN ACCOUNT'S STATUS CODE. 02660 DO 220 I=1,NUMREC 02670C CALCULATE POINTER TO START WORD OF NEXT TRANSACTION RECORD. 02680 J = TRECLN*(I-1) + 1 026901 02700C BYPASS RECORD IF RECORD TYPE IS NOT '02'. (BYPASSES ALL COL- 02710C LECTOR ACTIVITIES). 02720 K = J + RECTYP 02730 IF(TRNREC(K).NE.NFUPCD) GO TO 220 02740C FOUND NON-FINANCIAL UPDATE RECORD. BYPASS IF CHANGE WAS NOT TO 02750C STATUS CODE OF ACCOUNT. 02760 K = J + UPDCOD 02770 IF(TRNREC(K).NE.TUPCOD) GO TO 220 02780C*************************************************** RSWFIL MODS 9/80 ** 027901 02800 500 CONTINUE 02810 CALL CCSMVA(TRNREC(J),1,16,KEY1,1,16) 02820 CALL READR (DEQREQ,DEQREC,KEY1,ISTAT) 02830 IF (AND(ISTAT,$300).NE.0 ) GO TO 215 02840 IF (ISTAT.GE.0)GO TO 520 02850 CALL FILERR(DEQDAT,13,ISTAT,LU) 02860 GO TO 800 02870 520 CONTINUE 02880 DO 530 KP=1,4 02890 CALL CCSCST(DEQREC,306,1,WRSB,KP,1,IC) 02900 IF (IC.EQ.0) GO TO (550,550,550,540),KP 02910 530 CONTINUE 02920 GO TO 215 029301 02940 540 CONTINUE 02950 CALL CCSMVA(DEQREC,1,16,ACCREC,1,82) 02960 CALL WRITER(ACCREQ,ACCREC,ACCREC,ISTAT) 02970 IF (ISTAT.GE.0.OR.AND(ISTAT,$10).EQ.$10)GO TO 215 02980 CALL FILERR(ACCDAT,12,ISTAT,LU) 02990 GO TO 800 03000C*** UPDATE DELQMST RECORD WITH SYSTEM DATE IN POS. 857 03010 550 CONTINUE 03020 CALL CCSMVA( DATE, 1, 6, DEQREC, 857, 6 ) 03030 CALL UPDREC( DEQREQ, DEQREC, ISTAT ) 03040 IF ( ISTAT.GE.0 ) GO TO 555 03050 CALL FILERR( DEQDAT, 15, ISTAT, LU ) 030601 03070 555 CALL CCSMVA(DEQREC,1,16,ACCREC,1,82) 03080 CALL READR (ACCREQ,ACCREC,ACCREC,ISTAT) 03090 IF (AND(ISTAT,$200).EQ.$200.OR.AND(ISTAT,$100).EQ.$100)GO TO 215 03100 IF (ISTAT.GE.0)GO TO 560 03110 CALL FILERR(ACCDAT,13,ISTAT,LU) 03120 GO TO 800 03130 560 CONTINUE 03140 CALL DELREC(ACCREQ,ACCREC,ISTAT) 03150 IF(ISTAT.GE.0)GO TO 570 03160 CALL FILERR(ACCDAT,16,ISTAT,LU) 03170 GO TO 800 03180 570 ACCREC(1) = DEQREC(1) 03190C*** 03200C UPDATE PREVIOUS FEILDS 03210 CALL CCSMVA(ACCREC,17,4,ACCREC,21,4) 03220 CALL CCSMVA(ACCREC,35,3,ACCREC,38,3) 03230 CALL CCSMVA(ACCREC,41,9,ACCREC,50,9) 03240 CALL CCSMVA(ACCREC,59,9,ACCREC,68,9) 03250C*** 03260C NEW VALUES FROM MASTER RECORD 03270 CALL CCSMVA(DEQREC,271,4,ACCREC,17,4) 03280 CALL CCSMVA(A99X(1,KP),1,3,ACCREC,35,3) 03290 CALL CCSMVA(DEQREC,905,9,ACCREC,41,9) 03300 CALL CCSMVA(DEQREC,887,9,ACCREC,59,9) 03310 CALL CCSMVA(DEQREC,963,4,ACCREC,25,4) 03320 CALL CCSPUT(WRSB(KP),77,ACCREC) 03330C 03340 CALL PUTS (RSWREQ,ACCREC,ONE,ISTAT) 03350 IF (ISTAT.GE.0) GO TO 215 03360 CALL FILERR(RSWDAT,11,ISTAT,LU) 03370 GO TO 800 03380 215 CONTINUE 033901 03400C*************************************************** ---------------- ** 034101 03420C*** PSR 12/83 REMOVE CODE TO CREATE INACCT RECORD 034301 03440C*** INACCT FILE IS NOW HANDLED BY FIXINA WHICH SHOULD BE 03450C RUN BEFORE RUNNING MHUPDT. 034601 03470C*** CARDS DELETED HERE.... 034801 03490C PROCESS NEXT TRANSACTION. 03500 220 CONTINUE 035103 03520C ALL TRANSACTIONS FROM THIS BLOCK PROCESSED. CHECK IF THIS IS 03530C THE LAST BLOCK FROM TRANSACTION FILE. IF NOT, GET NEXT BLOCK. 03540 IF(NUMREC.GE.MAXREC) GO TO 210 035501 03560C LAST BLOCK PROCESSED. ALL TRANSACTIONS FROM TRANSACTION FILE 03570C HAVE BEEN CHECKED. CLOSE ALL FILES AND EXIT. 03580 GO TO 800 03590. 03600C*********************************************************************** 03610C FILE ERROR PROCESSING ROUTINES. * 03620C*********************************************************************** 036303 03640C FILE ERROR USING 'SCRNFILE'. 036502 03660C OPEN FILE REQUEST. 03670 300 J = 3 03680 GO TO 320 036901 03700C READR REQUEST. 03710 310 J = 13 037201 03730C REPORT ERROR, CLOSE ALL FILES AND EXIT. 03740 320 CALL FILERR(IDATAS,J,ISTAT,LU) 03750 GO TO 800 037603 03770C FILE ERROR USING 'TRNSFL'. 037802 03790C OPEN FILE REQUEST. 03800 330 J = 3 03810 GO TO 350 038201 03830C GETS REQUEST. CHECK FOR END-OF-FILE INDICATING ALL TRANS- 03840C ACTIONS HAVE BEEN PROCESSED AND JOB IS COMPLETE. IF END- 03850C OF-FILE, CLOSE ALL FILES AND EXIT. 03860 340 IF(AND(ISTAT,EOF).EQ.EOF) GO TO 800 03870C NO END-OF-FILE, FATAL ERROR. 03880 J = 14 038901 03900C REPORT ERROR, CLOSE ALL FILES AND EXIT. 03910 350 CALL FILERR(IDATAT,J,ISTAT,LU) 03920 GO TO 800 039303 03940C*** PSR 12/83 CARDS DELETED HERE..... 03950. 03960C EXIT SECTION. CLOSE ALL FILES 039702 03980C 'SCRNFILE'. 03990 800 CALL CLOSFL(REQBFS,ISTAT) 04000C*************************************************** RSWFIL MODS 9/80 ** 04010C 'DELQMST' 04020 CALL CLOSFL(DEQREQ,ISTAT) 04030C 'ACCAGE' 04040 CALL CLOSFL(ACCREQ,ISTAT) 04050C 'RSWFIL' 04060 CALL CLOSFL(RSWREQ,ISTAT) 04070C 04080C*************************************************** ---------------- ** 04090C 'TRNSFL'. 04100 CALL CLOSFL(REQBFT,ISTAT) 04110C*** PSR 12/83 CARD DELETED HERE..... 041202 04130C RETURN CONTROL TO CCS EXECUTIVE. 04140 900 CALL PGMOUT 041501 04160 END 04170 END/ 04180 END/ 04190*REW,7 04200*K,I7,P21,L14 04210*FTN 04220*EOF 04230*CLOSE 04240*K,I13,L14 04250*Z 04260*Z 04270__ CALL CLOSFL(DEQREQ,ISTAT) 04030C 'ACCAGE' 04040 CALL CLOSFL(ACCREQ,ISTAT) 04050C 'RSWFIL' 04060 CALL CLOSFL(RSWREQ,ISTAT) 04070C 04080C*************************************************** ---------------- ** 04090C 'TRNSFL'. 04100 CALL CLOSFL(REQBFT,ISTAT) 04110C*** PSR 12/83 CARD DELETED HERE..... 041202 04130C RETURN CONTROL TO CCS EXECUTIVE. 04140 900 CALL PGMOUT 041501 04160 END 04170 END/ 04180 END/ 04190*REW,7 04200*K,I7,P21,L14 04210*FTN 04220*EOF 04230*CLOSE 04240*K,I13,L14 04250