‚MON01 CSY/ 00020 ‚‚1 OPT LPC_]_^__ ‚‚LEGAL CSY/ E01 0020 ‚‚1_%NAM LEGAL_(E01 A LA_!CCS 3.0_5SL-149_^1*_]_^1*_$LEGAL AND AGENCY SYSTEM VERSION 3_8C17_^1*_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1*_$COPYRIGHT CONTROL DATA CORPORATION, 1979_^1*_]_^1*_]_^1*_$DUMMY PROGRAM TO JUMP AROUND LABELED COMMON_^1*_]_^1_%ENT LEGAL_^1_%EXT FLEGAL_^1LEGAL JMP FLEGAL_.JUMP TO THE FORTRAN MAIN MODULE_^1_%END_]_^__ ‚‚LPGGEN CSY/ E02 ‚‚1_%NAM LPGGEN_'E02 A LA_!CCS 3.0_5SL-149_^1*_$LEGAL AND AGENCY SYSTEM VERSION 3_^1*_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1*_$COPYRIGHT CONTROL DATA CORPORATION, 1979_^1*_]_^1*_]_^1*_$DUMMY PROGRAM TO JUMP AROUND LABELED COMMON_^1*_]_^1***********************************************************138**L/A_^1_%ENT LPGGEN_^1_%EXT LPGEN0_^1LPGGEN JMP LPGEN0_'JUMP T ‚‚O FORTRAN MAIN MODULE_^1_%END_]_^__ ‚‚LUD400 CSY/ 00010 ‚‚1_%NAM LUD400_'E03 A LA_!CCS 3.0_5SL-149_^1*_$LUD400 ENTRY POINT TO JUMP AROUND LABELLED COMMON - L/A VERSION_^1*_$CYBERCREDIT SYSTEM VERSION 3_^1*_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1*_$COPYRIGHT CONTROL DATA CORPORATION, 1979_^1*_]_^1_%ENT LUD400_^1_%EXT FUPD4X_'MAIN PROCESSOR MODULE._^1_%SPC 1_^1LUD400 JMP FUPD4X_'PASS CONTROL TO MAIN PROCESSOR._^1_%SP ‚‚C 1_^1_%END_]_^__ ‚‚LUPDAT CSY/ E04 0010 ‚‚1_%NAM LUPDAT_'E04 A LA_!CCS 3.0_5SL-149_^1*_$LUPDAT ENTRY POINT TO JUMP AROUND LABELLED COMMON (*L/A*)_^1*_$LEGAL AND AGENCY SYSTEM VERSION 3_^1*_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1*_$COPYRIGHT CONTROL DATA CORPORATION, 1979_^1*_]_^1_%ENT LUPDAT_^1_%EXT LAFUPD_+MAIN PROCESSOR MODULE._^1_%SPC 1_^1LUPDAT JMP LAFUPD_*PASS CONTROL TO MAIN PROCESSOR._^1_%SPC ‚‚ 1_^1_%END_]_^__ ‚‚LUD500 CSY/ 17850 ‚‚1_%NAM LUD500_'E05 A LA_!CCS 3.0_5SL-149_^1*_$CYBERCREDIT SYSTEM VERSION 3_^1*_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1*_$COPYRIGHT CONTROL DATA CORPORATION, 1979_^1*_]_^1*_$LUD500 BRANCH PROCESSOR_^1*_]_^1*_$THIS ROUTINE IS THE ENTRY PROCESSOR FOR LUD500, FINANCIAL UPDATE_^1*_$PROCESSING FOR LEGAL AND AGENCY. THE ONLY FUNCTION OF THIS_^1*_$ROUTINE IS TO DETERMI ‚‚NE IF TAPE INPUT IS ASCII OR EBCDIC FORMAT,_^1*_$AS SELECTED BY EXTERNAL SWITCH U1, AND BRANCH TO THE APPROPRIATE_^1*_$RPG VERSION OF THE UPD500 PROCESSOR. THE SWITCH VALUES ARE IN_^1*_$CORE LOCATION $E3 AND ARE MODIFIED BY THE SWITCH UTILITY._^1*_]_^1_%SPC 2_^1*_$ENTRY POINTS._^1_%ENT LUD500_^1_%SPC 1_^1*_$EXTERNALS._^1_%EXT CHAIN_(CCS EXECUTIVE CHAIN REQUEST PROCESSOR._^1_%S ‚‚PC 1_^1*_$COMMUNICATIONS REGION USED._^1_%EQU ONEBIT($23)_^1_%SPC 1_^1*_$OTHER EQUIVALENCES._^1_%EQU SWITCH($E3)_!CORE LOCATION OF EXTERNAL SWITCH. **NOTE: IF_^1*_8THIS LOCATION IS CHANGED FOR RPG, IT MUST BE_^1*_8CHANGED HERE ALSO._^1_%SPC 3_^1LUD500 0_"0_,ENTRY._^1_%LDA- SWITCH_'PICK UP SWITCH WORD._^1_%AND- ONEBIT+1_$CHECK SWITCH U1._^1_%SAZ LUD5XA_'SKIP IF U1 NOT SET (TA ‚‚PE IN ASCII)._^1LUD5XE RTJ CHAIN_(U1 IS SET, TAPE IN EBCDIC. INITIATE CHAIN_^1_%ADC LUD50E_'TO EBCDIC PROCESSOR._^1LUD5XA RTJ CHAIN_(U1 NOT SET, TAPE IN ASCII. INITIATE CHAIN_^1_%ADC LUD50A_'TO ASCII PROCESSOR._^1_%SPC 1_^1LUD50E ALF 4,LUD50E_$PROGRAM NAME FOR EBCDIC VERSION._^1LUD50A ALF 4,LUD50A_$PROGRAM NAME FOR ASCII VERSION._^1_%SPC 1_^1_%END_]_^__ ‚‚MON02 CSY/ 00100 ‚‚1 MON_]_^1 OPT LPC_]_^__ ‚‚CLXTRT CSY/ F08 0010 ‚‚1_$PROGRAM CLXTRT_^1_#1_2/F08 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#THIS PROGRAM BLOCK-READS (24 RCDS) THE L/A FILE 'LADLQMST'_^1C_#AND BUILDS THE LEGAL/AGENCY CLIENT INVENTORY FILE 'LACLINV'._^12_]_^1C_#********************************** ‚‚********************_^1C_#*_S*_^1C_#*_%J = ADDRESS (CHAR-POS IN ARRAY) OF FIRST_!*_^1C_#*_,WORD IN RECORD READ ( LADLQMST )_%*_^1C_#*_%K = TOTAL NUMBER OF RECORDS READ_**_^1C_#*_%L = TOTAL # OF RECORDS WITH ACTIVE STATUS *_^1C_#*_%M = NUMBER OF RECORDS WRITTEN THIS DO-LOOP *_^1C_#*_%N = ADDRESS (CHAR-POS IN ARRAY) OF FIRST_!*_^1C_#*_,WORD IN RECORD WRITTEN ( LACLINV )_#* ‚‚_^1C_#*_"MTOT = TOTAL # OF RECORDS WRITTEN TO LACLINV *_^1C_#*_S*_^1C_#******************************************************_^12_]_^1_$INTEGER LDQREQ(24), LCQREQ(24), DDATA(15), CDATA(15),_^1_#1_(LDQREC(20000), LCQREC(960), KEY1(8), USER(4),_^1_#2_(HD(20,3), HL(20), DT(3), K, L, M, MTOT, EFLAG_^11_]_^1_$DATA_#K, L, M, MTOT / 4*0 /, KEY1 / 8*0 /_^1_$DATA_#IK / $2020 /, EFLAG ‚‚ / 0 /_^1_$DATA_#LDQREQ, LCQREQ / 48*0 /_^1_$DATA_#DDATA / 'LADLQMST', 8*$2020, 0, 20, 0 /_^1_$DATA_#CDATA / 'LACLINV ',8*$2020, 0, 1, 1 /_^11_]_^1_$EQUIVALENCE ( LDQREQ(15), NUMREC )_^11_]_^1C**********_!ACCEPT LOG-IN FROM ITOS_^1_$CALL_#PGMIN ( USER, LU, MODE, NPORT )_^11_]_^1_$CALL_#CCSBLK ( LCQREC, 1920 )_^1_$CALL_#LAHEAD ( HD, DT )_^11_]_^1_$CALL_#OPENFL ( LDQREQ, DDATA ‚‚, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 100_^1_$CALL_#FILERR ( DDATA, 3, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1 100 CALL_#CLEAR_!( LCQREQ, CDATA, ISTAT )_^1_$IF_%( ISTAT .GE.0 ) GO TO 110_^1_$CALL_#FILERR ( CDATA, 1, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1 110 CALL_#OPENFL ( LCQREQ, CDATA, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 200_^1_$CALL_#FILERR ( CDATA, 3, ISTAT, 5 )_^1_$GO ‚‚TO_"900_^11_]_^1C**********_!READ RECORDS FROM LADLQMST AND PROCESS_^11_]_^1 200 CALL_#GETS_"( LDQREQ, LDQREC, KEY1, ISTAT )_^11_]_^1C**********_!EOF?_^11_]_^1_$IF_%( AND ( ISTAT, $8100 ) .EQ. $8100 ) GO TO 900_^1_$IF_%( AND ( ISTAT, $100 ) .EQ. $100 ) EFLAG = 1_^11_]_^1C**********_!FILE ERROR?_^11_]_^1_$IF_%( ISTAT .GE. 0 ) GO TO 210_^1_$CALL_#FILERR ( DDATA, 14, ISTAT, ‚‚5 )_^1_$GO TO_"900_^11_]_^1C**********_!PERFORM PROCESSING OF 24 RECORDS ACCESSED IN BLOCK-READ_^11_]_^1 210 DO 300_!I = 1, NUMREC_^1_$J = 1000*I - 999_^11_]_^1_$K = K + 1_^11_]_^1C**********_!DOES RECORD HAVE AN ACTIVE (BLANK) ACCOUNT STATUS?_^11_]_^1_$IF_%( AND ( LDQREC(J+152), $FF ) .NE. $20 ) GO TO 300_^11_]_^1_$L = L + 1_^1_$M = M + 1_^1_$N = 40*M - 39_^11_]_^1C**********_! ‚‚BUILD THE OUTPUT RECORD_^1C**********_'1-16 ACCOUNT #_^1C**********_%17-20 L/A CLIENT #_^1C**********_%21-50 CUSTOMER NAME_^1C**********_%51-56 REFERRAL DATE_^1C**********_%57-65 LAST BILLED BALANCE (CURRENT PAY-OFF)_^11_]_^1_$CALL_#CCSMVA ( LDQREC, 2*J-1,_"2000, LCQREC, 2*N-1, 16 )_^1_$CALL_#CCSMVA ( LDQREC, 2*J+1070, 2000, LCQREC, 2*N+15, 4 )_^1_$CALL_#CCSMVA ( LDQREC, ‚‚2*J+16,_!2000, LCQREC, 2*N+19, 30 )_^1_$CALL_#CCSMVA ( LDQREC, 2*J+1074, 2000, LCQREC, 2*N+49, 6 )_^1_$CALL_#CCSMVA ( LDQREC, 2*J+903, 2000, LCQREC, 2*N+55, 9 )_^11_]_^1 300 CONTINUE_^11_]_^1C**********_!WRITE THE OUTPUT RECORD_^11_]_^1_$IF_%( M .EQ. 0 )_!GO TO 310_^1_$CALL_#PUTS_"( LCQREQ, LCQREC, M, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 310_^1_$CALL_#FILERR ( CDATA, 11 ‚‚, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1C**********_!CLEAR THE INPUT/OUTPUT FILE BUFFERS AND CONTINUE_^11_]_^1 310 CALL_#CCSBLK ( LDQREC, 30000 )_^1_$CALL CCSBLK ( LDQREC(15001), 10000 )_^1_$CALL_#CCSBLK ( LCQREC, 1920 )_^11_]_^1_$MTOT = MTOT + M_^1_$M_"= 0_^11_]_^1_$IF_%( EFLAG .EQ. 0 ) GO TO 200_^11_]_^1C**********_!PRINT HEADING AND COUNTERS_^11_]_^1_$WRITE_"( 9, 500 ) HD_^1 5 ‚‚00 FORMAT_!( // 3 ( / 30X, 20R2 ) // )_^11_]_^1_$WRITE_"( 9, 505 )_^1 505 FORMAT_!( 28X, *LEGAL/AGENCY CLIENT EXTRACT PROGRAM* // )_^11_]_^1_$WRITE_"( 9, 510 )_^1 510 FORMAT_!( 29X, * DATE_!RCDS READ ACTIVE_!RCDS WRITTEN* / )_^11_]_^1_$WRITE_"( 9, 520 ) DT, K, L, MTOT_^1 520 FORMAT_!( 29X, 3R2, 5X, I5, 4X, I5, 6X, I5 )_^11_]_^1C**********_!CLOSE FILES AND STOP_^11_]_^1 900 CAL ‚‚L_#CLOSFL ( LDQREQ, ISTAT )_^1_$CALL_#CLOSFL ( LCQREQ, ISTAT )_^1_$CALL_#PGMOUT_^11_]_^1_$END_]_^__ ‚‚LACLPG CSY/ F10 0010 ‚‚1_$PROGRAM LACLPG_^1_#1_2/F10 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_#LEGAL AND AGENCY CLIENT FILE PURGE_^1C_]_^1C_#THE CLIENT FILE(LACLIENT) FILE IS READ SEQUENTIALLY FOR INACTIVE_^1C_#CLIENTS. WHEN AN INACTIVE CLIENT IS FOUND, THE ‚‚NUMBER OF DAYS_^1C_#SINCE IT WAS INACTIVE IS CHECK FOR GREATER THAN OR EQUAL TO THE_^1C_#NUMBER OF DAYS IN THE LACL RECORD OF THE UTILITY FILE. IF THE_^1C_#DAYS INACTIVE MEET THE REQUIREMENT, ALL THE CLIENT INFO IS_^1C_#PRINTED ON THE PRINTER AND THE RECORD IS DELETED. AT THE END_^1C_#OF THE PROGRAM THE LACLIENT FILE IS COMPRESSED._^12_]_^1_$INTEGER ADAYS(3),ADAYTO,AMONTO,AYERTO, ‚‚BLANK(10)_^1_$INTEGER CDATE(3),CLEN(6),CPOS1(6),CPOS2(8),COMP_^1_$INTEGER DELETE,DT(3),EOF,ERMSG1(24)_^1_$INTEGER FDEL,FLAG,FMRDEL,HDAYS,HDR(120)_^1_$INTEGER LACL(40),LDATA(15),LP,LREC(652),LREQ(24),LKEY(2)_^1_$INTEGER ONE,PAGE,PERIOD,PPOS1(6),PPOS2(8),PRT(66,18)_^1_$INTEGER PRT01(66),PRT02(66),PRT03(66),PRT04(66)_^1_$INTEGER PRT05(66),PRT06(66),PRT07(66),PRT08(66)_^1_$INTEGER PRT0 ‚‚9(66),PRT10(66),PRT11(66),PRT12(66)_^1_$INTEGER PRT13(66),PRT14(66),PRT15(66),PRT16(66)_^1_$INTEGER PRT17(66),PRT18(66),SUMM(4),TEMP(8),TOF_^1_$INTEGER UDATA(15),UKEY1(2),UKEY2(2),UREC(40),UREQ(24)_^1_$INTEGER ZERO(2),NINE_^0_$INTEGER CNTHLD(2), SIGN(1),MINUS(1),JJ_^11_]_^1C_#CLIENT DEF_'CLIENT POS_)PRINT POS_^1C_#MONTH_0157_14_^1C_#YEAR_1155_17_^1C_## ACT_0159_012_^1C_## PIF_0180_ ‚‚042_^1C_## CLD_0201_060_^1C_## ACT_0213_078_^1C_#AMT ACT_.162_017_^1C_#AMT COLL_-171_029_^1C_#AMT PIF_.183_047_^1C_#AMT CLD_.204_066_^1C_#AMT ACT_.216_083_^1C_#COURT COSTS_*225_095_^1C_#NR COURT COSTS_'234_/107_^1C_#COMM EARNED_*192_/119_^11_]_^11_]_^1_$DATA ADAYS/3*$3030/,BLANK/10*$2020/,HDR/120*$2020/_^1_$DATA CLEN/2,2,3,3,3,3/,CPOS1/157,155,159,180,201,213/_^1_$DATA CPOS2/162,17 ‚‚1,183,204,216,225,234,192/_^1_$DATA DELETE/0/,EOF/0/,FLAG/0/,LP/$100C/,LREQ/24*0/_^1_$DATA ONE/$3131/,PAGE/0/,SUMM/' SUMMARY'/,TOF/$000C/_^1_$DATA PPOS1/4,7,12,42,60,78/,PPOS2/17,29,47,66,83,95,107,119/_^1_$DATA UKEY1/'LACL'/,UKEY2/'HDR0'/,UREQ/24*0/,LKEY/2*$2020/_^1_$DATA ZERO/$3030,$3030/,NINE/$3930/_^0_$DATA MINUS /'- '/_^11_]_^1_$DATA LDATA/'LACLIENT',8*$2020,1,1,1/_^1_$DATA UD ‚‚ATA/'LAUTIFIL',8*$2020,1,1,0/_^11_]_^1_$DATA ERMSG1/$0A0D,$0A0D,'FILE ERROR-LACLIENT FILE WAS NOT',_^1_#1' COMPRESSED '/_^1._]_^1_$DATA PRT01/66*$2020/_^1_$DATA PRT02/_^1_#1_''_K',_^1_#2_''_)CLIENT PURGE REPORT_.',_^1_#3_''_>PAGE:_''/_^1_$DATA PRT03/_^1_#1_''_K',_^1_#2_''_)RUN DATE:_8',_^1_#3_''_K'/_^1_$DATA PRT04/66*$2020/_^1_$DATA PRT05/66*$2020/_^1_$DATA PRT06/_^1_#1_'' CLIENT # ‚‚_*DATE INACTIVE_*',_^1_#2_''_K',_^1_#3_''_K'/_^1_$DATA PRT07/66*$2020/_^1_$DATA PRT08/_^1_#1_'' FIRM NAME_A',_^1_#2_''_BCURRENT C',_^1_#3_''OMMISSION RATE_='/_^1_$DATA PRT09/_^1_#1_'' FIRM ADDRESS 1_<',_^1_#2_''_BPREVIOUS ',_^1_#3_''COMMISSION RATE_<'/_^1_$DATA PRT10/_^1_#1_'' FIRM ADDRESS 2_<',_^1_#2_''_BDATE LAST',_^1_#3_'' UPDATED_C'/_^1_$DATA PRT11/_^1_#1_'' CONTACT NAME_>',_^1 ‚‚_#2_''_BCOMMISSIO',_^1_#3_''N LAG_F'/_^1_$DATA PRT12/_^1_#1_'' PHONE NUMBER_5EXT:_#',_^1_#2_''_K',_^1_#3_''_K'/_^1_$DATA PRT13/66*$2020/_^1_$DATA PRT14/66*$2020/_^1_$DATA PRT15/_^0_#1_'' HISTORY # OF_$$ VALUE_%AMT_"# O',_^0_#2_''F_"$ VALUE # ACCTS $ VALUE # ACCTS $ V',_^0_#3_''ALUE_%COURT N/R COURT_'COMM_#'/_^1_$DATA PRT16/_^0_#1_''_!MM/YY ACCTS_#OF ACCTS_"COL"TD_!PIF',_^0_# ‚‚2_''_#OF PIF_!CLOSED_!CLOSED_!ACTIVE_!ACT',_^0_#3_''IVE_'COSTS COSTS_+EARNED_!'/_^1_$DATA PRT17/66*$2020/_^1_$DATA PRT18/66*$2020/_^11_]_^1_$EQUIVALENCE (PRT(1,1),PRT01(1)),(PRT(1,2),PRT02(1))_^1_$EQUIVALENCE (PRT(1,3),PRT03(1)),(PRT(1,4),PRT04(1))_^1_$EQUIVALENCE (PRT(1,5),PRT05(1)),(PRT(1,6),PRT06(1))_^1_$EQUIVALENCE (PRT(1,7),PRT07(1)),(PRT(1,8),PRT08(1))_^1_$EQUIVALENCE (PRT(1 ‚‚,9),PRT09(1)),(PRT(1,10),PRT10(1))_^1_$EQUIVALENCE (PRT(1,11),PRT11(1)),(PRT(1,12),PRT12(1))_^1_$EQUIVALENCE (PRT(1,13),PRT13(1)),(PRT(1,14),PRT14(1))_^1_$EQUIVALENCE (PRT(1,15),PRT15(1)),(PRT(1,16),PRT16(1))_^1_$EQUIVALENCE (PRT(1,17),PRT17(1)),(PRT(1,18),PRT18(1))_^11_]_^1_$EXTERNAL AMONTO,ADAYTO,AYERTO,FMRDEL_^1._]_^1 100 CALL PGMIN(IDUSER,LUNIT,MODE,NOPORT)_^1_$IF(NOPORT.NE.0) ‚‚ GO TO 990_^11_]_^1C_10 ACTIVITY BLOCKS', // )_^11_]_^1 4000 FORMAT ( 1H1, /, 1X, 20A2,/,1X,20A2,/,1X,20A2,3X,'AS OF : ',_^1_#1_(A2,'/',A2,'/',A2,/ )_^11_]_^1_$END_]_^__ ‚‚LAHEAD CSY/ F15 0020 ‚‚1_$SUBROUTINE LAHEAD ( HD , DATE )_^1_#1_2/F15 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_(THIS SUBROUTINE PICKS UP THE THREE LINES OF CUSTOMER_^1C_(INFORMATION FOR REPORT HEADINGS AND RETURNS THEM IN THE_^1C_(ARRAY 'HD'. IF AN ERROR OCCU ‚‚RS THEY ARE RETURNED BLANK_^1C_(FILLED._^1C_(IT ALSO PICKS UP THE SYSTEM DATE IN ASCII AND RETURNS IT_^11_]_^1_$INTEGER HD(20,3),UDATA(15),UREQ(24),UREC(40),KEY(2),DATE(3)_^0_$INTEGER KEYVAL(2)_^11_]_^1_$EXTERNAL AYERTO,AMONTO,ADAYTO_^11_]_^1_$DATA KEY / 'HDR0' /_^0_$DATA KEYVAL /'HDR0'/_^1_$DATA UDATA / 'LAUTIFIL', 8*$2020, 1, 1, 0/_^11_]_^1C_(PICK UP AND SAVE THE SYSTEM DATE_^1_$ ‚‚DATE(1)=AND(AMONTO,$FFFF)_^1_$DATE(2)=AND(ADAYTO,$FFFF)_^1_$DATE(3)=AND(AYERTO,$FFFF)_^0C_(INITIALIZE UREQ TO ZEROS_^0_$DO 50 I = 1,24_^0_$UREQ(I) = 2*0_^0_!50 CONTINUE_^0C_(INITIALIZE KEY FIELD TO HDR0 (FOR MULTIPLE CALLS)_^0_$CALL CCSMVA (KEYVAL,1,2,KEY,1,4)_^11_]_^1C_(BLANK OUT THE HEADING ARRAY_^1_$DO 100 I=1,20_^1_$HD(I,1)=$2020_^1_$HD(I,2)=$2020_^1 100 HD(I,3)=$2020_^11_]_^1 ‚‚C_(OPEN THE UTIFIL FILE FOR USE_^1_$CALL OPENFL (UREQ,UDATA,ISTAT)_^1_$IF (ISTAT.LT.0) RETURN_^11_]_^1C_(RETREIVE THE HEADINGS_^1_$DO 200 I=1,3_^1_$KEY(2)=KEY(2)+1_^1_$CALL READR (UREQ,UREC,KEY,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 250_^1_$DO 150 J=1,20_^1 150 HD(J,I)=UREC(J+2)_^1 200 CONTINUE_^1C_(CLOSE THE FILE AND RETURN_^1 250 CALL CLOSFL (UREQ,ISTAT)_^1_$RETURN_^1_$END_]_^__ ‚‚LAVMCN CSY/ F18 0020 ‚‚1_$PROGRAM LAVMCN_^1_#1_2/F18 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#CONSTRUCT ACTIVITY VERIFICATION MATRIX._^1C_]_^1C_#THIS PROGRAM WILL CONSTRUCT THE ACTIVITY VERIFICATION MATRIX USED_^1C_#BY 'COLECT'. THE FILE 'AVMDESC' CONTAINS DE ‚‚SCRIPTIONS OF THE ACTIO_^1C_#AND RESULT CODES TO BE USED. ALSO, THIS PROGRAM WILL UPDATE THE_^1C_#UTILITY FILE RECORDS 'ACTC' AND 'RESC' WITH THE CURRENT ACTION AND_^1C_#RESULT CODES IN USE._^1C_]_^1C_#THE FORMAT OF THE INPUT DESCRIPTION RECORDS FROM 'AVMDESC' ARE:_^1C_]_^1C_#START COL_"# CHARS_$DESCRIPTION_^1C_'1_+2_'IDENTIFIER. EITHER 'RS' FOR RESULT CODE_^1C_=RECORD, 'AC' FOR AC ‚‚TION CODE RECORD, OR_^1C_=ANY OTHER CHARACTERS FOR COMMENT RECORD._^1C_]_^1C_'3_+2_'THE TWO CHARACTER ACTION OR RESULT CODE._^1C_]_^1C_'5_+1_'EITHER 'L' OR 'C' FOR LETTER OR COMMENT_^1C_=REQUIRED. ANY OTHER ENTRY IS IGNORED._^1C_]_^1C_'6_+1_'SAME AS COLUMN 5._^1C_]_^1C_'7_+2_'DEFAULT NUMBER OF DAYS TILL NEXT CONTACT_^1C_=FOR USE BY 'COLECT'. MUST BE IN THE RANGE_^1C_=OF 0 TO 63 ‚‚._^1C_]_^1C_'9_*64_'FOR ACTION CODE RECORDS, THIS IS THE LIST_^1C_=OF RESULT CODE PERMITTED WITH THIS ACTION_^1C_=FOR LESS THAN 32 TWO CHARACTER CODES,_^1C_=TERMINATE THE LIST WITH A '**' ._^1C_]_^1C_#UP TO 32 RESULT CODE AND 32 ACTION CODE RECORDS CAN BE PROCESSED._^1C_#FOR MORE THAN 32 RECORDS, THE OVERFLOW RECORDS ARE REPORTED AS_^1C_#ERRORS AND IGNORED. OTHER ERRORS REPORTED AN ‚‚D RESTRICTIONS ARE:_^1C_(1. ACTION OR RESULT CODE NOT UNIQUE. IT DUPLICATES A PREVIOUS_^1C_+ACTION OR RESULT CODE ENTERED._^1C_(2. NEXT CONTACT DATE FOR THIS ACTION OR RESULT CODE IS OUT OF_^1C_+RANGE (NCD < 0 OR NCD > 63). TO CONTINUE PROCESSING, THE_^1C_+NEXT CONTACT DATE IS SET TO ZERO IF THIS ERROR OCCURS._^1C_(3. FOR ACTION CODE RECORDS, THE ACTION CODE CANNOT BE THE SAME_^1C ‚‚_+AS ANY SCREEN FUNCTION CODE USED IN 'COLECT'. IF THE ACTION_^1C_+CODE IS ON THIS RESERVED LIST, THE RECORD IS IGNORED._^1C_(4. FOR ACTION CODE RECORDS, THE LIST OF VALID RESULT CODES_^1C_+MUST CONTAIN VALID RESULTS. IF A RESULT CODE IN THE VALID_^1C_+RESULT CODE LIST IS NOT A RESULT CODE, IT WILL NOT BE USED_^1C_+IN THE BIT MASK CONSTRUCTION._^1C_]_^1C_#THE PROGRAM LISTS ALL PROC ‚‚ESSED ACTION AND RESULT CODE RECORDS_^1C_#TO THE PRINTER WITH DIAGNOSTICS FOR ANY ERRORS. THE PRINT-OUT_^1C_#UTILIZES STANDARD REPORT STYLE HEADINGS FOR CCS 2.0._^1C_]_^1._]_^1_$INTEGER BUF(8000), REQBUF(24), ID(4)_^1_$INTEGER AMDATA(15), ADDATA(15), UTDATA(15), ACTC(2), RESC(2)_^1_$INTEGER TABLE(162), ACT(1), RES(1), BIT1(1), BIT2(1), REQS(1)_^1_$EQUIVALENCE ( REQBUF(15),NUMREC ) ‚‚, ( TABLE(1),ACT(1) )_^1_$EQUIVALENCE ( TABLE(33),RES(1) ) , ( TABLE(65),BIT1(1) )_^1_$EQUIVALENCE ( TABLE(97),BIT2(1) ) , ( TABLE(129),REQS(1) )_^11_]_^1_$INTEGER DUPMES(21), DUPMLN, NCDMES(24), NCDMLN, NRSMES(26), NRSMLN_^1_$INTEGER OVFMES(24), OVFMLN, SCFMES(25), SCFMLN_^1_$DATA DUPMES/ '****LAST RESULT CODE REJECTED - NOT UNIQUE' /_^1_$DATA NCDMES/ '****NEXT CONTACT DATE OUT OF ‚‚ RANGE - SET TO ZERO' /_^1_$DATA NRSMES/'**** " " ($_") NOT A VALID RESULT CODE - IGNORED'/_^1_$DATA OVFMES/ '****LAST RESULT CODE REJECTED - OVERFLOWS TABLE ' /_^1_$DATA SCFMES/ '****LAST ACTION CODE A SCREEN FUNCTION - REJECTED '/_^1_$DATA DUPMLN/ 42 /, NCDMLN/ 48 /, NRSMLN/ 52 /, OVFMLN/ 48 /_^1_$DATA SCFMLN/ 50 /_^1_$INTEGER ACTION(3)_^1_$DATA ACTION/ 'ACTION' /_^11_]_^1_$INTE ‚‚GER FUNCOD(18), NUMFUN_^1_$DATA FUNCOD/ 'NADSDFDADCCSP1P2P3RLNQOASSDLAAEAUH ' /_^1_$DATA NUMFUN/ 18 /_^1_$DATA REQBUF/24*0/, ACTC/ 'ACTC' /, RESC/ 'RESC' /_^1_$DATA AMDATA/ 'LAACTVTB_'',4*$2020, 0,_!1, -1 /_^1_$DATA ADDATA/ 'LAAVMDSC_'',4*$2020, 0, 200, 0 /_^1_$DATA UTDATA/ 'LAUTIFIL_'',4*$2020, 1,_!1, 1 /_^1_$DATA TABLE/ 32*$2A2A, 32*$2A2A, 32*0, 32*0, 32*0, 2*0 /_^11_]_^1_$INT ‚‚EGER LP, COMPL1, COMPL2, COMPL3, COMPL4, FLAG, TEMP(8), RECLEN_^1_$DATA LP/ 9 /, RECLEN/ 80 /_^11_]_^1_$INTEGER ONE, SIX, TEN, NUMBYT, NZERO, FIVE_^1_$DATA ONE/ 1 /, SIX/ 6 /, TEN/ 10 /, NUMBYT/ 64 /, NZERO/ $FFFF /_^1_$DATA FIVE/ 5 /_^11_]_^1_$INTEGER AC, RS, REQ_^1_$DATA AC/ 'AC' /, RS/ 'RS' /_^11_]_^1_$INTEGER HEAD(120), DATE(1), HDLEN, TOF, TOFLEN_^1_$EQUIVALENCE ( HEAD(102),DA ‚‚TE(1) )_^1_$DATA HEAD/ 70*$2020, $A0A, 'ACTIVITY VERIFICATION MATRIX BUILD OF_^1_#1', 14*$2020, ' - RESULT CODE INPUT', 5*$2020, $A0A/_^1_$DATA TOF/ $C /, TOFLEN/ 2 /_^1._]_^1C_(ITOS LOGIN._^1_$CALL PGMIN(ID,LU,I,J)_^1C_(TERMINATE IF NOT MASTER CONSOLE._^1_$IF(J.NE.0) GO TO 950_^12_]_^1C_(LOGIN OK, OPEN DESCRIPTION RECORD FILE AND RETRIEVE 200 RECORD_^1C_(BLOCK. THIS SHOULD BE SUFF ‚‚ICIENT TO READ ALL RECORDS._^1_$CALL OPENFL(REQBUF,ADDATA,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 50_^1C_(NO ERROR, RETRIEVE RECORDS._^1_$CALL GETS(REQBUF,BUF,I,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 60_^11_]_^1C_(NO ERROR, RECORD BLOCK RETRIEVED SUCESSFULLY. CLOSE FILE._^1_$CALL CLOSFL(REQBUF,ISTAT)_^11_]_^1C_(RETRIEVE STANDARD HEADINGS FOR REPORT TYPE ‚‚ OUTPUT._^1_$CALL LAHEAD(HEAD,DATE)_^11_]_^1_$GO TO 90_^12_]_^1C_(FILE ERROR USING DESCRIPTION FILE. REPORT AND TERMINATE._^11_]_^1C_(OPEN FILE REQUEST._^1 50 J = 3_^1_$GO TO 70_^11_]_^1C_(GETS ERROR._^1 60 J = 14_^11_]_^1 70 CALL FILERR(ADDATA,J,ISTAT,LU)_^1_$GO TO 900_^1C_(OPEN FILE REQUEST._^1._]_^1C_(PROCESS ALL RESULT CODE RECORDS. VERIFY THEIR UNIQUE-_^1C_(NESS, SAVE LE ‚‚TTER AND COMMENT REQUIREMENTS, AND VALIDATE NEXT_^1C_(NEXT CONTACT DATE._^11_]_^1C_(SET UP COMPLETION VARIABLES FOR WRITE REQUESTS._^1 90 ASSIGN 110 TO COMPL1_^1_$ASSIGN 150 TO COMPL2_^1_$ASSIGN 140 TO COMPL3_^11_]_^1C_(INTIALIZE POINTER TO NEXT AVAILABLE SPACE IN RESULT CODE ARRAY_^1_$NEXT = 1_^11_]_^1C_(PRINT REPORT TYPE HEADINGS._^1_$ASSIGN 100 TO IRTN_^1_$GO TO 600_^12_]_^1C_ ‚‚(LOOP THRU FILE LOOKING FOR RESULT CODE RECORDS._^1 100 DO 150 I=1,NUMREC_^1C_(CALCULATE POINTER TO NEXT RECORD._^1_$J = 40*(I-1) + 1_^1C_(CHECK FOR RESULT CODE RECORD._^1_$IF(BUF(J).NE.RS) GO TO 150_^11_]_^1C_(FOUND RESULT CODE RECORD. WRITE IT TO THE PRINTER._^1 105 CALL FWRITE(LP,BUF(J),RECLEN,COMPL1,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_(CHECK IF THIS IS MORE THAN THE 32 CODES A ‚‚LLOWED._^1 110 IF(NEXT.LT.33) GO TO 120_^1C_(YES, TOO MANY RESULT CODES INPUT. REJECT THIS CODE._^1 115 CALL FWRITE(LP,OVFMES,OVFMLN,COMPL2,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_(VERIFY UNIQUENESS OF THIS CODE._^1 120 K = BUF(J+1)_^1_$CALL AVMCKV(RES,K)_^1_$IF(K.LT.0) GO TO 130_^1C_(CODE IS NOT UNIQUE, REJECT IT._^1 125 CALL FWRITE(LP,DUPMES,DUPMLN,COMPL2,FLAG,TEMP)_^1_$CALL DISP_ ‚‚^11_]_^1C_(RETRIEVE FIFTH AND SIXTH CHARACTERS OF RECORD WHICH CONTAIN A_^1C_(LETTER OR COMMENT REQUIREMENTS FOR THIS RESULT._^1 130 CALL CCSGET(BUF(J),FIVE,K)_^1_$CALL CCSGET(BUF(J),SIX,L)_^1C_(ZERO REQUIREMENT ACCUMULATOR._^1_$REQ = 0_^1C_(FLAG ANY LETTER OR COMMENT REQUIREMENT._^1_$IF(K.EQ.$4C.OR.L.EQ.$4C) REQ=$80_^1_$IF(K.EQ.$43.OR.L.EQ.$43) REQ=REQ+$40_^1C_(EXTRACT NEXT CONT ‚‚ACT DATE._^1_$NCD = ICCSAD( BUF(J+3) )_^1C_(VERIFY NEXT CONTACT DATE IS WITHIN RANGE._^1_$IF(NCD.GE.0.AND.NCD.LT.64) GO TO 140_^1C_(NEXT CONTACT DATE OUT OF RANGE. SET IT TO ZERO AND REPORT ERRO_^1_$NCD = 0_^1 135 CALL FWRITE(LP,NCDMES,NCDMLN,COMPL3,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_(ADD NEXT CONTACT DATE TO REQUIREMENTS AND SAVE RESULT CODE AND_^1C_(ITS ASSOCIATED REQUIREMENTS._ ‚‚^1 140 REQ = REQ + NCD_^1_$RES(NEXT) = BUF(J+1)_^1_$REQS(NEXT) = REQ_^11_]_^1C_(INCREMENT COUNTER AND GET NEXT RESULT CODE RECORD._^1_$NEXT = NEXT + 1_^11_]_^1 150 CONTINUE_^1._]_^1C_(PROCESS ALL ACTION CODE RECORDS. VERIFY THEIR UNIQUENESS, DETE_^1C_(MINE BIT MASKS INDICATING VALID RESULT CODES, SAVE THEIR LETTE_^1C_(AND COMMENT REQUIREMENTS, AND VALIDATE NEXT CONTACT DATE._^11_ ‚‚]_^1C_(ASSIGN COMPLETION ADDRESSES FOR WRITE REQUESTS._^1_$ASSIGN 200 TO COMPL1_^1_$ASSIGN 300 TO COMPL2_^1_$ASSIGN 240 TO COMPL3_^1_$ASSIGN 260 TO COMPL4_^11_]_^1C_(RESET POINTER TO NEXT AVAILABLE SPOT IN ACTION CODE ARRAY._^1_$NEXT = 1_^11_]_^1C_(MOVE 'ACTION' WORDING INTO ERROR MESSAGES AND HEADINGS._^1_$CALL CCSMVA(ACTION,ONE,SIX,DUPMES,TEN,SIX)_^1_$CALL CCSMVA(ACTION,ONE,SIX,O ‚‚VFMES,TEN,SIX)_^1_$CALL CCSMVA(ACTION,ONE,SIX,DATE,TEN,SIX)_^11_]_^1C_(PRINT REPORT TYPE HEADINGS._^1_$ASSIGN 190 TO IRTN_^1_$GO TO 600_^12_]_^1C_(LOOP THRU THE FILE CHECKING FOR ACTION CODE RECORDS._^1 190 DO 300 I=1,NUMREC_^1C_(CALCULATE POINTER TO NEXT RECORD._^1_$J = 40*(I-1) + 1_^1C_(CHECK FOR AN ACTION CODE RECORD._^1_$IF(BUF(J).NE.AC) GO TO 300_^1C_(FOUND ACTION CODE RECORD ‚‚. WRITE IT TO THE PRINTER._^1_$GO TO 105_^1C_(CHECK FOR TABLE OVERFLOW WITH THIS ACTION CODE._^1 200 IF(NEXT.LT.33) GO TO 210_^1C_(TABLE OVERFLOW. MORE THAN THE ALLOWED 32 ACTION CODES ENTERED._^1C_(REJECT THIS RECORD._^1_$GO TO 115_^11_]_^1C_(NO TABLE OVERFLOW. VERIFY UNIQUENESS OF THIS CODE._^1 210 K = BUF(J+1)_^1_$CALL AVMCKV(ACT,K)_^1_$IF(K.LT.0) GO TO 220_^1C_(CODE NOT UNIQU ‚‚E, REJECT IT._^1_$GO TO 125_^11_]_^1C_(CODE UNIQUE. ACTION CODES CANNOT BE SCREEN FUNCTIONS. REJECT_^1C_(CODE IF IT IS._^1 220 K = BUF(J+1)_^1_$DO 225 L=1,NUMFUN_^1_$IF(K.NE.FUNCOD(L)) GO TO 225_^1C_(CODE IS A SCREEN FUNCTION CODE, REJECT IT._^1_$CALL FWRITE(LP,SCFMES,SCFMLN,COMPL2,FLAG,TEMP)_^1_$CALL DISP_^1 225 CONTINUE_^11_]_^1C_(CODE OK. EXTRACT FIFTH AND SIXTH CHARACTERS FR ‚‚OM RECORD_^1C_(WHICH CONTAIN ANY LETTER OR COMMENT REQUIREMENTS._^1_$CALL CCSGET(BUF(J),FIVE,K)_^1_$CALL CCSGET(BUF(J),SIX,L)_^1C_(ZERO REQUEST ACCUMULATOR._^1_$REQ = 0_^1C_(SAVE ANY LETTER AND COMMENT REQUEST._^1_$IF(K.EQ.$4C.OR.L.EQ.$4C) REQ = $80_^1_$IF(K.EQ.$43.OR.L.EQ.$43) REQ=REQ+$40_^1C_(EXTRACT NEXT CONTACT DATE._^1_$NCD = ICCSAD( BUF(J+3) )_^1C_(VERIFY NEXT CONTACT DATE IS ‚‚ WITHIN RANGE._^1_$IF(NCD.GE.0.AND.NCD.LT.64) GO TO 240_^1C_(NEXT CONTACT DATE OUT OF RANGE. SET IT TO ZERO AND REPORT ERRO_^1_$NCD = 0_^1_$GO TO 135_^11_]_^1C_(ADD NEXT CONTACT DATE TO ACCUMULATOR._^1 240 REQ = REQ + NCD_^11_]_^1C_(SAVE RESULT CODE AND ITS REQUIREMENTS._^1_$ACT(NEXT) = BUF(J+1)_^1_$REQS(NEXT) = REQS(NEXT) + REQ*$100_^1C_(CHECK FOR ADDITION YIELDING ZERO FOR $FFFF ‚‚._^1_$IF(REQ.NE.0.AND.REQS(NEXT).EQ.0) REQS(NEXT)=NZERO_^12_]_^1C_(DETERMINE RESULT CODE BIT MASKS FOR THIS ACTION CODE._^1C_(ELIMINATE ANY DUPLICATE CODES. THE ROUITNE 'AVMCKD' WILL SET_^1C_(ANY DUPLICATE CODE TO BINARY ZERO, AND AS A RESULT WILL NOT_^1C_(HINDER BIT MASK CONSTRUCTION._^1_$CALL AVMCKD(BUF(J+4))_^1_$CALL AVMBIT(RES,BUF(J+4),BIT1(NEXT),BIT2(NEXT))_^1C_(REPORT ANY REJ ‚‚ECTED RESULT CODES._^1_$J = J + 4_^1_$DO 260 K=1,32_^1_$L = J + K_^1_$IF(BUF(L).GE.0) GO TO 260_^1C_(THIS RESULT CODE REJECTED. CONVERT IT BACK TO ITS ORIGINAL FOR_^1C_(PLACE IT AND ITS HEXADECIMAL REPRESENTATION IN THE ERROR MESSA_^1C_(AND WRITE THE ERROR MESSAGE TO THE PRINTER._^1_$NRSMES(4) = -BUF(L)_^1_$CALL CCSHXA(NRSMES(4),NRSMES(7))_^1_$CALL FWRITE(LP,NRSMES,NRSMLN,COMPL4,FL ‚‚AG,TEMP)_^1_$CALL DISP_^1 260 CONTINUE_^12_]_^1C_(INCREMENT CODE POINTER AND GET NEXT ACTION CODE RECORD._^1_$NEXT = NEXT + 1_^12_]_^1 300 CONTINUE_^1._]_^1C_(RETRIEVE OLD TABLE FROM FILE AND UPDATE WITH NEW TABLE._^1C_(ZERO REQUEST BUFFER._^1_$DO 405 I=1,24_^1 405 REQBUF(I) = 0_^11_]_^1C_(CLEAR THE FILE._^1_$CALL CLEAR(REQBUF,AMDATA,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT. ‚‚0) GO TO 450_^1C_(NO ERROR, OPEN THE FILE._^1_$CALL OPENFL(REQBUF,AMDATA,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 460_^1C_(NO ERROR, SAVE THE NEW TABLE IN THE FILE._^1_$CALL PUTS(REQBUF,TABLE,ONE,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 470_^1C_(NO ERROR, UPDATE SUCCESSFUL. CLOSE FILE AND PROCEED TO UPDATE_^1C_(UTILITY FILE SECTION._^1_$CALL CLOSFL(REQBUF, ‚‚ISTAT)_^1_$GO TO 500_^12_]_^1C_(FILE MANAGER ERRORS USING FILE 'ACTVERTB'._^11_]_^1C_(CLEAR FILE REQUEST._^1 450 J = 1_^1_$GO TO 480_^11_]_^1C_(OPEN FILE REQUEST._^1 460 J = 3_^1_$GO TO 480_^11_]_^1C_(PUTS REQUEST._^1 470 J = 11_^11_]_^1 480 CALL FILERR(AMDATA,J,ISTAT,LU)_^1_$GO TO 900_^1._]_^1C_(UPDATE UTILITY FILE RECORDS. SORT ACTION CODE AND RESULT CODE_^1C_(ARRAYS INTO ALP ‚‚HABETICAL ORDER._^1 500 CALL AVMSRT(ACT)_^1_$CALL AVMSRT(RES)_^11_]_^1C_(OPEN UTILITY FILE AND UPDATE 'ACTC' AND 'RESC' RECORDS._^1C_(ZERO REQUEST BUFFER FIRST._^1_$DO 505 I=1,32_^1 505 REQBUF(I) = 0_^11_]_^1_$CALL OPENFL(REQBUF,UTDATA,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 550_^1C_(NO ERROR, RETRIEVE 'ACTC' RECORD._^1_$CALL READR(REQBUF,BUF,ACTC,ISTAT)_^1C_(CHECK ‚‚FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 560_^1C_(NO ERROR, MOVE IN NEW ACTION CODES._^1_$CALL CCSMVA(ACT,ONE,NUMBYT,BUF(3),ONE,NUMBYT)_^1C_(SAVE UPDATED RECORD._^1_$CALL UPDREC(REQBUF,BUF,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 570_^11_]_^1C_(UPDATE 'RESC' RECORD._^1_$CALL READR(REQBUF,BUF,RESC,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 560_^1C_(NO ERROR, MOVE ‚‚IN NEW RESULT CODES._^1_$CALL CCSMVA(RES,ONE,NUMBYT,BUF(3),ONE,NUMBYT)_^1C_(SAVE UPDATED RECORD._^1_$CALL UPDREC(REQBUF,BUF,ISTAT)_^1C_(CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 570_^1C_(NO ERROR, CLOSE FILE. MATRIX CONSTRUCTION COMPLETE._^1_$GO TO 900_^12_]_^1C_(FILE MANAGER ERRORS USING UTILITY FILE._^11_]_^1C_(OPEN FILE REQUEST._^1 550 J = 3_^1_$GO TO 580_^11_]_^1C_(READR REQUE ‚‚ST._^1 560 J = 13_^1_$GO TO 580_^11_]_^1C_(UPDREC REQUEST._^1 570 J = 15_^11_]_^1 580 CALL FILERR(UTDATA,J,ISTAT,LU)_^1_$GO TO 900_^1._]_^1C_(PRINT REPORT STYLE HEADINGS._^11_]_^1C_(GET TOP OF FORM._^1 600 ASSIGN 610 TO ICOMPL_^1_$CALL FWRITE(LP,TOF,TOFLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_(OUTPUT HEADINGS._^1 610 HDLEN = 40_^1_$ASSIGN 620 TO ICOMPL_^1_$DO 620 I=1,5_^1 ‚‚_$J = 20*(I-1) + 1_^1_$IF(I.EQ.4) HDLEN=60_^1_$IF(I.EQ.5) J=91_^1_$CALL FWRITE(LP,HEAD(J),HDLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1 620 CONTINUE_^1_$GO TO IRTN_^1._]_^1C_(CLOSE ANY FILES AND EXIT._^1 900 CALL CLOSFL(REQBUF,ISTAT)_^12_]_^1 950 CALL PGMOUT_^1_$END_]_^__ ‚‚LAVMDP CSY/ F19 0020 ‚‚1_$PROGRAM LAVMDP_^1_#1_2/F19 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_#DUMP ACTIVITY VERIFICATION MATRIX._^1C_]_^1C_#THIS PROGRAM WILL PRINT AN INTELLIGIBLE DUMP OF THE ACTIVITY VERI-_^1C_#FICATION MATRIX STORED IN THE FILE 'ACTVERTB'. ‚‚ THE MATRIX CALLED_^1C_#'TBL' CONTAINS A LIST OF ALL VALID ACTION CODES, LIST OF ALL VALID_^1C_#RESULT CODES, MASKS FOR DETERMINING VALID ACTION/RESULT CODE PAIRS_^1C_#AND DEFAULT VALUES FOR NEXT CONTACT DATE AND LETTER AND COMMENT_^1C_#REQUIREMENTS FOR EACH PAIR THAT IS VALID. A MORE DETAILED DESCRIP-_^1C_#TION OF 'TBL' IS FOUND IN THE AVMVAC SUBROUTINE._^1C_]_^11_]_^1_$INTEGER RE ‚‚QBUF(24),IDATA(15),TBL(162),ACT(1),RES(1),OBUF(66)_^1_$INTEGER ASTRKS,LETREQ,COMREQ,NCD,BZ,RL,LREQD,CREQD,ONE,DP,NA,SR,PP_^1_$INTEGER HEAD1(21),HEAD2(10),HEAD3(3),HEAD4(6),HEAD5,HEAD6(7)_^1_$INTEGER FLAG,TEMP(8),LEN,TOF,LF_^1_$INTEGER BLANKS,NC,WRITE,STDHDR(20,3),DATE(3),HEAD7(5),HDRLEN_^1_$INTEGER ASCZER,LENHD1,LENHD2,HDRONE,HDRTWO,HDRTHR,ONE,TWO,DATFLD_^1_$INTEGER LENHD6,LENHD7,D ‚‚ATPOS,TILPOS,ZEROES,SIXTEN,ERRLEN,ASCNIN_^1_$INTEGER UTILRQ(24),IDATB(15),UTILRC(41),UTKEY(2),Y,WONE_^11_]_^1_$DATA ASTRKS/'**'/,BZ/'BZ'/,RL/'RL'/,LREQD/'L '/,CREQD/'C '/,_^1_#1_#WONE/'01'/,DP/'DP'/,NA/'NA'/,SR/'SR'/,PP/'PP'/,BLANKS/' '/_^1_$DATA NC/'NC'/_^1_$DATA HEAD1/'_$ACTIVITY VERIFICATION TABLE_#PAGE'/_^1_$DATA HEAD2/'R E S U L T C O D E'/_^1_$DATA HEAD3/'ACT_!'/_^1_$DATA H ‚‚EAD4/'ION_!L C CD'/_^1_$DATA HEAD5/'--'/_^1_$DATA HEAD6/' END OF TABLE '/_^1_$DATA HEAD7/'RUN DATE: '/_^1_$DATA IDATA/'LAACTVTB',8*$2020,0,1,0/,FLAG/0/,LEN/132/,LF/$D20/,_^1_#1_$TOF/$C20/,REQBUF/24*0/,OBUF/66*$2020/_^1_$DATA ASCZER/$2030/,LENHD1/34/,LENHD2/20/,HDRONE/1/,HDRTWO/41/,_^1_#1_$HDRTHR/81/,ONE/1/,TWO/2/,LENHD6/14/,LENHD7/10/_^1_$DATA DATPOS/63/,TILPOS/45/,ZEROES/$3030/,SI ‚‚XTEN/$3136/,ERRLEN/44/_^1_$DATA ASCNIN/$39/,HDRLEN/40/,DATFLD/1/,LP/9/_^1_$DATA UTILRQ/24*0/,UTILRC/41*0/,UTKEY/'OLPM'/,NARL/0/,Y/'Y '/_^1_$DATA IDATB/'LAUTIFIL',8*$2020,1,1,0/_^12_]_^1_$EQUIVALENCE (TBL(1),ACT(1)),(TBL(33),RES(1))_^12_]_^1C_#LOGIN SECTION._^1_$CALL PGMIN(TEMP,LU,I,J)_^1C_#VERIFY MASTER CONSOLE ONLY. EXIT IF NOT._^1_$IF(J.NE.0) GO TO 900_^1C_#OPEN THE LAUTIFIL_^1_$ ‚‚CALL OPENFL(UTILRQ,IDATB,ISTAT)_^1_$IF(ISTAT.GE.0) GO TO 40_^1_$CALL FILERR(IDATB,3,ISTAT,LU)_^1_$GO TO 900_^1C_#RETRIEVE THE OLPM RECORD FROM THE UTIFIL_^1_!40 CALL READR(UTILRQ,UTILRC,UTKEY,ISTAT)_^1_$IF(ISTAT.GE.0)GO TO 50_^1_$CALL FILERR(IDATB,13,ISTAT,LU)_^1_$GO TO 900_^1C_#CLOSE THE UTIFIL_^1_!50 CALL CLOSFL(UTILRQ,ISTAT)_^1C_#CHECK FOR NA PARAMETER_^1_$CALL CCSCST(UTILRC,20, ‚‚1,Y,1,1,ICOMP)_^1_$IF(ICOMP.NE.0) GO TO 60_^1_$NARL=1_^1_!60 CONTINUE_^12_]_^1C_#RETRIEVE TBL FROM FILE._^1 100 CALL OPENFL(REQBUF,IDATA,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 810_^1C_#RETRIEVE TBL, THEN CLOSE FILE._^1_$CALL GETS(REQBUF,TBL,TEMP,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 820_^1_$CALL CLOSFL(REQBUF,ISTAT)_^11_]_^1C_#RETRIEVE STANDARD HEADI ‚‚NGS FOR OUTPUT._^1_$CALL LAHEAD(STDHDR,DATE)_^1._]_^1C_]_^1C_#DUMP MATRIX SHOWING FOR EACH ACTION/RESULT CODE PAIR WHETHER THE_^1C_#COMBINATION IS VALID. ALSO IF IT IS VALID, SHOW THE DEFAULT VALUE_^1C_#IN DAYS FOR NEXT CONTACT AND ANY LETTER OR COMMENT REQUIREMENTS._^1C_]_^1C_#INTIALIZE VARIABLES._^1 200 I = 1_^1_$J = 1_^1_$N = ASCZER_^1_$ASSIGN 450 TO WRITE_^1C_#CHECK IF ANY RES ‚‚ULTS TO PROCESS THIS ROUND._^1 210 IF(RES(J).EQ.ASTRKS) GO TO 355_^1C_]_^1C_#OUTPUT HEADINGS._^1C_]_^1C_#BLANK OUTPUT BUFFER._^1_$CALL CCSBLK(OBUF,LEN)_^1C_#SET TOP OF FORM._^1_$OBUF(1) = TOF_^1_$CALL CCSMVA(HEAD1,ONE,LENHD1,OBUF,TILPOS,LENHD1)_^1C_#SET PAGE NUMBER._^1_$N = N+1_^1_$OBUF(57) = HEAD1(20)_^1_$OBUF(58) = HEAD1(21)_^1_$OBUF(59) = N_^1C_#MOVE IN STANDARD HEADING._^1_$IF ‚‚(RES(M).EQ.NA.AND.NARL.EQ.1) OBUF(JJ+4)=RL_^1_$CALL CCSMVA(STDHDR,HDRONE,HDRLEN,OBUF,TWO,HDRLEN)_^1_$ASSIGN 215 TO ICOMPL_^1_$GO TO WRITE_^1C_#MOVE IN SECOND LINE OF HEADING BLANKING REMAINING BUFFER._^1 215 CALL CCSMVA(STDHDR,HDRTWO,HDRLEN,OBUF,ONE,LEN)_^1C_#MOVE IN DATE._^1_$TILPOS = TILPOS + 8_^1_$CALL CCSMVA(HEAD7,ONE,LENHD7,OBUF,TILPOS,LENHD7)_^1_$CALL EDIT(DATE,ONE,OBUF,DATP ‚‚OS,DATFLD)_^1_$ASSIGN 220 TO ICOMPL_^1_$GO TO WRITE_^1C_#MOVE IN THIRD LINE OF HEADING BLANKING REMAINING BUFFER._^1 220 CALL CCSMVA(STDHDR,HDRTHR,HDRLEN,OBUF,ONE,LEN)_^1_$ASSIGN 225 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 225 CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$TILPOS = TILPOS + 3_^1_$CALL CCSMVA(HEAD2,ONE,LENHD2,OBUF,TILPOS,LENHD2)_^1_$ASSIGN 230 TO ICOMPL ‚‚_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 230 TILPOS=TILPOS - 11_^1_$CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$OBUF(2) = $20_^1_$IF(J.NE.1) GO TO 235_^1_$L = ZEROES_^1_$GO TO 240_^1 235 L = SIXTEN_^1 240 DO 245 K=1,16_^1_$L = L+1_^1_$IF(AND(L,$FF).GT.ASCNIN) L=L+$F6_^1 245 OBUF(4*K+2) = L_^1 250 ASSIGN 255 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 255 CALL C ‚‚CSBLK(OBUF,LEN)_^1_$DO 260 K=1,3_^1 260 OBUF(K) = HEAD3(K)_^1_$L = J + 15_^1_$DO 265 K=J,L_^1_$IF(RES(K).EQ.ASTRKS) GO TO 270_^1_$M = AND(K-1,$F) + 1_^1 265 OBUF(4*M+1) = RES(K)_^1 270 ASSIGN 275 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 275 CALL CCSBLK(OBUF,LEN)_^1_$DO 280 K=1,3_^1 280 OBUF(K) = HEAD4(K)_^1_$DO 285 K=1,16_^1_$OBUF(4*K+0) = HEAD4(4)_^1_$OBUF(4*K+1 ‚‚) = HEAD4(5)_^1 285 OBUF(4*K+2) = HEAD4(6)_^1_$ASSIGN 290 TO ICOMPL_^1_$GO TO WRITE_^1C_#BLANK OUTPUT BUFFER._^1 290 CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = HEAD5_^1_$OBUF(2) = AND($FF20,HEAD5)_^1_$DO 300 K=1,16_^1_$OBUF(4*K+0) = HEAD5_^1_$OBUF(4*K+1) = HEAD5_^1 300 OBUF(4*K+2) = HEAD5_^1_$ASSIGN 305 TO ICOMPL_^1_$GO TO WRITE_^1._]_^1C_#HEADINGS COMPLETE. PROCESS ACTION/RESULT CODE ‚‚PAIRS FILLING THE_^1C_#OUTPUT BUFFER WITH THE INFORMATION PERTAINING TO EACH PAIR._^1 305 L = I+15_^1C_#LOOP THRU ALL ACTION CODES CHECKING ALL POSSIBLE RESULTS WITH IT._^1_$DO 350 K=I,L_^1C_#CHECK IF ALL ACTION CODES DONE._^1_$IF(ACT(K).EQ.ASTRKS) GO TO 355_^1C_#BLANK OUTPUT BUFFER AND OUTPUT TWO BLANK LINES FOR TRIPLE SPACING._^1_$CALL CCSBLK(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$ASSIG ‚‚N 310 TO ICOMPL_^1_$GO TO WRITE_^1 310 OBUF(1) = ACT(K)_^1_$II = J + 15_^1C_#LOOP THRU ALL RESULT CODES._^1_$DO 340 M=J,II_^1C_#CHECK IF ALL RESULT CODES CHECK WITH THIS ACTION CODE._^1_$IF(RES(M).EQ.ASTRKS) GO TO 345_^1C_#CHECK THIS ACTION/RESULT CODE PAIR._^1_$CALL AVMVAC(TBL,ACT(K),RES(M),LETREQ,COMREQ,NCD)_^1_$JJ = 4 * (AND(M-1,$F) + 1) - 2_^1C_#CHECK IF THIS ACTION/RESULT COD ‚‚E PAIR ALLOWED (NCD > OR = 0)._^1_$IF(NCD.LT.0) GO TO 330_^1C_#PAIR VALID. SET LETTER AND COMMENT REQUIREMENTS IF ANY._^1 320 IF(LETREQ.NE.0) OBUF(JJ+2)=LREQD_^1_$IF(COMREQ.NE.0) OBUF(JJ+3)=CREQD_^1C_#CHECK FOR ACTION = SR, RESULT = PP OR BZ, OR NCD = 0 INDICATING_^1C_#SPECIAL VALUE FOR NEXT CONTACT._^1_$IF(ACT(K).EQ.SR) OBUF(JJ+4)=WONE_^1_$IF(RES(M).EQ.PP) OBUF(JJ+4)=DP_^1_$IF(RE ‚‚S(M).EQ.BZ) OBUF(JJ+4)=RL_^1_$IF(OBUF(JJ+4).NE.BLANKS) GO TO 340_^1_$IF(NCD.EQ.0)_#OBUF(JJ+4)=NC_^1_$IF(OBUF(JJ+4).NE.BLANKS) GO TO 340_^1C_#CONVERT NEXT CONTACT DATE._^1_$OBUF(JJ+4) = (NCD/10 * $100) + AND(NCD-(NCD/10)*10,$F) + ZEROES_^1_$GO TO 340_^1 330 OBUF(JJ+4) = NA_^1 340 CONTINUE_^11_]_^1C_#OUTPUT BUFFER._^1 345 ASSIGN 350 TO ICOMPL_^1_$GO TO WRITE_^1 350 CONTINUE_^11_ ‚‚]_^1C_#CHECK IF MORE ACTION/RESULT CODES TO CHECK._^1 355 IF((I.EQ.17.AND.J.EQ.17).OR.(I.EQ.17.AND.M.LT.17).OR.(J.EQ.17.AND._^1_#1_$K.LT.17).OR.(M.LT.17.AND.K.LT.17)) GO TO 400_^1_$IF(J.EQ.17) GO TO 370_^11_]_^1_$J = 17_^1_$GO TO 210_^11_]_^1 370 I = 17_^1_$J = 1_^1_$GO TO 210_^1._]_^1C_]_^1C_#MATRIX OUTPUT COMPLETE. OUTPUT END OF MATRIX MESSAGE AND EXIT._^1C_]_^1 400 CALL CCSBL ‚‚K(OBUF,LEN)_^1_$OBUF(1) = LF_^1_$ASSIGN 405 TO ICOMPL_^1_$GO TO WRITE_^1 405 TILPOS = TILPOS + 4_^1_$CALL CCSMVA(HEAD6,ONE,LENHD6,OBUF,TILPOS,LENHD6)_^1_$ASSIGN 900 TO ICOMPL_^12_]_^1C_#WRITE FILLED OUTPUT BUFFER._^1 450 CALL FWRITE(LP,OBUF,LEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1._]_^1C_]_^1C_#FILE ERRORS._^1C_]_^1C_#OPENFL ERROR._^1 810 I = 3_^1_$GO TO 830_^11_]_^1C_#GETS ERROR. ‚‚_^1 820 I = 14_^11_]_^1C_#REPORT ERROR TO USER._^1 830 CALL FILERR(IDATA,I,ISTAT,LU)_^11_]_^1C_#FORCE FILE CLOSURE, BYPASS ANY ERROR._^1 850 CALL CLOSFL(REQBUF,ISTAT)_^13_]_^1C_#NORMAL TERMINATION._^1 900 CALL PGMOUT_^1_$END_]_^__ ‚‚LAXTRT CSY/ F20 0010 ‚‚1_$PROGRAM LAXTRT_^1_#1_2/F20 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#THIS PROGRAM BLOCK-READS (16 RCDS) THE C.C.S. FILE 'DELQMST',_^1C_#ADDS EXTRACTED RECORDS TO THE LEGAL/AGENCY FILE 'LADLQMST'_^1C_#AND CREATES THE TEMPORARY FILE 'LADLQKE ‚‚Y'. IF THE ACCOUNT_^1C_#STATUS OF THE RECORD READ FROM 'DELQMST' IS 'W' AND THE CHARS_^1C_#'LA' ARE NOT IN CHAR-POSITIONS 1055-1056, THIS PROGRAM PUTS_^1C_#THE LITERAL 'LA' INTO THOSE CHARACTER POSITIONS, WRITES THE_^1C_#RECORD-KEYS TO 'LADLQKEY', ADDS THE RECORDS TO 'LADLQMST AND_^1C_#UPDATES THE 'DELQMST' RECORD(S) FOR THE 'LA'._^12_]_^1C_#*************************************** ‚‚***************_^1C_#*_S*_^1C_#*_/FUNCTION OF VARIABLES_.*_^1C_#*_S*_^1C_#*_S*_^1C_#*_%J = ADDRESS (CHAR-POS IN ARRAY) OF FIRST_!*_^1C_#*_,WORD IN RECORD READ ( DELQMST )_%*_^1C_#*_%K = TOTAL NUMBER OF RECORDS READ_**_^1C_#*_%L = TOTAL # OF RECORDS WITH STATUS OF 'W' *_^1C_#*_%M = NUMBER OF RECORDS WRITTEN THIS DO-LOOP *_^1C_#*_%N = ADDRESS (CHAR-POS IN ARRAY) OF FIRST_ ‚‚!*_^1C_#*_,WORD IN RECORD WRITTEN ( LADLQKEY )_"*_^1C_#*_$MD = NUMBER OF ATTEMPTS TO WRITE DUPLICATE *_^1C_#*_,RECORDS TO LADLQMST_3*_^1C_#*_$MA = NUMBER OF ATTEMPTS TO WRITE DUPLICATE *_^1C_#*_,RECORDS TO LAACCAGE_3*_^1C_#*_$ND = CHARACTER POSITION OF FIRST WORD OF_"*_^1C_#*_,ARRAY-ELEMENT (ACCT-#) IN 'DUP' ARRAY *_^1C_#*_,CONTAINING ACCT-#'S OF DUPLICATE RCD'S *_^1C_#*_" ‚‚MTOT = TOTAL # OF RECORDS WRITTEN TO LADLQKEY *_^1C_#*_S*_^1C_#******************************************************_^12_]_^1_$INTEGER DEQREQ(24), LDQREQ(24), KEYREQ(24), AGEREQ(24),_^1_#1_(DDATA(15), LDATA(15), KDATA(15), ADATA(15),_^1_#2_(DEQREC(16000), LDQREC(1002), KEYREC(128), AGEREC(43),_^1_#3_(DUP(8,50), DUP2(8,50), MD, MA, ND, MTOT, SPACES(3),_^1_#4_(KEY1(8), USER(4) ‚‚, HD(20,3), HL(20), DT(3), EFLAG_^11_]_^1_$DATA_#K, L, M, MD, MA, ND, MTOT, EFLAG / 8*0 /, KEY1 / 8*0 /_^1_$DATA_#IK / $2020 /, LA / 'LA' /,_"DUP, DUP2 / 800*$2020 /_^1_$DATA_#SPACES / 3*$2020 /_^1_$DATA_#DEQREQ, LDQREQ, KEYREQ, AGEREQ / 96*0 /_^1_$DATA_#DDATA / 'DELQMST CCS20_*', 0,16, 1 /_^1_$DATA_#LDATA / 'LADLQMSTLA_-', 1, 1, 1 /_^1_$DATA_#KDATA / 'LADLQKEYLA_-', 0, 1, 1 ‚‚ /_^1_$DATA_#ADATA / 'LAACCAGELA_-', 1, 1, 1 /_^11_]_^1_$EQUIVALENCE ( DEQREQ(15), NUMREC )_^11_]_^1C**********_!ACCEPT LOG-IN FROM ITOS_^1_$CALL_#PGMIN ( USER, LU, MODE, NPORT )_^11_]_^1C**********_!STORE SYSTEM DATE AND INITIALIZE 'LADLQKEY' BUFFER_^1_$CALL_#LAHEAD ( HD, DT )_^1_$CALL_#CCSBLK ( KEYREC, 256 )_^11_]_^1C**********_!OPEN FILES_^11_]_^1_$CALL_#OPENFL ( DEQREQ, D ‚‚DATA, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 100_^1_$CALL_#FILERR ( DDATA, 3, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1 100 CALL_#OPENFL ( LDQREQ, LDATA, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 105_^1_$CALL_#FILERR ( LDATA, 3, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1 105 CALL_#OPENFL ( AGEREQ, ADATA, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 110_^1_$CALL_#FILERR ( ADATA, 3, ISTAT, 5 )_^1_ ‚‚$GO TO_"900_^11_]_^1 110 CALL_#CLEAR_!( KEYREQ, KDATA, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 115_^1_$CALL_#FILERR ( KDATA, 1, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1 115 CALL_#OPENFL ( KEYREQ, KDATA, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 200_^1_$CALL_#FILERR ( KDATA, 3, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1C**********_!READ RECORDS FROM DELQMST AND PROCESS_^11_]_^1 200 CALL_#GET ‚‚S_"( DEQREQ, DEQREC, KEY1, ISTAT )_^11_]_^1C**********_!EOF?_^11_]_^1_$IF_%( AND ( ISTAT, $8100 ) .EQ. $8100 ) GO TO 900_^1_$IF_%( AND ( ISTAT, $100 ) .EQ. $100 ) EFLAG = 1_^11_]_^1C**********_!FILE ERROR?_^11_]_^1_$IF_%( ISTAT .GE. 0 ) GO TO 210_^1_$CALL_#FILERR ( DDATA, 14, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1C**********_!PERFORM PROCESSING OF 16 RECORDS ACCESSED IN BLOCK-RE ‚‚AD_^11_]_^1 210 DO 300_!I = 1, NUMREC_^1_$J = 1000*I - 999_^11_]_^1_$K = K + 1_^11_]_^1C**********_!DOES RECORD HAVE AN ACCOUNT STATUS OF 'W' IN CHAR-POS 306?_^11_]_^1_$IF_%( AND ( DEQREC(J+152), $FF ) .NE. $57 ) GO TO 300_^1_$L = L + 1_^11_]_^1C**********_!DO CHARS. 1055-1056 CONTAIN 'LA'?_^11_]_^1_$IF_%( DEQREC(J+527) .EQ. $4C41 ) GO TO 300_^1_$M = M + 1_^1_$N = 8*M - 7_^11_]_ ‚‚^1C**********_!PUT THE VARIABLE LA (CONTAINING 'LA') INTO CHARS 1055-1056_^11_]_^1_$DEQREC(J+527) = LA_^11_]_^1C**********_!MOVE DATA FROM 'DELQMST' ARRAY TO 'LADLQMST' BUFFER._^11_]_^1_$CALL_#CCSBLK ( LDQREC, 2004 )_^1_$CALL_#CCSMVA ( DEQREC, 2*J-1, 1056, LDQREC, 1, 2000 )_^11_]_^1C**********_!MOVE CURRENT BALANCE IN CCS TO BALANCE DUE IN L/A_^11_]_^1_$CALL_#CCSMVA ( DEQREC, 2* ‚‚J+894, 9, LDQREC, 1063, 9 )_^11_]_^1C**********_!MOVE SPACES TO POSITION 1047 - PREVIOUS NAME FIELD_^1_$CALL_#CCSMVA (SPACES, 1, 6, LDQREC, 1047, 6)_^11_]_^1C**********_!MOVE SYSTEM DATE INTO L/A_^11_]_^1_$LDQREC(529) = DT(1)_^1_$LDQREC(530) = DT(2)_^1_$LDQREC(531) = DT(3)_^11_]_^1C**********_!REPLACE 'W' STATUS WITH BLANK (ACTIVE) STATUS IN L/A RCD._^11_]_^1_$CALL_#CCSPUT ( $20 ‚‚, 306, LDQREC )_^11_]_^1C**********_!ADD RECORD TO INDEX FILE 'LADLQMST'_^11_]_^1_$CALL_#WRITER ( LDQREQ, LDQREC, LDQREC, ISTAT )_^1_$IF_%( AND ( ISTAT, $10 ) .EQ. $10 ) GO TO 275_^1_$IF_%( ISTAT .GE. 0 ) GO TO 250_^1_$CALL_#FILERR ( LDATA, 12, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1C**********_!MOVE MASTER FILE ACCOUNT # TO 'LADLQKEY' ARRAY._^11_]_^1 250 CALL_#CCSMVA ( DEQREC, 2* ‚‚J-1, 2000, KEYREC, 2*N-1, 16 )_^11_]_^1C**********_!MOVE ACCOUNT # FROM 'DELQMST' ARRAY TO 'LAACCAGE' BUFFER._^11_]_^1_$CALL_#CCSBLK ( AGEREC, 86 )_^1_$CALL_#CCSMVA ( DEQREC, 2*J-1, 2000, AGEREC, 1, 16 )_^11_]_^1C**********_!ADD RECORD TO INDEX FILE 'LAACCAGE'_^11_]_^1_$CALL_#WRITER ( AGEREQ, AGEREC, AGEREC, ISTAT )_^1_$IF_%( AND ( ISTAT, $10 ) .EQ. $10 ) GO TO 285_^1_$IF_%( IS ‚‚TAT .GE. 0 ) GO TO 300_^1_$CALL_#FILERR ( ADATA, 12, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1C**********_!ATTEMPT TO WRITE DUPLICATE RECORD TO LADLQMST._^1C**********_!SAVE ACCOUNT NUMBER AND CONTINUE.(UP TO 50 DUP-RCDS)_^11_]_^1 275 M = M - 1_^1_$MD = MD + 1_^1_$ND = 8*MD - 7_^1_$CALL_#CCSMVA ( LDQREC, 1, 16, DUP, 2*ND-1, 16 )_^1_$GO TO_"300_^11_]_^1C**********_!ATTEMPT TO WRITE ‚‚DUPLICATE RECORD TO LAACCAGE._^1C*****_)1. RE-ACCESS 'LAACCAGE' RECORD_^1C*****_)2. MOVE BLANKS INTO ALL BUT PRIMARY KEY OF RCD BUFFER_^1C*****_)3. UPDATE THE RECORD_^1C*****_)4. SAVE ACCOUNT NUMBER AND CONTINUE (UP TO 50 DUP-RCDS)_^11_]_^1 285 CALL_#READR_!( AGEREQ, AGEREC, AGEREC, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 290_^1_$CALL_#FILERR ( ADATA, 13, ISTAT, 5 )_^1_$GO TO_"9 ‚‚00_^11_]_^1 290 CALL_#CCSMVA ( SPACES, 1, 0, AGEREC, 17, 66 )_^11_]_^1_$CALL_#UPDREC ( AGEREQ, AGEREC, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 295_^1_$CALL_#FILERR ( ADATA, 15, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1 295 MA = MA + 1_^1_$ND = 8*MA - 7_^1_$CALL_#CCSMVA ( AGEREC, 1, 16, DUP2, 2*ND-1, 16 )_^11_]_^1 300 CONTINUE_^11_]_^1C**********_!BLOCK-WRITE THE SEQUENTIAL OUTPUT ‚‚RECORD 'LADLQKEY'._^11_]_^1_$IF_%( M .EQ. 0 )_!GO TO 310_^1_$CALL_#PUTS_"( KEYREQ, KEYREC, M, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 305_^1_$CALL_#FILERR ( KDATA, 11, ISTAT, 5 )_^1_$GO TO_"900_^11_]_^1C**********_!UPDATE DELQMST_^11_]_^1 305 CALL_#UPDREC ( DEQREQ, DEQREC, ISTAT )_^1_$IF_%( ISTAT .GE. 0 ) GO TO 310_^1_$CALL_#FILERR ( DDATA, 15, ISTAT, 5 )_^1_$GO TO_"900_^11_]_ ‚‚^1C**********_!CLEAR THE INPUT/OUTPUT FILE BUFFERS AND CONTINUE_^11_]_^1 310 CALL_#CCSBLK ( DEQREC, 32000 )_^1_$CALL_#CCSBLK ( KEYREC, 256 )_^11_]_^1_$MTOT = MTOT + M_^1_$M_"= 0_^11_]_^1_$IF_%( EFLAG .EQ. 0 ) GO TO 200_^11_]_^1C**********_!PRINT HEADING AND COUNTERS_^11_]_^1_$ENDFILE 9_^11_]_^1_$WRITE_"( 9, 500 ) HD_^1 500 FORMAT_!( // 3 ( / 30X, 20R2 ) )_^11_]_^1_$WRITE_"( 9, ‚‚ 505 )_^1 505 FORMAT_!( // 30X, *LEGAL & AGENCY EXTRACT PROGRAM* // )_^11_]_^1_$WRITE_"( 9, 510 )_^1 510 FORMAT_!( 29X, * DATE_!RCDS READ W-RCDS_!RCDS WRITTEN* / )_^11_]_^1_$WRITE_"( 9, 520 ) DT, K, L, MTOT_^1 520 FORMAT_!( 29X, 3R2, 5X, I5, 4X, I5, 6X, I5 / )_^11_]_^1_$IF_%( MD .LE. 0 ) GO TO 800_^11_]_^1C**********_!ATTEMPTS TO WRITE DUPLICATE RECORDS TO 'LADLQMST' FILE_^1C* ‚‚*********_!( CCS VS. L/A ) HAVE OCCURRED. LIST TO PRINTER ACCOUNT_^1C**********_!NUMBERS OF DUPLICATE RECORDS WITH ERROR MESSAGE._^11_]_^1_$DO 700_!I = 1, MD_^1_$WRITE_"( 9, 600 ) ( DUP(J,I), J=1,8 )_^1 600 FORMAT_!( / 10X, 8R2 , 5X, *ERROR - DUPLICATE RECORD. ACCOUNT*,_^1_#1_*1X, *ALREADY EXISTS ON L/A MASTER FILE* / )_^11_]_^1 700 CONTINUE_^12_]_^1C**********_!ATTEMPTS TO WRITE ‚‚ DUPLICATE RECORDS TO 'LAACCAGE' (THAT_^1C**********_!WERE NOT DUPLICATE RECORDS TO 'LADLQMST') HAVE OCCURRED._^1C**********_!LIST TO PRINTER ACCOUNT NUMBERS OF DUPLICATE RECORDS WITH_^1C**********_!ERROR MESSAGE._^11_]_^1_$IF_%( MA .LE. 0 ) GO TO 900_^11_]_^1 800 DO 850_!I = 1, MA_^1_$WRITE_"( 9, 825 ) ( DUP2(J,I), J=1,8 )_^1 825 FORMAT_!( / 10X, 8R2, 5X, *ERROR - DUPLICATE RE ‚‚CORD. ACCOUNT*,_^1_#1_*1X, *ALREADY EXISTS ON L/A AGEING FILE* / )_^11_]_^1 850 CONTINUE_^12_]_^1C**********_!CLOSE FILES AND STOP_^11_]_^1 900 CALL_#CLOSFL ( DEQREQ, ISTAT )_^1_$CALL_#CLOSFL ( LDQREQ, ISTAT )_^1_$CALL_#CLOSFL ( KEYREQ, ISTAT )_^1_$CALL_#CLOSFL ( AGEREQ, ISTAT )_^1_$CALL_#PGMOUT_^11_]_^1_$END_]_^__ ‚‚LBATUD CSY/ F21 0005 ‚‚1_$PROGRAM LBATUD_^1_#1_2/F21 F LA_!CCS 3.0_5SL-149_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#THIS PROGRAM PERFORMS THE NIGHTLY BATCH UPDATE OF L/A FINANCIAL_^1C_#TRANSACTIONS AGAINST THE LADLQMST AND THE LACLIENT FILES._^1C_#. THE INPUT FILE - LAFINTRN- IS THE OUTPUT OF ‚‚ A SORT OF THE_^1C_%ONLINE TRANSACTION FILE - LATRNSFL - AND THE HOST FINANCIAL_^1C_%TRANSACTION FILE CREATED BY LUD500._^1C_#. ONLY TRANSACTIONS WHICH CONTAIN '03' (FINANCIAL TRANSACTION)_^1C_%IN POSITIONS 29 - 30 OR '0261' (REASSIGNMENT TRANSACTION) IN_^1C_%POSITIONS 29 - 32 OF THE INPUT RECORD WILL BE ACCEPTED._^1C_#. DIRECT OR INDIRECT PAYMENTS ('05' OR '06' IN POSITION 51-52)_ ‚‚^1C_%WILL DECREASE THE CURRECT PAYOFF AND AMOUNT DELINQUENT). IF THE_^1C_%RESULTING AMOUNT GOES NEGATIVE, ZEROS WILL BE SUBSTITUTED._^1C_#. NONRECOVERABLE COURT COSTS ('07' IN POSITION 51-52) WILL HAVE_^1C_%NO EFFECT ON THE ACCOUNT MASTER RECORD BUT WILL BE NOTED IN_^1C_%THE CLIENT RECORD UNDER THAT MONTHS ACTIVITIES._^1C_#. RECOVERABLE COURT COSTS WILL BE ADDED TO THE ACCOUNTS CUR ‚‚RENT_^1C_%PAYOFF AND AMOUNT DELINQUENT, AS WELL AS THE CLIENTS RECORD._^1C_#. FEES/COMMISSIONS ARE NOTED ONLY IN THE CLIENT RECORD._^1C_#. SUCCESSFULLY PROCESSED TRANSACTIONS ARE RE-WRITTEN TO THE_^1C_#. INPUT TRANSACTION FILE WITH '04' BEING USED TO REPLACE THE_^1C_%'03' OR '0261' TRANSACTION CODES. THIS TO PREVENT FINANCIAL_^1C_%UPDATES FROM BEING PROCESSED TWICE._^1C_#. SUCCESSF ‚‚ULLY PROCESSED DIRECT AND INDIRECT PAYMENTS ARE WRITTEN_^1C_%TO A CUMULATIVE FILE - LAPMTFIL - WHICH IS LATER USED BY THE_^1C_%PAYMENT STATEMENT REPORTING MODULES IN THE ON DEMAND REPORT_^1C_%MENU._^1C_#. ALL SUCCESSFULLY PROCESSED TRANSACTIONS ARE WRITTEN TO THE_^1C_%FILE - LARPTDAT - AND ARE USED TO PRODUCE THE AUDIT TRAIL_^1C_%REPORT WHICH DETAILS THE EFFECT OF EACH TRANSACTION. ‚‚_^1C_#. REASSIGNMENT TRANSACTIONS CAUSE THE CURRENT CLIENT OF RECORD_^1C_%DATA IN THE LADLQMST RECORD TO BE MOVED TO THE PREVIOUS CLIENT_^1C_%OF RECORD FIELDS. NUMBER OF ACCOUNTS ASSIGNED AND CLOSED FILEDS_^1C_%IN THE CLIENT RECORD ARE ALSO UPDATED DURING REASSIGNMENTS._^1C_%THANK YOU AND GOOD EVENING!_^1C_]_^1_$INTEGER DDATA(15), CDATA(15), FDATA(15), PDATA(15), RDATA(15),_^1_#2_' ‚‚DREQ(24), CREQ(24), FREQ(24), PREQ(24), RREQ(24),_^1_#3_'DREC(1000),CREC(652), FREC(70), PREC(22), RREC(82),_^1_#4_'USER(4), ACTNUM(8), LGNO(2), TCODE(2), NUMB1(5), NUMB2(6),_^1_#5_'NUMB3(6), CURDAT(3), MM(1), ATT1(2), ATT2(2), REFDT1(3),_^1_#6_'REFDT2(3), DTHOLD(3), COMPIN(1), EM1(1), EM2(1),CDHOLD(2)_^1_$INTEGER YYMM(2), CLRFLD(44), TC(1), ONE(1), EM3(1), EM4(1),EM5(1),_^1_ ‚‚#2_'BLANK(2), EM6(1), RANGE(2), TABLE1(5), TABLE2(5),_^1_#3_'PMTHLD(5), EM7(1), SIGN(1), SPACES(44)_^1C_]_^1_$DATA DDATA / 'LADLQMST',8*$2020,1,1,0/_^1_$DATA CDATA / 'LACLIENT',8*$2020,1,1,0/_^1_$DATA FDATA / 'LAFINTRN',8*$2020,0,1,0/_^1_$DATA PDATA / 'LAPMTFIL',8*$2020,0,1,0/_^1_$DATA RDATA / 'LARPTDAT',8*$2020,0,1,0/_^1_$DATA EM1 / 'DN' /, EM2 / 'CN' /, TC / '04' /_^1_$DATA EM3 / ‚‚ 'BL' /, EM4 / 'IM' /, EM5 / 'IY' /, EM6 / 'BC' /_^1_$DATA EM7 /'IS'/_^1_$DATA CDHOLD / '0261' /, RANGE / '0112' /_^1_$DATA CLRFLD / 44*$3030 /_^1_$DATA SPACES / 44*$2020 /_^1C_]_^1_$DATA DREQ, CREQ, FREQ, PREQ, RREQ /120*0/_^1_$DATA PREC,RREC /104*$2020 /_^1_$DATA NUMB1,NUMB2,NUMB3 / 17*$3030 /_^1_$DATA ONE / '01' /, BLANK /'_"'/_^1_$DATA SIGN /0/_^1C_JGET SYSTEM DATE_^1_$EXTERNAL ‚‚ AMONTO,ADAYTO,AYERTO,ASCBIN,BINASC_^1_$ASSEM $C400,+AMONTO,$6800,CURDAT(1)_^1_$ASSEM $C400,+ADAYTO,$6800,CURDAT(2)_^1_$ASSEM $C400,+AYERTO,$6800,CURDAT(3)_^1_$CALL CCSMVA (CURDAT,1,2,YYMM,3,2)_^1_$CALL CCSMVA (CURDAT,5,2,YYMM,1,2)_^1C_JACCEPT ITOS LOGIN_^1_$CALL PGMIN (USER, LU, MODE, NPORT)_^1C_JOPEN FILES_^1_$CALL OPENFL (DREQ, DDATA, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 100_^1_$C ‚‚ALL FILERR (DDATA, 3, ISTAT, LU)_^1_$GO TO 900_^1C_]_^1 100 CALL OPENFL (CREQ, CDATA, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 110_^1_$CALL FILERR (CDATA, 3, ISTAT, LU)_^1_$GO TO 900_^1C_]_^1 110 CALL OPENFL (FREQ, FDATA, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 120_^1_$CALL FILERR (FDATA, 3, ISTAT, LU)_^1_$GO TO 900_^1C_]_^1 120 CALL OPENFL (PREQ, PDATA, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO ‚‚130_^1_$CALL FILERR (PDATA, 3, ISTAT, LU)_^1_$GO TO 900_^1C_]_^1 130 CALL OPENFL (RREQ, RDATA, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 200_^1_$CALL FILERR (RDATA, 3, ISTAT, LU)_^1_$GO TO 900_^1C_ICLEAR OUTPUT BUFFERS_^1 200 CALL CCSBLK (FREC, 140)_^1_$CALL CCSBLK (PREC, 40)_^1_$CALL CCSBLK (RREC, 160)_^1C_JREAD LAFINTRN TRANS FILE_^1_$CALL GETS (FREQ, FREC, 1, ISTAT)_^1C_JEOF?_^1_$IF ‚‚(AND (ISTAT,$100) .EQ. $100) GO TO 900_^1_$IF (ISTAT .GE. 0) GOTO 205_^1C_JREPORT ERRORS_^1_$CALL FILERR (FDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JIF REASSIGNMENT TRANSACTION,_^1C_J(TYPE=02,CODE=61) SKIP PAYME_^1C_JPROCESSING, PERFORM REASSIGN_^1C_JLOGIC_^1 205 CALL CCSCST (CDHOLD,1,4,FREC,29,4,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 700_^1C_IIF NOT AN L/A PAYMENT TRANS,_^1C_I(TYPE=0 ‚‚3), GET ANOTHER TRANS._^1 210 CALL CCSMVA (FREC,29,2,TCODE,1,2)_^1_$IF (TCODE .NE. $3033) GO TO 200_^1C_JGET ACCT NUMBER FROM TRANS,_^1C_JREAD LADLQMST_^1_$CALL CCSMVA (FREC, 1, 16, ACTNUM, 1, 16)_^1_$CALL READR (DREQ, DREC, ACTNUM, ISTAT)_^1_$IF (ISTAT .EQ. 0) GO TO 220_^1C_JREPORT ERRORS BUT DONT ABORT_^1C_JIN THE CASE OF NOT FOUND_^1_$IF (ISTAT .GT. 0) GO TO 800_^1_$CALL FILERR ‚‚ (DDATA, 13, ISTAT, LU)_^1_$GO TO 800_^1C_JIF TRANS HAS CLIENT NUMBER I_^1C_JIT, THAT CLIENT GETS CREDIT_^1C_JFOR THE PAYMENT. OTHERWISE,_^1C_JUSE REFERRAL DATES,CURRENT_^1C_JAND PAST CLIENTS OF RECORD_^1C_JAND PAYMENT DATE TO DETERMIN_^1C_JWHO GETS CREDIT_^1 220 CALL CCSMVA (FREC, 46, 4, LGNO, 1, 4)_^1_$CALL CCSCST(LGNO,1,4,BLANK,1,4,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 250_^1C_J ‚‚SKIP CLIENT CREDIT LOGIC_^1C_JIF LGNO NOT = BLANKS_^1_$GO TO 290_^1C_JCLIENT CREDIT LOGIC STARTS_^1C_JHERE. GET "CURRENT" CLIENT_^1C_JNUMBER, REFERRAL DATE_^1 250 CALL CCSMVA (DREC, 1072, 4, ATT1, 1, 4)_^1_$CALL CCSMVA (DREC, 1080, 2, REFDT1, 1, 2)_^1_$CALL CCSMVA (DREC, 1076, 4, REFDT1, 3, 4)_^1C_JGET "PREVIOUS" CLIENT NUMBER_^1C_JAND REFERRAL DATE_^1_$CALL CCSMVA (DREC, 1229, 4, ‚‚ ATT2, 1, 4)_^1_$CALL CCSMVA (DREC, 1237, 2, REFDT2, 1, 2)_^1_$CALL CCSMVA (DREC, 1233, 4, REFDT2, 3, 4)_^1C_JCONVERT PAYMENT DATE TO YYMM_^1_$CALL CCSMVA (FREC, 44, 2, DTHOLD, 1, 2)_^1_$CALL CCSMVA (FREC, 40, 4, DTHOLD, 3, 4)_^1_$CALL CCSMVA (FREC, 42, 2, DTHOLD, 5, 2)_^1C_JCOMPARE "CURRENT" REFERRAL D_^1C_JWITH PAYMENT DATE_^1_$CALL CCSCST (DTHOLD, 1, 6, REFDT1, 1, 6, COMPIN)_^1_ ‚‚$IF (COMPIN .LT. 0) GO TO 260_^1C_J"CURRENT" CLIENT GETS CREDIT_^1_$CALL CCSMVA (ATT1, 1, 4, LGNO,1, 4)_^1_$GO TO 290_^1C_J"CURRENT" CLIENT NOT VALID Y_^1C_JUSE "PREVIOUS"._^1 260 CALL CCSMVA (ATT2, 1, 4, LGNO, 1, 4)_^1_$IF (LGNO .EQ. $2020) GO TO 820_^1_$GO TO 290_^1C_ILGNO NOW CONTAINS A CLIENT_^1C_INUMBER - DO THE READ_^1 290 CALL READR (CREQ, CREC, LGNO, ISTAT)_^1_$IF (ISTAT ‚‚.EQ. 0) GO TO 300_^1C_JREPORT ERROR BUT DO NOT ABOR_^1C_JIN THE CASE NOT FOUND_^1_$IF (ISTAT .GT. 0) GO TO 810_^1_$CALL FILERR (CDATA, 13, ISTAT, LU)_^1_$GO TO 810_^1C_JCLIENT FILE HAS 13 PERIODIC_^1C_JSETS WHICH DETAIL THE VOLUME_^1C_J(BOTH $ AND #) OF ACCOUNTS_^1C_JWORKED BY CLIENTS. ONE SET_^1C_JEXISTS FOR EACH MONTH; THE 1_^1C_JSET IS FOR YTD FIGURES. CHEC_^1C_JIS MADE TO DETER ‚‚MINE IF SET_^1C_JCONTAINS THIS YEARS DATA OR_^1C_JLAST YEARS DATA. 'I' MUST BE_^1C_JINCREMENTED TO POINT TO SETS_^1 300 I = 69_^1_$DO 305 J = 1,12_^1_$I = I + 88_^1_$CALL CCSCST (FREC,40,2,CREC,(I),2,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 310_^1 305 CONTINUE_^1C_JDIDNT FIND A MATCH OF TRANS_^1C_JMONTH WITH SET MONTH. EITHER_^1C_JTRANS HAS AN INVALID MONTH O_^1C_JCLIENT RECORD HAS N ‚‚O SET FOR_^1C_JTHAT MONTH. ELIMINATE FIRST_^1C_JPOSSIBILITY RIGHT AWAY THEN_^1C_JFIND FIRST AVAILABLE SPACE I_^1C_JCLIENT RECORD AND INITIALIZE_^1C_JIT WITH ZEROS._^1_$CALL CCSCST (FREC,40,2,RANGE,1,2,COMPIN)_^1_$IF (COMPIN .LT. 0) GO TO 830_^1_$CALL CCSCST (FREC,40,2,RANGE,3,2,COMPIN)_^1_$IF (COMPIN .GT. 0) GO TO 830_^1C_JIF WE GOT THIS FAR THE DATE_^1C_JMUST BE OK. FIND FIRST AVA ‚‚IL_^1C_JABLE PERIODIC SET AND USE IT_^1_$I = 69_^1_$DO 306 J = 1,12_^1_$I = I + 88_^1_$CALL CCSCST (CREC, (I), 4, BLANK, 1, 4, COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 307_^1 306 CONTINUE_^1C_JIF WE DROPPED THRU THE LOOP_^1C_JTHIS CLIENT RECORD IS REALLY_^1C_JMESSED UP. REPORT AN ERROR._^1_$GO TO 850_^1C_JFOUND A BLANK SET. INITIALIZ_^1 307 CALL CCSMVA (CLRFLD, 1, 2, CREC, (I), 2)_^1 ‚‚_$CALL CCSMVA (FREC, 40, 2, CREC, (I), 2)_^1_$I = I - 2_^1_$CALL CCSMVA (FREC,44,2,CREC,(I),2)_^1_$I = I + 2_^1_$GO TO 310_^1C_JGOT THE MONTH BUCKET, COMPAR_^1C_JYEAR OF TRANS PAYMENT DATE W_^1C_JYEAR SET WAS LAST UPDATED. I_^1C_JEQUAL, ADD TRANS DATA TO EXI_^1C_JDATA; IF HIGHER, CLEAR OUT S_^1C_JIF LOWER, GOT A BAD DATE_^1 310 I = I - 2_^1_$CALL CCSCST (FREC,44,2,CREC,(I),2,COMPI ‚‚N)_^1_$IF (COMPIN .EQ. 0) GO TO 340_^1_$IF (COMPIN .GT. 0) GO TO 320_^1C_JANYTHING BEYOND HERE IS ERRO_^1_$GO TO 840_^1C_JMUST BE LAST YEARS DATA SO_^1C_JCLEAR IT OUT_^1 320 CALL CCSMVA (FREC,44,2,CREC,(I),2)_^1_$I = I + 4_^1_$CALL CCSMVA (SPACES,1,84,CREC,(I),84)_^1_$I = I - 4_^1_$GO TO 340_^1C_JCHECK TRANSACTION TYPE AND_^1C_JBRANCH TO SUPPORTING ROUNTIN_^1 340 CALL CCSMVA (FRE ‚‚C, 51, 2, TCODE, 1, 2)_^1_$IF (TCODE .EQ. $3035) GO TO 350_^1_$IF (TCODE .EQ. $3036) GO TO 350_^1_$IF (TCODE .EQ. $3038) GO TO 370_^1_$IF (TCODE .EQ. $3037) GO TO 380_^1_$IF (TCODE .EQ. $3039) GO TO 390_^1_$GO TO 200_^1C_IPROCESS DIRECT/INDIRECT PAYME_^1C_IWHICH MUST FIRST HAVE THE SIG_^1C_IBITS REVERSED IN THE TRANS AM_^1C_ITHIS IS NECESSARY INORDER FOR_^1C_ITHE NEGATIVE ADD (SUBT ‚‚RACT) T_^1C_IFUNCTION CORRECTLY_^1 350 CALL CCSMVA(FREC,31,9,PMTHLD,2,9)_^1_$SIGN = AND(PMTHLD(5),$00FF)_^1_$IF (SIGN .GE. $31 .AND. SIGN .LE. $39) GO TO 351_^1_$IF (SIGN .EQ. $30 ) GO TO 352_^1_$IF (SIGN .GE. $4A .AND. SIGN .LE. $52) GO TO 353_^1_$IF (SIGN .EQ. $7D) GO TO 354_^1_$GO TO 860_^1 351 SIGN = SIGN + $19_^1_$GO TO 355_^1 352 SIGN = SIGN + $4D_^1_$GO TO 355_^1 353 SIG ‚‚N = SIGN - $19_^1_$GO TO 355_^1 354 SIGN = SIGN - $4D_^1_$GO TO 355_^1 355 CALL CCSMVA(SIGN,2,1,PMTHLD,10,1)_^1C_IPROCESS PAYMENTS_^1_$CALL CCSMVA (PMTHLD, 2, 9,NUMB1, 2, 9)_^1_$CALL CCSMVA (DREC, 887, 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (DREC, 887, 9, RREC, 42, 9)_^1_$CALL CCSADD (NUMB1, 2, NUMB2, 1, NUMB3,1)_^1C_JIF SUBTRACTION CAUSED DELQ._^1C_JAMOUNT TO BECOME NEGATIVE,RE_^1C_JPL ‚‚ACE WITH ZEROS._^1_$SIGN = AND(NUMB3(6),$00FF)_^1_$IF (SIGN .LT. $30 .OR. SIGN .GT. $39)_^1_#1_'CALL CCSMVA (CLRFLD,1,12,NUMB3,1,12)_^1C_]_^1_$CALL CCSMVA (NUMB3, 4, 9, DREC, 887, 9)_^1_$CALL CCSMVA (NUMB3, 4, 9, RREC, 51, 9)_^1C_JSUBTRACT DIRECT PAYMENTS FRO_^1C_JAMOUNT DELINQUENT_^1C_]_^1_$CALL CCSMVA (DREC, 905, 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (DREC, 905, 9, RREC, 60, 9)_^1_$CAL ‚‚L CCSADD (NUMB1, 2, NUMB2, 1, NUMB3,1)_^1C_JIF SUBTRACTION CAUSED CURREN_^1C_JPAYOFF TO BECOME NEGATIVE,_^1C_JCHANGE IT TO ZEROS_^1_$SIGN = AND(NUMB3(6),$00FF)_^1_$IF (SIGN .LT. $30 .OR. SIGN .GT. $39)_^1_#1_'CALL CCSMVA(CLRFLD,1,12,NUMB3,1,12)_^1C_]_^1_$CALL CCSMVA (NUMB3, 4, 9, DREC, 905, 9)_^1_$CALL CCSMVA (NUMB3, 4, 9, RREC, 69, 9)_^1C_JPLUG IN UPDATE DATE_^1_$CALL CCSMVA (CUR ‚‚DAT, 1, 6, DREC, 863, 6)_^1C_JGET MONTH OF PAYMENT DATE AN_^1C_JADD PAYMENT AMOUNT TO CLIENT_^1C_JFILE RECORD 'AMOUNT COLLECTE_^1C_JMONTH(N)._^1_$I = I + 16_^1_$CALL CCSMVA (FREC,31,9,NUMB1,2,9)_^1_$CALL CCSMVA (CREC, (I), 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (CREC, (I), 9, RREC, 132, 9)_^1C_JNUMB1 = TRANS PAYMENT,NUMB2_^1C_JAMOUNT COLLECTED_^1_$CALL CCSADD (NUMB1, 2, NUMB2, 1, NUMB3, 1 ‚‚)_^1C_JMOVE UPDATED AMOUNT COLLECTE_^1C_JBACK INTO CLIENT RECORD_^1_$CALL CCSMVA (NUMB3, 4, 9, CREC, (I), 9)_^1_$CALL CCSMVA (CREC, (I), 9, RREC, 141, 9)_^1C_JIF PAYMENT CAUSED PAYOFF DU_^1C_JTO BECOME ZERO,CLIENT OF REC_^1C_JGETS CREDIT FOR A 'PAID IN F_^1_$CALL CCSCST(DREC,905,9,CLRFLD,1,9,COMPIN)_^1_$IF (COMPIN .GT. 0) GO TO 400_^1_$CALL CCSMVA(CLRFLD,1,17,NUMB1,1,17)_^1_$I = I ‚‚ + 9_^1_$CALL CCSMVA (ONE,1,2,NUMB1,9,2)_^1_$CALL CCSMVA (CREC,(I),3,NUMB2,10,3)_^1_$CALL CCSADD (NUMB1,2,NUMB2,1,NUMB3,1)_^1_$CALL CCSMVA (NUMB3,10,3,CREC,(I),3)_^1_$I = I + 3_^1_$CALL CCSMVA (DREC,1216,9,NUMB1,2,9)_^1_$CALL CCSMVA (CREC,(I),9,NUMB2,4,9)_^1_$CALL CCSADD (NUMB1,2,NUMB2,1,NUMB3,1)_^1_$CALL CCSMVA (NUMB3,4,9,CREC,(I),9)_^1_$GO TO 400_^1C_]_^1C_JPROCESS RECOVERABLE CO ‚‚URT CO_^1C_JCOSTS WHICH CAN BE ADDED TO_^1C_JBORROWERS AMOUNT DELINQUENT_^1C_]_^1 370 CALL CCSMVA (FREC, 31, 9, NUMB1, 2, 9)_^1_$CALL CCSMVA (DREC, 887, 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (DREC, 887, 9, RREC, 42, 9)_^1C_JADD RECOVERABLE COURT COST_^1_$CALL CCSADD (NUMB1, 2, NUMB2, 1, NUMB3,1)_^1_$CALL CCSMVA (NUMB3, 4, 9, DREC, 887, 9)_^1_$CALL CCSMVA (DREC, 887, 9, RREC, 51, 9)_^1C_ ‚‚JADD TO CURRENT PAYOFF AMOUNT_^1_$CALL CCSMVA (DREC, 905, 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (DREC, 905, 9, RREC, 60, 9)_^1_$CALL CCSADD ( NUMB1, 2, NUMB2, 1, NUMB3,1)_^1_$CALL CCSMVA (NUMB3, 4, 9, DREC, 905, 9)_^1_$CALL CCSMVA (DREC, 905, 9, RREC, 69, 9)_^1C_JPLUG IN UPDATE DATE_^1_$CALL CCSMVA (CURDAT, 1, 6, DREC, 863, 6)_^1C_JADD RECOVERABLE COURT COSTS_^1C_JSAME FIELD IN CLIENT RE ‚‚CORD_^1C_JFOR MONTH(N)_^1_$I = I + 70_^1_$CALL CCSMVA (CREC, (I), 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (CREC, (I), 9, RREC, 78, 9)_^1C_JNUMB1 = COURT COST FROM TRAN_^1C_JNUMB2 = TOTAL COURT COST FRO_^1C_JCLIENT FILE RECORD_^1_$CALL CCSADD (NUMB1, 2, NUMB2, 1, NUMB3, 1)_^1C_JMOVE UPDATED COURT COSTS BAC_^1C_JINTO CLIENT RECORD_^1_$CALL CCSMVA (NUMB3, 4, 9, CREC, (I), 9)_^1_$CALL CCSMVA ( ‚‚CREC, (I), 9, RREC, 87, 9)_^1_$GO TO 400_^1C_JPROCESS NONRECOVERABLE COURT_^1C_JCOSTS - CANNOT BE ADDED TO_^1C_JAMOUNT DELINQUENT_^1 380 I = I + 79_^1_$CALL CCSMVA (CREC, (I), 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (CREC, (I), 9, RREC, 96, 9)_^1_$CALL CCSMVA (FREC, 31, 9, NUMB1, 2, 9)_^1_$CALL CCSADD (NUMB1, 2, NUMB2, 1, NUMB3,1)_^1C_JMOVE NON RECOVERABLE COURT C_^1C_JBACK INTO CLIENT RE ‚‚CORD FOR_^1C_JMONTH(N)_^1_$CALL CCSMVA (NUMB3, 4, 9, CREC, (I), 9)_^1_$CALL CCSMVA (CREC, (I), 9, RREC, 105, 9)_^1_$GO TO 410_^1C_JPROCESS FEE/COMMISSIONS_^1 390 I = I + 37_^1_$CALL CCSMVA (CREC, (I), 9, NUMB2, 4, 9)_^1_$CALL CCSMVA (FREC, 31, 9, NUMB1, 2, 9)_^1_$CALL CCSADD (NUMB1, 2, NUMB2, 1, NUMB3, 1)_^1C_JMOVE UPDATED COMMISSIONS BAC_^1C_JINTO CLIENT RECORD FOR MONTH_^1_$CALL ‚‚ CCSMVA (CREC, (I), 9, RREC, 114, 9)_^1_$CALL CCSMVA (NUMB3, 4, 9, CREC, (I), 9)_^1_$CALL CCSMVA (CREC, (I), 9, RREC, 123, 9)_^1_$GO TO 410_^1C_JWRITE UPDATED LADLQMST RECOR_^1 400 CALL UPDREC (DREQ,DREC,ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 410_^1C_JREPORT ERROR_^1_$CALL FILERR (DDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JWRITE UPDATED CLIENT RECORD_^1 410 CALL CCSMVA(CURDAT,1,6,CREC, ‚‚139,6)_^1_$CALL UPDREC (CREQ, CREC, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 420_^1_$CALL FILERR (CDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JBUILD AND WRITE OUT SUCCESSF_^1C_JLY PROCESSED TRANSACTIONS TO_^1C_JLAPMTFIL BUT ONLY FOR DIRECT_^1C_JAND INDIRECT PAYMENTS_^1 420 IF (TCODE .LT. $3035 .OR. TCODE .GT. $3036) GO TO 500_^1_$CALL CCSMVA (FREC, 1, 16, PREC, 1, 16)_^1_$CALL CCSMVA (FREC, ‚‚ 51, 2, PREC, 17, 2)_^1_$CALL CCSMVA (FREC, 31, 9, PREC, 19, 9)_^1_$CALL CCSMVA (FREC, 40, 6, PREC, 28, 6)_^1_$CALL CCSMVA (LGNO, 1, 4, PREC, 34, 4)_^1_$CALL PUTS (PREQ,PREC,1,ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 500_^1C_JREPORT ERRORS_^1_$CALL FILERR (PDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JREWRITE TRANSACTION TO LAFIN_^1C_JWITH THE '03' TRANS CODE CHA_^1C_JED TO '04'. IN THE EVENT ‚‚ OF_^1C_JRERUN THEY WILL NOT BE RE-_^1C_JPROCESSED_^1 500 CALL CCSMVA (TC, 1, 2, FREC, 29, 2)_^1_$CALL UPDREC (FREQ, FREC, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 600_^1C_HREPORT ERROR_^1_$CALL FILERR (FDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JTHIS SECTION WILL CONSTRUCT_^1C_JA RECORD FOR EACH PROCESSED_^1C_JTRANSACTION TO BE WRITTEN TO_^1C_JLARPTDAT FILE. THIS FILE WIL_^1C_JBE USED TO ‚‚PRODUCE AN AUDIT_^1C_JTRAIL REPORT_^1 600 CALL CCSMVA (FREC, 1, 16, RREC, 1, 16)_^1_$CALL CCSMVA (FREC, 51, 2, RREC, 17, 2)_^1_$CALL CCSMVA (FREC, 31, 9, RREC, 19, 9)_^1_$CALL CCSMVA (FREC, 40, 6, RREC, 28, 6)_^1_$CALL CCSMVA (FREC, 17, 4, RREC, 34, 4)_^1_$CALL CCSMVA (FREC,46, 4, RREC, 38, 4)_^1_$CALL PUTS (RREQ,RREC,1,ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 200_^1C_JREPORT ERROR_^1_$ ‚‚CALL FILERR (RDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JCLIENT REASSIGNMENT LOGIC._^1C_J(1)REARRANGE TRANS TO LOOK L_^1C_JPAYMENT TRANS,(2)GET L/A NUM_^1C_JDO READ FOR CLIENT RECORD_^1 700 CALL CCSMVA(FREC,33,4,FREC,46,4)_^1_$CALL CCSMVA(CURDAT,1,6,FREC,40,6)_^1_$CALL CCSMVA(CLRFLD,1,9,FREC,31,9)_^1_$CALL CCSMVA (FREC,46,4,LGNO,1,4)_^1_$CALL READR (CREQ,CREC,LGNO,ISTAT)_^1_$IF (ISTA ‚‚T .EQ. 0) GO TO 710_^1C_JREPORT ERROR_^1_$IF (ISTAT .GT. 0) GO TO 820_^1_$CALL FILERR (CDATA,13,ISTAT,LU)_^1_$GO TO 810_^1C_JGET ACCOUNT NUMBER,DO A READ_^1C_JFOR THE LADLQMST RECORD_^1 710 CALL CCSMVA (FREC,1,16,ACTNUM,1,16)_^1_$CALL READR (DREQ,DREC,ACTNUM,ISTAT)_^1_$IF (ISTAT .EQ. 0) GO TO 715_^1C_JREPORT ERROR_^1_$IF (ISTAT .GT. 0) GO TO 800_^1_$CALL FILERR (DDATA,13,ISTAT,LU) ‚‚_^1_$GO TO 800_^1C_JCOMPARE LGNO FROM TRANS WITH_^1C_JREASSIGN FIELD IN LADLQMST-_^1C_JACCEPT ONLY LATEST, THROW_^1C_JOTHERS AWAY_^1 715 CALL CCSCST(LGNO,1,4,DREC,1382,4,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 720_^1_$GO TO 200_^1C_JCLEAR 1382 IN LADLQMST_^1 720 CALL CCSMVA(BLANK,1,4,DREC,1382,4)_^1C_JWITHIN LADLQMST RECORD, MOVE_^1C_JMOVE CURRENT CLIENT DATA TO_^1C_JPREVIOUS_^1_$CA ‚‚LL CCSMVA (DREC,1072,4,DREC,1229,4)_^1_$CALL CCSMVA (DREC,1076,6,DREC,1233,6)_^1_$CALL CCSMVA (DREC,1082,30,DREC,1239,30)_^1_$CALL CCSMVA (DREC,1112,30,DREC,1269,30)_^1_$CALL CCSMVA (DREC,1142,60,DREC,1299,60)_^1_$CALL CCSMVA (DREC,1202,10,DREC,1359,10)_^1_$CALL CCSMVA (DREC,1212,4,DREC,1369,4)_^1_$CALL CCSMVA (DREC,1216,9,DREC,1373,9)_^1C_JMOVE NEW CLIENT DATA TO CURR_^1C_JCLIENT ‚‚FILEDS_^1_$CALL CCSMVA (CREC,1,4,DREC,1072,4)_^1_$CALL CCSMVA (CURDAT,1,6,DREC,1076,6)_^1_$CALL CCSMVA (CREC,5,30,DREC,1082,30)_^1_$CALL CCSMVA (CREC,35,30,DREC,1112,30)_^1_$CALL CCSMVA (CREC,65,60,DREC,1142,60)_^1_$CALL CCSMVA (CREC,125,10,DREC,1202,10)_^1_$CALL CCSMVA (CREC,135,4,DREC,1212,4)_^1_$CALL CCSMVA (DREC,905,9,DREC,1216,9)_^1_$CALL CCSMVA (CREC,145,4,DREC,1225,4)_^1C_JW ‚‚RITE OUT UPDATED LADLQMST_^1_$CALL UPDREC (DREQ, DREC, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 730_^1_$CALL FILERR (DDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JUPDATE '# ACCTS PLACED' DATA_^1C_JIN CURRENT CLIENT RECORD_^1 730 I = 69_^1_$DO 735 J = 1,12_^1_$I = I + 88_^1_$CALL CCSCST (YYMM,3,2,CREC,(I),2,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 740_^1 735 CONTINUE_^1C_JDROPPED THRU LOOP - COU ‚‚LD NO_^1C_JFIND MATCHING MONTH/YEAR SET_^1C_JLOOK FOR FIRST AVAILABLE SET_^1C_JAND USE IT._^1_$I = 67_^1_$DO 736 J = 1,12_^1_$I = I + 88_^1_$CALL CCSCST(CREC,(I),4,BLANK,1,4,COMPIN)_^1_$IF (COMPIN .NE. 0) GO TO 736_^1_$CALL CCSMVA (CLRFLD,1, 4,CREC,(I), 4)_^1_$CALL CCSMVA (FREC,44,2,CREC,(I),2)_^1_$I = I + 2_^1_$CALL CCSMVA (FREC,40,2,CREC,(I),2)_^1_$I = I - 2_^1_$GO TO 750_^1 736 ‚‚ CONTINUE_^1C_JEERROR IN CLIENT RECORD_^1_$GO TO 850_^1C_JFOUND MONTH BUCKET,CHECK YEA_^1 740 I = I - 2_^1_$CALL CCSCST (YYMM,1,2,CREC,(I),2,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 750_^1C_JLAST YEARS DATA, CLEAR IT OU_^1_$CALL CCSMVA(YYMM,1,2,CREC,(I),2)_^1_$I = I + 4_^1_$CALL CCSMVA(SPACES,1,84,CREC,(I),84)_^1_$I = I - 4_^1_$GO TO 750_^1C_JGOT THE RIGHT MONTH AND YEAR_^1C_JBUCKET. ‚‚ADD 1 TO '#ACCTS PLA_^1C_JED' AND ACCOUNT BALANCE DUE_^1C_JTO '$ VALUE OF ACCTS PLACED'_^1C_JIN CURRENT CLIENT RECORD_^1 750 I = I + 4_^1_$CALL CCSMVA (CLRFLD,1,17,NUMB1,1,17)_^1_$CALL CCSMVA (ONE,1,2,NUMB1,9,2)_^1_$CALL CCSMVA (CREC,(I),3,NUMB2,10,3)_^1_$CALL CCSADD (NUMB1,2,NUMB2,1,NUMB3,1)_^1_$CALL CCSMVA (NUMB3,10,3,CREC,(I),3)_^1_$I = I + 3_^1_$CALL CCSMVA (DREC,1216,9,NUMB1, ‚‚2,9)_^1_$CALL CCSMVA (CREC,(I),9,NUMB2,4,9)_^1_$CALL CCSADD (NUMB1,2,NUMB2,1,NUMB3,1)_^1_$CALL CCSMVA (NUMB3,4,9,CREC,(I),9)_^1C_JWRITE UPDATED CLIENT RECORD_^1_$CALL UPDREC (CREQ,CREC,ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 760_^1_$CALL FILERR (CDATA,I4,ISTAT,LU)_^1_$GO TO 900_^1C_JDO MUCH THE SAME THING TO TH_^1C_JPREVIOUS CLIENT RECORD EXCEP_^1C_JTHE DATA FIELDS ARE # AND $_^1C_JVALU ‚‚E OF 'ACCOUNT CLOSED'_^1 760 CALL CCSMVA (DREC, 1229,4,LGNO,1,4)_^1_$CALL CCSCST (LGNO,1,4,BLANK,1,4,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 790_^1C_JSKIP IF LGNO = BLANKS_^1_$CALL READR (CREQ,CREC,LGNO,ISTAT)_^1_$IF (ISTAT .EQ. 0) GO TO 761_^1_$IF (ISTAT .GT. 0) GO TO 820_^1_$CALL FILERR (CDATA,I4,ISTAT,LU)_^1_$GO TO 900_^1C_]_^1 761 I = 69_^1_$DO 765 J = 1,12_^1_$I = I + 88_^1_$CA ‚‚LL CCSCST (YYMM,3,2,CREC,(I),2,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 770_^1 765 CONTINUE_^1C_JNO MATCH ON YEAR/MONTH SET._^1C_JFIND FIRST AVAILABLE SET AND_^1C_JUSE IT_^1_$I = 67_^1_$DO 766 J = 1,12_^1_$I = I + 88_^1_$CALL CCSCST (CREC,(I),4,BLANK,1,4,COMPIN)_^1_$IF (COMPIN .NE. 0) GO TO 766_^1_$CALL CCSMVA (CLRFLD,1, 4,CREC,(I), 4)_^1_$CALL CCSMVA (FREC,44,2,CREC,(I),2)_^1_$I = I ‚‚ + 2_^1_$CALL CCSMVA (FREC,40,2,CREC,(I),2)_^1_$I = I - 2_^1_$GO TO 780_^1 766 CONTINUE_^1C_JERROR IN CLIENT RECORD_^1_$GO TO 850_^1C_JGOT MONTH BUCKET, CHECK YEAR_^1 770 I = I - 2_^1_$CALL CCSCST (YYMM,1,2,CREC,(I),2,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 780_^1C_JLAST YEARS DATA, CLEAR IT OU_^1_$CALL CCSMVA(YYMM,1,2,CREC,(I),2)_^1_$I = I + 4_^1_$CALL CCSMVA(SPACES,1,84,CREC,(I),8 ‚‚4)_^1_$I = I - 4_^1_$GO TO 780_^1C_IADD IN THE # AND $ AMOUNT_^1 780 I = I + 46_^1_$CALL CCSMVA (CLRFLD,1,17,NUMB1,1,17)_^1_$CALL CCSMVA (ONE,1,2,NUMB1,9,2)_^1_$CALL CCSMVA (CREC,(I),3,NUMB2,10,3)_^1_$CALL CCSADD (NUMB1,2,NUMB2,1,NUMB3,1)_^1_$CALL CCSMVA (NUMB3,10,3,CREC,(I),3)_^1C_]_^1_$I = I + 3_^1_$CALL CCSMVA (DREC,1216,9,NUMB1,2,9)_^1_$CALL CCSMVA (CREC,(I),9,NUMB2,4,9)_^1_$C ‚‚ALL CCSADD (NUMB1,2,NUMB2,1,NUMB3,1)_^1_$CALL CCSMVA (NUMB3,4,9,CREC,(I),9)_^1C_JWRITE UPDATED CLIENT RECORD_^1_$CALL UPDREC (CREQ, CREC,ISTAT)_^1_$IF (ISTAT .GE. 0 ) GO TO 790_^1_$CALL FILERR (CDATA,I4,ISTAT,LU)_^1_$GO TO 800_^1C_IREASSIGNMENT LOGIC COMPLETE_^1 790 GO TO 500_^1C_JSET CODE FOR NOT FOUND IN_^1C_JLADLQMST_^1 800 CALL CCSMVA (EM1, 1, 2, RREC, 150, 2)_^1_$GO TO 890_^ ‚‚1C_JSET CODE FOR NOT FOUND IN_^1C_JLACLIENT_^1 810 CALL CCSMVA (EM2, 1, 2, RREC, 150, 2)_^1_$GO TO 890_^1C_@SET CODE FOR LGNO = BLANKS_^1 820 CALL CCSMVA (EM3,1,2,RREC,150,2)_^1_$GO TO 890_^1C_@SET CODE FOR INVALID MONTH_^1 830 CALL CCSMVA (EM4,1,2,RREC,150,2)_^1_$GO TO 890_^1C_@SET CODE FOR INVALID YEAR_^1 840 CALL CCSMVA (EM5,1,2,RREC,150,2)_^1_$GO TO 890_^1C_JSET CODE FOR BA ‚‚D CLIENT REC_^1 850 CALL CCSMVA (EM6, 1, 2, RREC, 150, 2)_^1_$GO TO 890_^1C_JSET CODE FOR INVALID SIGN_^1 860 CALL CCSMVA (EM7,1,2,RREC,150,2)_^1_$GO TO 890_^1C_JCOMPLETE THE REST OF THE REP_^1C_JDATA RECORD_^1 890 CALL CCSMVA (FREC, 1, 16, RREC, 1, 16)_^1_$CALL CCSMVA (FREC, 51, 2, RREC, 17, 2)_^1_$CALL CCSMVA (FREC, 31, 9, RREC, 19, 9)_^1_$CALL CCSMVA (FREC, 40, 6, RREC, 28, 6 ‚‚)_^1_$CALL CCSMVA (FREC, 17, 4, RREC, 34, 4)_^1_$CALL CCSMVA (FREC, 46, 4, RREC, 38, 4)_^1C_JWRITE REPORT DATA RECORD_^1_$CALL PUTS (RREQ,RREC,1,ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 200_^1C_IREPORT ERROR_^1_$CALL FILERR (RDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_JCLOSE UP SHOP AND EXIT_^1 900 CALL CLOSFL (DREQ, ISTAT)_^1_$CALL CLOSFL (CREQ, ISTAT)_^1_$CALL CLOSFL (FREQ, ISTAT)_^1_$CAL ‚‚L CLOSFL (PREQ, ISTAT)_^1_$CALL CLOSFL (RREQ, ISTAT)_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LBLDSR CSY/ F22 0010 ‚‚1_%PROGRAM LBLDSR_^1_#1_2/F22 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_#GENERATE SCREEN FILE FOR DISPLAY._^1C_]_^1C_#GENERATES A SCREEN FILE FROM 80 COLUMN INPUT RECORDS. INPUT IS FRO_^1C_#THE FILE 'LASCNDSC'. THIS FILE IS LOADED ONTO T ‚‚HE SYSTEM VIA A PRO_^1C_#CEDURE STREAM, MODIFIED WITH THE EDITIOR, USED FOR INPUT TO THIS_^1C_#PROGRAM, AND FINALLY SAVED ON TAPE. EACH RECORD IN THE SCREEN FILE_^1C_#'LASCNFIL' CONTAINS A SCREEN DEFINITION WITH ENOUGH INFORMATION TO_^1C_#TO CONSTRUCT A SCREEN. THE FORMAT FOR THE INPUT RECORDS FROM_^1C_#'LASCNDSC' IS:_^1C_7COLS_)DESCRIPTION_^1C_*FIRST CARD_!1 - 2_(SCREEN NUMBER._^1 ‚‚C_73 - 80_'COMMENTS._^1C_*NEXT N RECS 1 - 2_(LINE NUMBER FOR ITEM (01-24)_^1C_73 - 4_(COLUMN NUMBER FOR ITEM (01-80)._^1C_75 - 6_(LENGTH OF FIELD IN BYTES._^1C_77 - 10_'STARTING POSITION IN FILE IF_^1C_FAPPLICABLE._^1C_711_+FIELD TYPE FOR EDITING (SEE BELOW_^1C_712 - 80_%CONSTANT SCREEN FIELD._^1C_741 - 80_%COMMENTS IF NOT CONSTANT FIELD._^1C_*LAST RECORD 1 - 3_(CONSTANT 'END'._^ ‚‚1C_74 - 80_'COMMENTS._^1C_#THE LAST RECORD TO TERMINATE THE SCREEN FILE BUILD IS AN 'END'_^1C_#RECORD WITH THE 'END' STARTING IN COLUMN ONE._^1C_]_^1C_#FIELD TYPES USED ARE:_^1C_*0 = CONSTANT SCREEN FIELD._^1C_*1 = DATE IN FORM MM/DD/YY._^1C_*2 = ALPHA/NUMERIC IN FILE._^1C_*3 = NINE DIGIT DOLLAR AMOUNT IN FORM 9999999.99 ._^1C_*4 = TEN DIGIT PHONE NUMBER IN FORM 999/999-9999 ._^1C_ ‚‚*5 = RESTRICTED USAGE TO REPORT COLLECTION ACTIVITY._^1C_*6 = SOCIAL SECURITY NUMBER IN FORM 999-99-9999 ._^1C_*7 = TIME OF DAY IN 24 HOUR TIME, HHMM ._^1C_*8 = CONSTANT SCREEN FIELD LABELLING CHANGE SCREEN ITEM._^1C_*9 = MOST RECENT COLLECTION ACTIVITY._^1C_]_^1C_#DESCRIPTION OF THE OUTPUT SCREEN DEFINITION RECORD GIVEN IN THE_^1C_#DISPLY SUBROUTINE._^11_]_^1_$INTEGER X,Y,TEMP(8), ‚‚INBUF(42),OBUF(1002),NXTWRD,FLDTYP,_^1_#1_$LENGTH,KEY,FILPOS(2),FLAG,ENDMSG(15),ZERO,CSF(1)_^1_$INTEGER SCRSIZ,ERRMSG(26)_^1_$DATA SCRSIZ / 1000 /_^1_$DATA ERRMSG / ' ***** SCREEN EXCEEDS MAXIMUM ALLOWABLE SIZE *',_^1_#1_"'****' /_^1_$INTEGER REQBF1(24),REQBF2(24),IDATA1(15),IDATA2(15)_^1_$INTEGER END,LP,ONE,SIX,TWO_^1_$INTEGER EIGHT,ENDLEN,OBFLEN,TC,XYN_^1_$INTEGER TOF,LF,TITLE1 ‚‚(13),TITLE2(5),POSTI1_^1_$INTEGER POSTI2,LENTI1,LENTI2,STDHDR(60),DATE(3),DATPOS,HDRONE_^1_$INTEGER HDRTWO,HDRLEN,FOUR,ASCTEN_^11_]_^1_$EQUIVALENCE (INBUF(1),KEY),(INBUF(1),Y),(INBUF(2),X),_^1_#1_#(INBUF(3),LENGTH),(INBUF(4),FILPOS(1)),(INBUF(6),CSF(1))_^11_]_^1_$DATA REQBF1/24*0/,REQBF2/24*0/,IDATA1/'LASCNFIL',8*$2020,0,1,-1/,_^1_#1_$IDATA2/'LASCNDSC',8*$2020,0,1,-1/,OBUF/1002*$20 ‚‚20/_^1_$DATA END/'EN'/,TWO/2/,LP/9/,ONE/1/,INPLEN/80/,FLAG/0/,ZERO/0/_^1_$DATA ENDLEN/30/,OBFLEN/2004/,XYN/-1/_^1_$DATA ENDMSG/$D0A,'SCREEN FILE BUILD COMPLETE '/_^1_$DATA TOF/$C00/,LF/$D20/,HDRLEN/40/_^1_$DATA TITLE1/'SCREEN FILE BUILD LASCNFIL'/,TITLE2/'RUN DATE: '/_^1_$DATA POSTI1/45/,POSTI2/47/,LENTI1/25/,LENTI2/9/,DATPOS/57/_^1_$DATA HDRONE/1/,HDRTWO/41/,ASCTEN/$30/_^14_]_^1C_ ‚‚]_^1C_#PROGRAM LOGIN. MASTER CONSOLE USAGE ONLY ALLOWED._^1C_]_^1_$CALL PGMIN(TEMP,LU,I,J)_^1C_#EXIT IF NOT MASTER CONSOLE._^1_$IF(J.NE.0) GO TO 950_^11_]_^1C_#CLEAR SCREEN DECRIPTION FILE._^1_$CALL CLEAR(REQBF1,IDATA1,ISTAT)_^1C_#CHECK IF FILE OPEN OR OTHER ERROR._^1_$IF(ISTAT.LT.0) GO TO 810_^1C_#NO ERRORS, OPEN BOTH FILES. LOCK FILE UPON ACCESS._^1C_#ZERO OUT REQBF1 FIRST._^1_$D ‚‚O 50 I=1,24_^1 50 REQBF1(I) = 0_^1_$CALL OPENFL(REQBF1,IDATA1,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 820_^1C_#NO ERROR._^1_$CALL OPENFL(REQBF2,IDATA2,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 830_^1C_#NO ERRORS. RETRIEVE STANDARD HEADERS FOR OUTPUT._^1_$CALL LAHEAD(STDHDR,DATE)_^1C_#START SCREEN FILE CONSTRUCTION._^1._]_^1C_]_^1C_#OUTPUT HEADER INFORMAT ‚‚ION ON FRESH PAGE._^1C_]_^1C_#SET TOP OF FORM._^1 100 INBUF(1) = TOF_^1C_#MOVE IN FIRST LINE OF STANDARD HEADER BLANKING REMAINING BUFFER._^1_$CALL CCSMVA(STDHDR,HDRONE,HDRLEN,INBUF,TWO,INPLEN)_^1C_#MOVE IN FIRST LINE OF TITLE._^1_$CALL CCSMVA(TITLE1,ONE,LENTI1,INBUF,POSTI1,LENTI1)_^1C_#WRITE FIRST LINE._^1_$ASSIGN 110 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,ICOMPL,FLAG,TEMP)_^1 ‚‚_$CALL DISP_^11_]_^1C_#MOVE IN SECOND LINE OF STANDARD HEADER BLANKING REMAINING BUFFER._^1 110 CALL CCSMVA(STDHDR,HDRTWO,HDRLEN,INBUF,ONE,INPLEN)_^1C_#MOVE IN SECOND LINE OF TITLE._^1_$CALL CCSMVA(TITLE2,ONE,LENTI2,INBUF,POSTI2,LENTI2)_^1C_#MOVE IN RUN DATE._^1_$CALL EDIT(DATE,ONE,INBUF,DATPOS,ONE)_^1C_#WRITE SECOND LINE._^1_$ASSIGN 120 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,I ‚‚COMPL,FLAG,TEMP)_^1_$CALL DISP_^11_]_^1C_#WRITE THIRD LINE OF STANDARD HEADER WITH LINE FEED AT END._^1 120 STDHDR(60) = LF_^1_$ASSIGN 130 TO ICOMPL_^1_$CALL FWRITE(LP,STDHDR(41),HDRLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^12_]_^1C_]_^1C_#RETRIEVE DESIRED SCREEN DEFINITION._^1C_]_^1 130 CALL GETS(REQBF2,INBUF,TEMP,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 840_^1C_#CHECK F ‚‚OR END OF SCREENS - TERMINATE IF YES._^1_$IF(KEY.EQ.END) GO TO 900_^11_]_^1C_#START NEW SCREEN. SET KEY INTO FIRST TWO BYTES OF OUTPUT RECORD._^1_$OBUF(1) = ICCSAD(KEY)_^1C_#OUTPUT SCREEN NUMBER AND TITLE._^1_$ASSIGN 150 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1 150 NXTWRD = 2_^11_]_^1C_#READ SCREEN DEFINITIONS._^1 200 CALL GETS(REQBF2,INBUF,TEM ‚‚P,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 840_^1C_#LIST SCREEN DESCRIPTION RECORD INPUT._^1_$ASSIGN 205 TO ICOMPL_^1_$CALL FWRITE(LP,INBUF,INPLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1C_#CHECK FOR END OF SCREEN DEFINITION._^1 205 IF(Y.EQ.END) GO TO 300_^11_]_^1C_#CONSTRUCT SCREEN DEFINITION FROM INPUT. CONSTRUCT FIRST WORD, X-Y_^1C_#POSITIONING. SAVE INDEX FOR SECOND WOR ‚‚D._^1 206 ISAVE = NXTWRD + 1_^1_$OBUF(NXTWRD) = (ICCSAD(X)-1)*$100 + ICCSAD(Y)-1_^11_]_^1C_#SET SECOND WORD, THE LOCATION OF THE NEXT FIELD DESCRIPTION._^1C_#CONVERT FIELD TYPE AND LENGTH TO NUMBERS._^1_$FLDTYP = AND(INBUF(6)/$100,$F)_^1_$LENGTH = ICCSAD(LENGTH)_^1C_#CHECK IF FIELD TYPE = 0 OR 8, CONSTANT SCREEN FIELD._^1_$IF(FLDTYP.EQ.0.OR.FLDTYP.EQ.8) GO TO 210_^1_$OBUF(NXTWRD+1 ‚‚) = NXTWRD + 5_^1_$IF((NXTWRD+5).GT.SCRSIZ) GO TO 280_^1_$GO TO 220_^1C_#CONSTANT SCREEN FIELD. START OF NEXT FIELD DESCRIPTION MUST INCLUD_^1C_#ANY CHARACTERS SAVED._^1 210 OBUF(NXTWRD+1) = NXTWRD + 5 + (LENGTH+1)/2_^1_$IF(OBUF(NXTWRD+1).GT.SCRSIZ) GO TO 280_^11_]_^1C_#GET THIRD WORD, LENGTH OF SCREEN ITEM._^1 220 OBUF(NXTWRD+2) = LENGTH_^11_]_^1C_#GET FOURTH AND FIFTH WORDS, FI ‚‚LE POSITION AND FIELD TYPE._^1_$IF(FLDTYP.EQ.0.OR.FLDTYP.EQ.8) GO TO 250_^1_$OBUF(NXTWRD+3) = ICCSAD(FILPOS(1))*100 + ICCSAD(FILPOS(2))_^1_$OBUF(NXTWRD+4) = FLDTYP_^1_$GO TO 260_^11_]_^1C_#CONSTANT SCREEN FIELD - SET STARTING POSITION IN FILE FIELD TO ONE_^1C_#AND SAVE THE FIELD TYPE AND CONSTANT SCREEN FIELD._^1 250 OBUF(NXTWRD+3) = 1_^1_$OBUF(NXTWRD+4) = FLDTYP_^1C_#SET STARTING ‚‚ BYTE INTO OBUF WHERE FIELD IS TO BE MOVED._^1_$J = (NXTWRD + 5) * 2 - 1_^1_$K=((LENGTH+1)/2)+(NXTWRD+5)_^1_$IF(K.GE.SCRSIZ) GO TO 280_^1_$CALL CCSMVA(CSF,TWO,LENGTH,OBUF,J,LENGTH)_^1 260 NXTWRD = OBUF(NXTWRD+1)_^1_$IF(NXTWRD.GE.SCRSIZ) GO TO 280_^1_$GO TO 200_^11_]_^1C_#SCRNFILE BUFFER WAS EXCEEDED - PRINT MESSAGE_^1C_#CONTINUE TO CHECK NEXT SCREENS_^1 280 NXTWRD=2_^1_$ASSIGN 2 ‚‚90 TO ICOMPL_^1_$CALL FWRITE(LP,ERRMSG,52,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1 290 ASSIGN 206 TO ICOMPL_^1_$CALL FWRITE(LU,ERRMSG,52,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^12_]_^1C_#SCREEN COMPLETE. TERMINATE SCREEN DESCRIPTION AND SAVE RECORD._^1C_]_^1 300 OBUF(ISAVE) = 0_^1_$CALL WRITER(REQBF1,OBUF,OBUF(1),ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 850_^1C_#NO ERROR, BLANK O ‚‚UTPUT BUFFER AND PROCESS NEXT SCREEN._^1_$CALL CCSBLK(OBUF,OBFLEN)_^1_$GO TO 100_^1._]_^1C_]_^1C_#FILE ERRORS._^1C_]_^1C_#CLEAR REQUEST, LASCNFIL._^1 810 I = 1_^1_$GO TO 825_^1C_#OPEN REQUEST, LASCNFIL._^1 820 I = 3_^1 825 CALL FILERR(IDATA1,I,ISTAT,LU)_^1_$GO TO 910_^1C_#OPEN REQUEST, LASCNDSC._^1 830 I = 3_^1_$GO TO 845_^1C_#GETS REQUEST, LASCNDSC._^1 840 I = 14_^1 845 CALL ‚‚ FILERR(IDATA2,I,ISTAT,LU)_^1_$GO TO 910_^1C_#WRITER REQUEST, LASCNFIL._^1 850 I = 12_^1_$GO TO 825_^11_]_^1C_#NORMAL TERMINATION. OUTPUT BUILD COMPLETE MESSAGE._^1 900 ASSIGN 905 TO ICOMPL_^1_$CALL FWRITE(LP,ENDMSG,ENDLEN,ICOMPL,FLAG,TEMP)_^1_$CALL DISP_^1 905 CALL WTREAD(LU,XYN,ENDMSG,ENDLEN,ZERO,ZERO,ZERO,TC)_^11_]_^1C_#FORCE FILE CLOSURES. IGNORE ANY ERRORS._^1 910 CALL CLO ‚‚SFL(REQBF1,ISTAT)_^1_$CALL CLOSFL(REQBF2,ISTAT)_^1C_#EXIT._^1 950 CALL PGMOUT_^1_$END_]_^__ ‚‚LCCSSP CSY/ F24 0020 ‚‚1_$PROGRAM LCCSSP_^1_#1_2/F24 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C---------------------------------------------------------------------_^1C_]_^1C_#AUDIT PRODUCES THE FILE SPACE REPORT. THE REPORT DISPLAYS FILE_^1C_#NAMES AND AVAILA ‚‚BLE SPACE INFORMATION IN THE FORM OF (1) MAXIMUM_^1C_#RECORDS ALLOWED, (2) NUMBER OF RECORDS CURRENTLY IN THE FILE,_^1C_#(3) NUMBER OF RECORDS REMAINING, AND (4) PERCENTAGE OF TOTAL FILE_^1C_#SPACE AVAILABLE. THIS INFORMATION IS GIVEN FOR SEVEN FILES :_^1C_#DELQMST, COSIGNER, ACCAGE, ACTFIL, SUMHIST, TAPEARC, AND INACCT._^1C_]_^1C--------------------------------------------------- ‚‚------------------_^1C_]_^1C ---- PROGRAM DECLARATIONS ----_^1C_]_^1_$EXTERNAL AMONTO,ADAYTO,AYERTO_^1C_]_^1_$RELATIVE GETFCB_^1C_]_^1_$INTEGER LU,LST,OD_^1_$INTEGER REQBUF(24),VOLNAM(4),INDEX,FCBBFR(96),ISTAT,ERR(13)_^1_$INTEGER NAME(4),REC_^1_$REAL MXRECS,CURECS,AVRECS_^1_$INTEGER IDATA(15,7)_^1_$INTEGER MO,DA,YR_^1_$INTEGER RPTHDR(9),HDR1(40),HDR2(40),MSGMU(40),MSGWN(40)_^1C_]_^ ‚‚1_$REAL HIRECS,NMRECS,RMRECS,PCTREM,TDATRM,TDATRL,NEDATM,NEDATL_^1_$REAL COMPM,COMPW_^1C_]_^1_$DATA COMPM/05.0/,COMPW/15.0/_^1_$DATA IDATA/ 'LADLQMST',8*$2020,0,1,0, 'LACOSIGN',8*$2020,0,1,0,_^1_#1_+'LAACCAGE',8*$2020,0,1,0, 'LAACTFIL',8*$2020,0,1,0,_^1_#2_+'LASUMHST',8*$2020,0,1,0, 'LATAPARC',8*$2020,0,1,0,_^1_#3_+'LAINACCT',8*$2020,0,1,0/_^1_$DATA REC / 0 /_^1_$DATA LST/12/,LU/4/ ‚‚_^1_$DATA RPTHDR/' FILE SPACE REPORT'/_^1_$DATA HDR1/'_%FILE_(MAXIMUM_#CURRENT_#AVAILABLE_^1_#2_"PCT SPACE_+'/_^1_$DATA HDR2/'_%NAME_(RECORDS_#RECORDS_$RECORDS_^1_#2_"AVAILABLE_+'/_^1_$DATA MSGMU/'_#THIS FILE MUST BE COMPRESSED AND HISTORY MUST BE_^1_#2RUN_"*****_,'/_^1_$DATA MSGWN/'_#WARNING_"-_"THIS FILE SHOULD BE COMPRESSED_^1_#2_%*****_,'/_^1C_]_^1_$EQUIVALENCE (FCBBFR(25),NAME ‚‚(1))_^1_$BYTE (ISIGN1,TDATRL(15=15)),(ISIGN2,NEDATL(15=15))_^1C_]_^1C ---- GET DATE ----_^1C_]_^1_$MO = AND(AMONTO,$FFFF)_^1_$DA = AND(ADAYTO,$FFFF)_^1_$YR = AND(AYERTO,$FFFF)_^1C_]_^1C ---- GET APPROPRIATE FCBS ----_^1C_]_^1_$DO 199 K = 1, 7_^1C_(ZERO THE REQUEST BUFFER FOR THE NEXT FILE_^1_$DO 250 J = 1, 24_^1 250 REQBUF(J) = 0_^1C_(OPEN THE FILE FOR USE_^1_$CALL OPENFL ( REQBUF ‚‚, IDATA(1,K), ISTAT )_^1C_(ERROR ?_^1_$IF ( ISTAT .GE. 0 ) GO TO 260_^1_$CALL FILERR ( IDATA(1,K), 3, ISTAT, LU )_^1_$GO TO 199_^1C_(GET THE FCB_^1 260 VOLNAM(1) = 0_^1_$CALL GETFCB ( REQBUF, VOLNAM, INDEX, FCBBFR, ISTAT )_^1C_(ERROR ?_^1_$IF ( ISTAT .GE. 0 ) GO TO 300_^1_$CALL FILERR ( IDATA(1,K), 7, ISTAT, LU )_^1_$GO TO 280_^1C_]_^1C ---- HIT ----_^1C_]_^1 300 REC = REC + 1_^1 ‚‚C_]_^1C ---- CONVERT TWO-WORD BINARY NUMBER TO REAL ----_^1C_]_^1_$TDATRM = FCBBFR(2) * 65536._^1_$TDATRL = FCBBFR(3)_^1_$IF ( ISIGN1 .EQ. 1 ) TDATRL = TDATRL + 65535._^1_$HIRECS = TDATRM + TDATRL_^1C_]_^1_$NEDATM = FCBBFR(7) * 65536._^1_$NEDATL = FCBBFR(8)_^1_$IF ( ISIGN2 .EQ. 1 ) NEDATL = NEDATL + 65535._^1_$NMRECS = NEDATM + NEDATL_^1C_]_^1C ---- FIND REMAINING NUMBER OF RECORDS ‚‚ AND PREPARE FOR OUTPUT ----_^1C_]_^1_$RMRECS = HIRECS - NMRECS_^1_$CURECS = NMRECS_^1_$MXRECS = HIRECS_^1_$AVRECS = RMRECS_^1_$PCTREM = 0_^1_$IF ( HIRECS .EQ. 0 ) GO TO 310_^1_$PCTREM = (RMRECS / HIRECS) * 100._^1 310 IF ( REC .GT. 1 ) GO TO 350_^1C_]_^1C ---- OUTPUT HEADERS ----_^1C_]_^1_$OD = LU_^1_$WRITE (OD,3002)_^1_$WRITE (OD,3005) (HDR1(I),I=1,35)_^1_$WRITE (OD,3005) (HDR2( ‚‚I),I=1,35)_^1_$WRITE (OD,3001)_^1C_]_^1_$OD = LST_^1_$WRITE (OD,3000) (RPTHDR(I),I=1,9),MO,DA,YR_^1_$WRITE (OD,3006) (HDR1(I),I=1,40)_^1_$WRITE (OD,3006) (HDR2(I),I=1,40)_^1_$WRITE (OD,3002)_^1C_]_^1C ---- OUTPUT FILE INFORMATION ----_^1C_]_^1 350 OD = LU_^1_$WRITE (OD,3020) (NAME(I),I=1,4),MXRECS,CURECS,AVRECS,PCTREM_^1_$IF (PCTREM .GT. COMPW) GO TO 370_^1_$IF (PCTREM .GT. COMPM) ‚‚ GO TO 360_^1_$WRITE (OD,3005) (MSGMU(I),I=1,35)_^1_$GO TO 370_^1 360 WRITE (OD,3005) (MSGWN(I),I=1,35)_^1 370 WRITE (OD,3888)_^1C_]_^1_$OD = LST_^1_$WRITE (OD,3030) (NAME(I),I=1,4),MXRECS,CURECS,AVRECS,PCTREM_^1_$IF (PCTREM .GT. COMPW) GO TO 390_^1_$IF (PCTREM .GT. COMPM) GO TO 380_^1_$WRITE (OD,3006) (MSGMU(I),I=1,40)_^1_$GO TO 390_^1 380 WRITE (OD,3006) (MSGWN(I),I=1,40)_^1 ‚‚390 WRITE (OD,3001)_^1C_]_^1C ---- GET NEXT FCB ----_^1C_]_^1C_(CLOSE THE FILE AND CONTINUE_^1 280 CALL CLOSFL ( REQBUF, ISTAT )_^1 199 CONTINUE_^1C_]_^1C ---- END OF JOB PROCESSING ----_^1C_]_^1 900 WRITE (LU,3002)_^1_$WRITE (LST,3999)_^1 999 CALL PGMOUT_^1C_]_^1C ---- END ----_^1C_]_^1 3000 FORMAT (1H1,////,52X,9A2,2X,1H-,2X,2(1A2,1H/),1A2,////)_^1 3001 FORMAT (/)_^1 3002 FOR ‚‚MAT (//)_^1 3005 FORMAT (40A2)_^1 3006 FORMAT (31X,40A2)_^1 3020 FORMAT (5X,4A2,X,2(4X,F8.0),5X,F8.0,10X,F4.1,1H%)_^1 3030 FORMAT (36X,4A2,X,2(4X,F8.0),5X,F8.0,10X,F4.1,1H%)_^1 3888 FORMAT (X)_^1 3999 FORMAT (1H1)_^1_$END_]_^__ ‚‚LCHUD2 CSY/ F28 0020 ‚‚1_$PROGRAM LCHUD2_^1_#1_2/F28 F LA_!CCS 3.0_5SL-149_^11_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^11_]_^1C_(THIS PROGRAM WILL REQUEST THAT A HISTORY TAPE BE MOUNTED,_^1C_(IT WILL VERIFY THAT THE CORRECT TAPE IS MOUNTED, IT WILL_^1C_(THEN LOCATE THE CORRECT ACCOUNT AND VERIFY IT'S ‚‚ON THE_^1C_(DELQMST FILE; THEN ADD THE ACTFIL FILE WITH THE ACTIVITY_^1C_(BLOCK FROM THE TAPE. WHEN COMPLETE IT WILL THEN PROCESS_^1C_(ALL REMAINING TAPES, AS DETERMINED BY THE UPREQ FILE._^11_]_^11_]_^1_$INTEGER FP,REQBUF(72),IDATA(15),USER(4),RECBUF(1000),TREC(1001),_^1_#2_'AREC(252),HD(20,3),DT(3),FNAME(4,3),RTYPE,ZERO,ACT(9),_^1_#2_'COMMD(2),OK,EX,RD,TEMP(8),ERMSG(13),NFMSG(26) ‚‚,DATE(3),_^1_#2_'OLDTP(3),MTMSG(52),TFL(4),RESLT(2),PRYES(2),PRNO(2),_^1_#2_'RQACT(8),TPACT(8),SUF(3),BOROW(15),SW,SKP_^1_$INTEGER BLK(8)_^1_$INTEGER ENDMSG(7),NMTMSG(14),REEL_^11_]_^1_$EQUIVALENCE ( TREC(8),TPACT(8) )_^11_]_^1C_(INITIALIZE THE REQUEST BUFFERS_^1_$DATA REQBUF / 72*0 /_^11_]_^1C_(SET UP THE DATA FOR OPENING THE FILES_^1_$DATA IDATA / 12*$2020, 1, 1, -1 /_^11_]_^1C_( ‚‚SET UP THE BUFFER WITH THE FILE NAMES TO BE USED_^1_$DATA FNAME / 'LADLQMSTLAACTFILLAUPDREQ' /_^11_]_^1C_(MESSAGE BUFFERS CONTAINING DIRECTIONS AND INSTRUCTIONS_^1_$DATA MTMSG / $D0A,'MOUNT TAPE LABELED:_!/_!/_!',_^1_#2_,$D0A,'ENTER "OK" FOR READY',_^1_#2_,$D0A,'ENTER "NX" FOR NEXT RECORD',_^1_#2_,$D0A,'ENTER "EX" TO END ',$D0A /_^1_$DATA OK/'OK'/,EX/'EX'/,NX/'NX'/,ZERO/0/,RD/0/_^1 ‚‚_$DATA ERMSG / $D0A,'INCORRECT TAPE MOUNTED',$D0A /_^1_$DATA NFMSG / $D0A,'ACCOUNT=# ',8*$2020,' NOT FOUND ON ',_^1_#2_,4*$2020,$D0A /_^1_$DATA ENDMSG/'END OF HISTORY'/_^1_$DATA NMTMSG/$D0A,'END OF REEL X MOUNT REEL X'/_^1_$DATA TFL / 'TAPE_"' /_^1_$DATA PRYES,PRNO / ' YES',' NO' /_^1_$DATA BLK / 8*$2020 /_^11_]_^1_$EXTERNAL MONTO,YERTO_^11_]_^1C_(ACCEPT LOG ON FROM ITOS_^1_$CALL ‚‚PGMIN (USER,LU,MODE,NPORT)_^11_]_^1C_(PICK UP SYSTEM DATE AND CONVERT_^1_$IMTH=AND(MONTO,$FFFF)_^1_$IYR=AND(YERTO,$FFFF)_^11_]_^1C_(LOCATE THE REPORT HEADING INFORMATION_^1_$CALL LAHEAD (HD,DT)_^1C_(PRINT THE REPORT HEADING_^1_$WRITE (12,1000)(HD(I,1),I=1,20),(HD(I,2),I=1,20),DT,(HD(I,3),_^1_#1_"I=1,20)_^11_]_^1C_(OPEN ALL FILES FOR USE, IF ERROR - PRINT MESSAGE AND EXIT_^1_$DO 50 ‚‚FP=1,2_^1_$DO 40 I=1,4_^1_!40 IDATA(I)=FNAME(I,FP)_^1_$CALL OPENFL (REQBUF(24*FP+1),IDATA,ISTAT)_^1_$RTYPE=3_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$DO 45 I=5,12_^1_!45 IDATA (I)=$2020_^1_!50 CONTINUE_^1_$DO 70 I=1,4_^1_!70 IDATA(I)=FNAME(I,3)_^1_$IDATA(13)=0_^1_$CALL OPENFL (REQBUF(1),IDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 900_^11_]_^1C_(SEQUENTIALLY RETRIEVE RECORDS FROM THE UPREQ FILE ‚‚_^1 100 CALL GETS ( REQBUF(1),RECBUF,KEY,ISTAT )_^1_$RTYPE=14_^11_]_^1C_(CHECK IF AT END-OF-FILE_^1_$IF (AND(ISTAT,$100).EQ.$100) GO TO 950_^1_$IF (ISTAT.LT.0) GO TO 900_^1C_(SET UP ACCOUNT NUMBER FOR MESSAGE_^1_$CALL CCSMVA (RECBUF,1,16,RQACT,1,16)_^1_$CALL CCSMVA (RQACT,1,16,NFMSG,13,16)_^11_]_^1C_(CHECK IF SAME TAPE TO BE PROCESSED ?_^1_$CALL CCSCST (RECBUF,17,6,OLDTP,1,6,ICOMP ‚‚)_^1_$IF (ICOMP.EQ.0) GO TO 200_^11_]_^1C_(NEW TAPE TO PROCESS, SAVE DATE AND PROMPT OPERATOR_^1_$SW=0_]_^1_$REEL=$31_^1_$CALL CCSMVA (RECBUF,17,6,OLDTP,1,6)_^1_$MTMSG(12)=RECBUF(9)_^1_$MTMSG(14)=RECBUF(10)_^1_$MTMSG(16)=RECBUF(11)_^1C_(OUTPUT INSTRUCTIONS AND INPUT COMMANDS_^1 150 CALL WTREAD (LU,-1,MTMSG,104,-1,COMMD,2,IC)_^1C_(CHECK FOR TAPE READY_^1_$IF (COMMD.EQ.OK) GO TO 210 ‚‚_^1C_(CHECK FOR EXIT_^1_$IF (COMMD.EQ.EX) GO TO 950_^1C_(CHECK FOR NEXT RECORD_^1_$IF (COMMD.EQ.NX) GO TO 100_^1_$GO TO 150_^11_]_^1C_(CHECK IF IT IS NECESSARY TO READ TAPE_^1 200 IF (RD.EQ.0) GO TO 210_^1_$RD=0_]_^1_$GO TO 300_^11_]_^1C_(GET NEXT RECORD FROM TAPE_^1 210 ASSIGN 220 TO IRTN_^1_$CALL FREAD (6,TREC,2000,IRTN,0,TEMP)_^1_$CALL DISP_^1C_(SET UP MESSAGE FOR TAPE_^1 220 ‚‚ CALL CCSMVA (TFL,1,8,NFMSG,43,8)_^11_]_^1C_(CHECK IF AT ROUTINE TO WRITE ACTFIL RECORD_^1_$IF (SW.EQ.2) GO TO 400_^11_]_^1C_#CHECK IF LAST RECORD_^1_$CALL CCSCST(TREC,1,14,ENDMSG,1,14,ICOMP)_^1_$IF(ICOMP.EQ.0) GO TO 500_^1C_#CHECK FOR EOF, IF EOF, THERE ARE MORE REELS_^1_$IF(LINK(0).GE.0) GO TO 230_^1C_#OUTPUT MESSAGE TO MOUNT NEXT REEL_^1_$CALL CCSMVA(REEL,2,1,NMTMSG,15,1)_^1_$RE ‚‚EL=REEL+1_^1_$CALL CCSMVA(REEL,2,1,NMTMSG,28,1)_^1_$CALL WTREAD(LU,-1,NMTMSG,28,ZERO,ZERO,ZERO,IC)_^1_$GO TO 150_^11_]_^1C_(CHECK WHICH WAY TO RUN_^1 230 IF(SW.EQ.1) GO TO 300_^11_]_^1C_(TAPE READY VERIFY TAPE DATE_^1_$CALL CCSMVA (TREC,1,6,DATE,1,6)_^1_$CALL CCSCST (DATE,1,6,OLDTP,1,6,ICOMP)_^1_$IF (ICOMP.EQ.0) GO TO 240_^1C_(OUTPUT ERROR MESSAGE_^1_$CALL WTREAD (LU,-1,ERMSG,26,Z ‚‚ERO,ZERO,ZERO,IC)_^1_$GO TO 150_^1C_(TAPE CORRECT - PROCESS ACCOUNT_^1 240 SW=1_]_^1_$GO TO 210_^11_]_^1C_(PROCESS THE SAME TAPE REQUESTED_^1C_(FIRST, SEARCH THE REQUESTED ACCOUNT ON THE TAPE_^1 300 CALL CCSCST (TPACT,1,16,RQACT,1,16,ICOMP)_^1_$IF (ICOMP.LT.0) GO TO 210_^1_$IF (ICOMP.EQ.0) GO TO 310_^1_$RD=1_]_^1_$GO TO 500_^11_]_^1C_(RETRIEVE THE DELQMST RECORD TO CHECK IF IT EX ‚‚IT_^1 310 CALL READR (REQBUF(25),RECBUF,RQACT,ISTAT)_^1_$RTYPE=13_^1C_(SET UP MESSAGE FOR DELQMST FILE_^1_$CALL CCSMVA (FNAME,1,8,NFMSG,43,8)_^11_]_^1C_(END-OF-FILE ?_^1_$IF (AND(ISTAT,$100).EQ.$100) GO TO 320_^1_$IF (ISTAT.LT.0) GO TO 900_^11_]_^1C_(CHECK IF THE DELQMST RECORD IS THE CORRECT ACCOUNT_^1 320 CALL CCSCST (RECBUF,1,16,RQACT,1,16,ICOMP)_^1_$IF (ICOMP.NE.0) GO TO 500_ ‚‚^11_]_^1C_(SWITCH IS SET FOR THE ROUTINE TO WRITE THE ACTFIL RECORD_^1_$SW=2_]_^1_$SKP=0_^1_$CALL CCSMVA (PRNO,1,4,RESLT,1,4)_^1_$CALL CCSMVA (RECBUF,18,30,BOROW,1,30)_^1_$GO TO 210_^11_]_^1C_(ROUTINE - TRY TO WRITE THE ACTFIL RECORD_^1C_(FIRST, CHECK IF IT IS EOF ?_^1 400 IF (LINK(0).LT.0) GO TO 480_^1C_(CHECK IF THE ACCOUNT IS THE SAME_^1_$CALL CCSCST (TPACT,1,16,RQACT,1,16,ICOM ‚‚P)_^1_$IF (ICOMP.EQ.0) GO TO 410_^1_$IF (SKP.EQ.1) GO TO 405_^1_$CALL CCSCST (TPACT,1,16,BLK,1,16,ICOMP)_^1_$IF (ICOMP.EQ.0) GO TO 410_^1 405 RD=1_]_^1_$GO TO 480_^11_]_^1C_(ACTFIL MANIPULATION_^1C_(SET UP SUFFIX = 50 AND SKIP FIRST BLOCK (COSIGNER)_^1 410 IF (SKP.EQ.1) GO TO 420_^1_$SUF(3)=$3530_^1_$I=1_]_^1_$GO TO 430_^1 420 I=0_]_^11_]_^1C_(THIS IS THE ACTIVITY BLOCK_^1C_(CHE ‚‚CK IF THIS BLOCK IS THE GOOD ACCOUNT_^1 430 CALL CCSCST ( TREC(250*I+1),1,16,RQACT,1,16,ICOMP)_^1_$IF (ICOMP.NE.0) GO TO 480_^1C_(CONVERT SUFFIX INTO A DECIMAL NUMBER, THEN INCREMENT 1_^1_$K=ICCSAD( SUF(3) )_^1_$K=K+1_^1_$CALL HEXDEC (K,SUF)_^1C_(CHECK IF THE SUFFIX EXCEED OVER 99_^1_$IF (K.GT.99) GO TO 480_^1C_(CREATE THE KEY AND PLACE ACTIVITY BLOCK IN THE RECORD_^1_$CALL CCSMVA ‚‚ (RQACT,1,16,AREC,1,16)_^1_$AREC(9)=SUF(3)_^1_$CALL CCSMVA (AREC,1,18,ACT,1,18)_^1_$CALL CCSMVA (TREC(250*I+1),19,482,AREC,19,482)_^1C_(PLACE THE RECORD IN THE ACTFIL_^1_$CALL WRITER (REQBUF(49),AREC,ACT,ISTAT)_^1_$RTYPE=12_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$CALL CCSMVA (PRYES,1,4,RESLT,1,4)_^1C_(CHECK IF THE RECORD HAS FINISHED TO BE PLACED IN THE ACTFIL_^1_$I=I+1_^1_$IF (I.LT.4) G ‚‚O TO 430_^1_$SKP=1_^1_$GO TO 210_^11_]_^1C_(PRINT THE DETAIL_^1 480 WRITE (12,1100) RQACT,BOROW,DATE,RESLT_^1_$CALL CCSBLK (BOROW,30)_^1_$GO TO 510_^11_]_^1C_(OUTPUT NO-FOUND MESSAGE_^1 500 CALL WTREAD (LU,-1,NFMSG,52,ZERO,ZERO,ZERO,IC)_^1 510 SW=1_]_^1_$GO TO 100_^11_]_^1C_(A FILE ERROR HAS OCCURRED - REPORT AND TERMINATE JOB_^1 900 CALL FILERR (IDATA,RTYPE,ISTAT,LU)_^11_]_^1C ‚‚_(REPORT END AND CLOSE ALL FILES, THEN EXIT_^1 950 WRITE (12,1200)_^1_$CALL CLOSFL (REQBUF(1),ISTAT)_^1_$CALL CLOSFL (REQBUF(25),ISTAT)_^1_$CALL CLOSFL (REQBUF(49),ISTAT)_^1_$CALL PGMOUT_^11_]_^1C_(OUTPUT FORMATS_^1 1000 FORMAT (1H1,20A2,9X,'TAPE HISTORY UPDATE REPORT',/,1X,20A2,14X,_^1_#1 'RUN DATE:',A2,'/',A2,'/',A2,/,1X,20A2,//,20X,'ACCOUNT NUMBER',_^1_#1 8X,'BORROWERS NAME', ‚‚17X,'DATE OF TAPE',5X,'RECORDS ADDED TO ',_^1_#1 'ACTIVITY FILE',/)_^1 1100 FORMAT (19X,8A2,5X,15A2,5X,A2,'/',A2,'/',A2,19X,2A2)_^1 1200 FORMAT (//,50X,'*** END OF REPORT ***')_^1_$END_]_^__ ‚‚LCLIUD CSY/ F30 0010 ‚‚1_$PROGRAM LCLIUD_^1_#1_2/F30 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#THIS PROGRAM REARRANGES THE 12 PERIODIC SETS WITHIN EACH CLIENT_^1C_#RECORD SO THAT THE MOST CURRENT MONTH APPEARS FIRST. THIS IS_^1C_#HELPFUL WHEN LOOKING AT THE CLIENT ‚‚FINANCIAL STATISTICS DURING_^1C_#CLIENT FILE MAINTENANCE. ADDITIONALLY, THE YEAR-TO-DATE AMOUNT_^1C_#ARE RECALCULATED SO THAT THEY REFLECT THE MOST CURRECT STATE_^1C_#OF THE CLIENT._^1C_]_^1_$INTEGER CDATA(15), CREQ(24), CREC(652), COMPIN(1), MTHTBL(24),_^1_#2_'MM(1), TMPBUF(572), CURDAT(3), NUMB1(5), NUMB2(6),SIGN(1),_^1_#3_'BLANK(2), MINUS1(1), YYHLD(1)_^1C_]_^1_$DATA CDATA /'LAC ‚‚LIENT',8*$2020,0,1,0/_^1_$DATA MTHTBL /' 01 02 03 04 05 06 07 08 09 10 11 12'/_^1_$DATA TMPBUF /572*$2020/, SIGN /0/_^1_$DATA NUMB1 / 5*$2020 /, NUMB2 / 6*$2020 /_^1_$DATA BLANK /'_"'/, MINUS1 /$304A/_^1C_]_^1_$EXTERNAL AMONTO, ADAYTO, AYERTO, ASCBIN, BINASC_^1C_]_^1_$ASSEM $C400, +AMONTO, $6800, CURDAT(1)_^1_$ASSEM $C400, +ADAYTO, $6800, CURDAT(2)_^1_$ASSEM $C400, +AYE ‚‚RTO, $6800, CURDAT(3)_^1C_]_^1_$CALL CCSMVA (CURDAT,1,2,MM,1,2)_^1C_]_^1_$CALL OPENFL (CREQ, CDATA, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 10_^1_$CALL FILERR (CDATA, 3, ISTAT, LU)_^1_$GO TO 900_^1C_JINITIALIZE MONTH TABLE_^1_!10 CALL CCSMVA(CURDAT,5,2,YYHLD,1,2)_^1_$CALL CCSMVA(YYHLD,1,2,NUMB2,11,2)_^1_$CALL CCSMVA(MINUS1,1,2,NUMB1,9,2)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1C_]_^1 ‚‚_$J = 3_^1_$DO 90 I = 1,12_^1_$CALL CCSCST(MTHTBL,(J),2,MM,1,2,COMPIN)_^1_$IF (COMPIN .GT. 0) CALL CCSMVA (NUMB2,11,2,YYHLD,1,2)_^1_$J = J - 2_^1_$CALL CCSMVA(YYHLD,1,2,MTHTBL,(J),2)_^1_$J = J + 6_^1_!90 CONTINUE_^1C_]_^1 100 CALL GETS (CREQ, CREC, 1, ISTAT)_^1_$IF (AND (ISTAT,$100) .EQ. $100) GO TO 900_^1_$IF (ISTAT .GE. 0) GO TO 200_^1_$CALL FILERR (CDATA, I4, ISTAT, LU)_^1_$GO ‚‚TO 900_^1_]_^1 200 CALL CCSMVA (CREC,155, 1056, TMPBUF, 1, 1056)_^1_$J = 155_^1_$CALL CCSBLK (CREC(J),528)_^1_$J = 3_^1_$DO 300 I = 1, 12_^1_$CALL CCSCST (MM,1,2,MTHTBL,(J),2,COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 400_^1_$J = J + 4_^1 300 CONTINUE_^1C_]_^1 400 L = J_^1_$L = L - 2_^1_$M = 67_^1_$DO 500 I = 1,12_^1_$K = 1_^1C_]_^1 410 DO 420 J = 1, 12_^1_$CALL CCSCST (TMPBUF, (K), ‚‚4, MTHTBL, (L), 4, COMPIN)_^1_$IF (COMPIN .EQ. 0) GO TO 430_^1_$K = K + 88_^1 420 CONTINUE_^1_$L = L - 4_^1_$IF (L .LE. 0) L = 45_^1_$GO TO 500_^1C_]_^1 430 M = M + 88_^1_$CALL CCSMVA (TMPBUF, (K), 88, CREC, (M), 88)_^1_$L = L - 4_^1_$IF (L .LE. 0) L = 45_^1 500 CONTINUE_^1C_JFIND AND PLUG INTO THE FIRST_^1C_JFOUR POSITIONS OF THE Y-T-D_^1C_JTHE YYMM OF THE LAST VALID_^1C_JSET. ‚‚_^1_$M = 67_^1_$DO 550 I = 1 , 12_^1_$M = M + 88_^1_$CALL CCSCST (CREC,(M),4,BLANK,1,4,COMPIN)_^1_$IF (COMPIN .EQ. 0) M = M - 88_^1 550 CONTINUE_^1_$CALL CCSMVA (CREC,(M),4,CREC,1211,4)_^1C_]_^1C_]_^1C_JTHIS SECTION WILL RECALCULAT_^1C_JTHE YEAR TO DATE TOTALS_^1C_J** # ACCT PLACED_^1 600 M = 159_^1_$CALL CCSBLK(NUMB1,22)_^1_$DO 610 I =1,12_^1_$CALL CCSMVA(CREC,(M),3,NUMB1,8,3)_^ ‚‚1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 610 CONTINUE_^1_$CALL CCSMVA(NUMB2,10,3,CREC,1215,3)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J** $ ACCTS PLACED_^1_$M = 162_^1_$DO 615 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 615 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1218,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J$ AMOUNT C ‚‚OLLECTED_^1_$M = 171_^1_$DO 620 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 620 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1227,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J# ACCTS PIF_^1_$M = 180_^1_$DO 625 I = 1,12_^1_$CALL CCSMVA(CREC,(M),3,NUMB1,8,3)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 625 CONTINUE_^1_$CAL ‚‚L CCSMVA(NUMB2,10,3,CREC,1236,3)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J$ ACCTS PIF_^1_$M = 183_^1_$DO 630 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 630 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1239,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J** $ COMMISSIONS_^1_$M = 192_^1_$DO 635 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1_$CALL ‚‚ CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 635 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1248,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J**# ACCTS CLOSED_^1_$M = 201_^1_$DO 640 I = 1,12_^1_$CALL CCSMVA(CREC,(M),3,NUMB1,8,3)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 640 CONTINUE_^1_$CALL CCSMVA(NUMB2,10,3,CREC,1257,3)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J** $ ACCTS CLOSED_ ‚‚^1_$M = 204_^1_$DO 645 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 645 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1260,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J** # ACTIVE ACCTS_^1_$M = 213_^1_$DO 650 I = 1,12_^1_$CALL CCSMVA(CREC,(M),3,NUMB1,8,3)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 650 CONTINUE_^1_$CALL C ‚‚CSMVA(NUMB2,10,3,CREC,1269,3)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J** $ ACTIVE ACCTS_^1_$M = 216_^1_$DO 655 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 655 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1272,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J** REC. COURT COSTS_^1_$M = 225_^1_$DO 660 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1 ‚‚_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 660 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1281,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_J** NON REC COURT COSTS_^1_$M = 234_^1_$DO 665 I = 1,12_^1_$CALL CCSMVA(CREC,(M),9,NUMB1,2,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$M = M + 88_^1 665 CONTINUE_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1290,9)_^1_$CALL CCSBLK(NUMB1,22)_^1C_JCALCULA ‚‚TE # ACTIVE ACCTS -_^1C_JTOTAL ASSIGN MINUS # CLOSED_^1C_JMINUS # PIF_^1 670 CALL CCSMVA (CREC,1236,3,NUMB1,8,3)_^1_$CALL CCSMVA (CREC,1257,3,NUMB2,10,3)_^1_$CALL CCSADD (NUMB1,2,NUMB2,1,NUMB2,1)_^1_$SIGN = AND(NUMB2(6),$00FF)_^1_$IF (SIGN .GE. $31 .AND. SIGN .LE. $39) SIGN = SIGN + $19_^1_$IF (SIGN .EQ. $30) SIGN = SIGN + $4D_^1_$CALL CCSMVA(SIGN,2,1,NUMB2,12,1)_^1_$CALL CCSMVA ( ‚‚CREC,1215,3,NUMB1,8,3)_^1_$CALL CCSADD (NUMB1,2,NUMB2,1,NUMB2,1)_^1_$CALL CCSMVA (NUMB2,10,3,CREC,1269,3)_^1C_JCALCULATE $ ACTIVE ACCTS_^1 675 CALL CCSMVA(CREC,1239,9,NUMB1,2,9)_^1_$CALL CCSMVA(CREC,1260,9,NUMB2,4,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$SIGN = AND(NUMB2(6),$00FF)_^1_$IF (SIGN .GE. $31 .AND. SIGN .LE. $39) SIGN = SIGN + $19_^1_$IF (SIGN .EQ. $30) SIGN = SIG ‚‚N + $4D_^1_$CALL CCSMVA(SIGN,2,1,NUMB2,12,1)_^1_$CALL CCSMVA(CREC,1218,9,NUMB1,2,9)_^1_$CALL CCSADD(NUMB1,2,NUMB2,1,NUMB2,1)_^1_$CALL CCSMVA(NUMB2,4,9,CREC,1272,9)_^1C_]_^1 700 CALL UPDREC (CREQ, CREC, ISTAT)_^1_$IF (ISTAT .GE. 0) GO TO 100_^1_$CALL FILERR (CDATA, I4, ISTAT, LU)_^1_$GO TO 900_^1C_]_^1 900 CALL CLOSFL (CREQ, ISTAT)_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LCMPDQ CSY/ F31 ‚‚1_$PROGRAM LCMPDQ_^1_#1_2/F31 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^11_]_^1C_$COPYRIGTH CONTROL DATA CORPORATION, 1978_^1C_$DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_$CREDIT COLLECTION SYSTEM VERSION 2.0_^11_]_^1C_(THIS PROGR ‚‚AM PERFORMS A FILE COMPRESSION ON THE_^1C_(DELQMST FILE. THIS REMOVES ALL DELETED RECORDS_^1C_(THEREBY FREEING FILE SPACE._^11_]_^1_$INTEGER USER(4),IDATA(15),REQBUF(24),RECBUF(2004)_^11_]_^1_$DATA REQBUF / 24*0 /_^1_$DATA IDATA / 'LADLQMST' ,8*$2020,-1, 1, 0 /_^11_]_^1C_(ITOS LOGON_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^11_]_^1C_(OPEN DELQMST_^1_$CALL OPENFL ( REQBUF, IDATA, IS ‚‚TAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1C_(ERROR ON OPEN_^1_$CALL FILERR ( IDATA, 3, ISTAT, LU )_^1_$CALL PGMOUT_^11_]_^1C_(PERFORM THE COMPRESSION_^1 100 CALL COMFIL ( REQBUF, RECBUF, ISTAT )_^1_$IF ( AND($100,ISTAT) .EQ. $100 ) GO TO 200_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1C_(ERROR ON COMPRESS_^1_$CALL FILERR ( IDATA, 17, ISTAT, LU )_^1C_(CLOSE DELQMST AND EXIT_^1 200 CALL CL ‚‚OSFL ( REQBUF, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LCMPSM CSY/ F32 ‚‚1_$PROGRAM LCMPSM_^1_#1_2/F32 F LA_!CCS 3.0_5SL-149_^11_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^11_]_^1C_(THIS PROGRAM PERFORMS A FILE COMPRESSION ON THE_^1C_(SUMHIST FILE._^11_]_^1_$INTEGER USER(4),IDATA(15),REQBUF(24),RECBUF(1000)_^1_$DATA REQBUF / 24*0 /_^1_$DATA IDATA / ' ‚‚LASUMHST',8*$2020,-1,1,0 /_^11_]_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^1_$CALL OPENFL ( REQBUF, IDATA, ISTAT )_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1_$CALL FILERR ( IDATA, 3, ISTAT, LU )_^1_$CALL PGMOUT_^1 100 CALL COMFIL ( REQBUF, RECBUF, ISTAT )_^1_$IF ( AND(ISTAT,$100) .EQ. $100 ) GO TO 200_^1_$IF ( ISTAT .GE. 0 ) GO TO 100_^1_$CALL FILERR ( IDATA, 17, ISTAT, LU )_^1 200 CAL ‚‚L CLOSFL ( REQBUF, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LDACRT CSY/ F34 0010 ‚‚1_$PROGRAM LDACRT_^1_#1_2/F34 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_(THIS PROGRAM REASSIGNS QUEUES AND PRIORITIES FOR ALL ACTIVE_^1C_(ACCOUNTS IN THE LADLQMST FILE AND CREATES THE LADLYASN FILE_^1C_(WHICH IS USED BY THE ON-LINE AUTOM ‚‚ATIC FUNCTION_^11_]_^1_$INTEGER DEQREQ(24),ASNREQ(24),DDATA(15),ADATA(15),ST,EFG,DT(3),_^1_#2_"USER(4),HD(3,20),PRI(3,9),QUE(3,9),NQUE(2),NPRI(2),FDEL,_^1_#3_"DEQREC(23000),ASNREC(462),QUEP(9),QUEL(9),PRIP(9),PRIL(9),_^1_#4_"STG(40),LTHACT(2)_^11_]_^1_$EXTERNAL FMRDEL_^11_]_^1_$DATA DEQREQ, ASNREQ / 48*0 /_^1_$DATA DDATA / 'LADLQMST', 8*$2020, 0, 0, 0 /_^1_$DATA ADATA / 'LADLYASN ‚‚', 8*$2020, 0, 1, 0 /_^1_$DATA NUMREC / 23 /, ST / 0 /, EFG / 0 /, LTHACT / '0360' /_^1_$DATA QUE, PRI / 54*$2020 /_^1._]_^1C****_#SET UP THE LADLQMST STARTING CHARACTER POSITIONS FOR THE_^1C_(QUEUE ASSIGNMENT PARAMETERS, IF NOT USED MUST BE ZERO (0)_^11_]_^1C_0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_!P-9_^1_$DATA QUEP /_!0,_"0,_"0,_"0,_"0,_"0,_"0,_"0,_"0 /_^11_]_^1C****_#SET UP THE ‚‚ LADLQMST PARAMETER LENGTH IN CHARACTERS MAX. = 6_^1C_(IF UNUSED MUST BE ZERO (0)_^11_]_^1C_0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_!P-9_^1_$DATA QUEL /_!0,_"0,_"0,_"0,_"0,_"0,_"0,_"0,_"0 /_^12_]_^1C****_#SET UP THE STARTING CHARACTER POSITIONS IN LADLQMST FILE FOR_^1C_(THE PRIORITY ASSIGNMENT PARAMETERS, IF UNSED MUST BE ZERO (0)_^11_]_^1C_0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_! ‚‚P-9_^1_$DATA PRIP /_!0,_"0,_"0,_"0,_"0,_"0,_"0,_"0,_"0 /_^11_]_^1C****_#SET UP THE PRIORITY PARAMETER CHARACTER LENGTHS MAX. = 6_^1C_(IF UNUSED MUST BE ZERO (0)_^11_]_^1C_0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_!P-9_^1_$DATA PRIL /_!0,_"0,_"0,_"0,_"0,_"0,_"0,_"0,_"0 /_^11_]_^1C****_#SET UP THE STARTING CHARACTER POSITIONS FOR THE MOST RECENT_^1C_(PAYMENT AMOUNT AND PAYMENT DATE, US ‚‚ED FOR BROKEN PP'S_^11_]_^1_$DATA LDATE /_"0 / , LAMT /_"0 /_^1._]_^1C_(ACCEPT LOGIN FROM ITOS_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^11_]_^1C_(INITIALIZE VARIABLES_^1_$ASSEM $C000,FMRDEL,$6800,FDEL_^1_$CALL CCSBLK ( ASNREC, 920 )_^1_$IOSW = $3030_^1_$CALL LAHEAD ( HD, DT )_^1_$DDATA(14) = NUMREC_^1_$M = 1_^12_]_^1C_(OPEN FILES FOR USE_^1_$CALL OPENFL ( DEQREQ, DDATA, ISTAT )_^1 ‚‚_$IF (ISTAT.GE.0) GO TO 100_^1_$CALL FILERR ( DDATA, 3, ISTAT, LU )_^1_$GO TO 900_^1 100 CALL CLEAR ( ASNREQ, ADATA, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 110_^1_$CALL FILERR ( ADATA, 1, ISTAT, LU )_^1_$GO TO 900_^1 110 CALL OPENFL ( ASNREQ, ADATA, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 200_^1_$CALL FILERR ( ADATA, 3, ISTAT, LU )_^1_$GO TO 900_^1._]_^1C_(READ RECORDS FROM THE LADLQMST AND ‚‚ PROCESS_^1 200 CALL GETS ( DEQREQ, DEQREC, I, ISTAT )_^1C_(EOF?_^1_$IF (AND(ISTAT,$8100).EQ.$8100) GO TO 900_^1_$IF (AND(ISTAT,$100).EQ.$100) EFG = 1_^1C_(FILE ERROR?_^1_$IF (ISTAT.GE.0) GO TO 210_^1_$CALL FILERR ( DDATA, 14, ISTAT, LU )_^1_$GO TO 900_^1 210 DO 300 I = 1 , NUMREC_^1_$L = 40*M - 39_^1_$K = 1000*I-999_^1_$J = 2*K-1_^1C_(RECORD PRESENT?_^1_$IF (DEQREC(K).EQ.$2020.O ‚‚R._^1_#1_"DEQREC(K).EQ.FDEL) GO TO 300_^1C_(RECORD ACTIVE?_^1_$IF (AND(DEQREC(K+152),$FF).NE.$20) GO TO 300_^11_]_^1C_(GET THE MOST RECENT ACTIVITY_^1C***************************************************************138*A023_^1_$IOSW = $3031_^1C***************************************************************138*A023_^1_$CALL GETACF ( STG, DEQREC(K+153), LTHACT, IOSW )_^12_]_^1C_(REASS ‚‚IGN QUEUE ALLOWED?_^1_$IF (AND(DEQREC(K+146),$FF).NE.$20) GO TO 220_^11_]_^1._]_^1C****_#SET UP THE PARAMETERS FOR QUEUE ASSIGNMENT :_^1C_(-_"THE MOST RECENT ACTION CODE IS IN : STG(4)_^1C_(-_3RESULT CODE IS IN : STG(5)_^1C_(-_3CONTACT DATE STARTS IN : STG(1)_^1C_(-_"THE SYSTEM DATE STARTS IN : DT(1)_^13_]_^1C_(PARAMETER #1_^1_$CALL CCSMVA ( DEQREC, QUEP(1)+J-1, QUEL(1), QUE, 1, 6 ‚‚)_^11_]_^1C_(PARAMETER #2_^1_$CALL CCSMVA ( DEQREC, QUEP(2)+J-1, QUEL(2), QUE, 7, 6 )_^11_]_^1C_(PARAMETER #3_^1_$CALL CCSMVA ( DEQREC, QUEP(3)+J-1, QUEL(3), QUE, 13, 6 )_^11_]_^1C_(PARAMETER #4_^1_$CALL CCSMVA ( DEQREC, QUEP(4)+J-1, QUEL(4), QUE, 19, 6 )_^11_]_^1C_(PARAMETER #5_^1_$CALL CCSMVA ( DEQREC, QUEP(5)+J-1, QUEL(5), QUE, 25, 6 )_^11_]_^1C_(PARAMETER #6_^1_$CALL CCSMVA ( D ‚‚EQREC, QUEP(6)+J-1, QUEL(6), QUE, 31, 6 )_^11_]_^1C_(PARAMETER #7_^1_$CALL CCSMVA ( DEQREC, QUEP(7)+J-1, QUEL(7), QUE, 37, 6 )_^11_]_^1C_(PARAMETER #8_^1_$CALL CCSMVA ( DEQREC, QUEP(8)+J-1, QUEL(8), QUE, 43, 6 )_^11_]_^1C_(PARAMETER #9_^1_$CALL CCSMVA ( DEQREC, QUEP(9)+J-1, QUEL(9), QUE, 49, 6 )_^1._]_^1C_(GET THE NEW QUEUE_^1_$CALL LFTND1 ( QUE, NQUE )_^1C_(NEW QUEUE?_^1_$IF (NQUE ‚‚(1).EQ.DEQREC(K+135).AND._^1_#1_"NQUE(2).EQ.DEQREC(K+136)) GO TO 220_^1C_(QUEUE RETURN SUCCESSFUL?_^1_$IF (NQUE(1).EQ.$3939.AND._^1_#1_"NQUE(2).EQ.$3939) GO TO 220_^1C_(SAVE OLD QUEUE , DATE , AND NEW QUEUE_^1_$CALL CCSMVA ( DEQREC, J+270, 4, DEQREC, J+295, 4 )_^1_$CALL CCSMVA ( DT, 1, 6, DEQREC, J+299, 6 )_^1_$CALL CCSMVA ( NQUE, 1, 4, DEQREC, J+270, 4 )_^12_]_^1C_(GET THE NEW PRI ‚‚ORITY_^1 220 CONTINUE_^1._]_^1C****_#SET UP THE PARAMETERS FOR THE PRIORITY ASSIGNMENT -_^1C_(-_"THE MOST RECENT ACTION CODE IS IN : STG(4)_^1C_(-_3RESULT CODE IS IN : STG(5)_^1C_(-_3CONTACT DATE STARTS IN : STG (1)_^1C_(-_"THE SYSTEM DATE STARTS IN : DT(1)_^12_]_^1C_(PARAMETER #1_^1_$CALL CCSMVA ( DEQREC, PRIP(1)+J-1, PRIL(1), PRI, 1, 6 )_^11_]_^1C_(PARAMETER #2_^1_$CALL CCSMVA ( ‚‚ DEQREC, PRIP(2)+J-1, PRIL(2), PRI, 7, 6 )_^11_]_^1C_(PARAMETER #3_^1_$CALL CCSMVA ( DEQREC, PRIP(3)+J-1, PRIL(3), PRI, 13, 6 )_^11_]_^1C_(PARAMETER #4_^1_$CALL CCSMVA ( DEQREC, PRIP(4)+J-1, PRIL(4), PRI, 19, 6 )_^11_]_^1C_(PARAMETER #5_^1_$CALL CCSMVA ( DEQREC, PRIP(5)+J-1, PRIL(5), PRI, 25, 6 )_^11_]_^1C_(PARAMETER #6_^1_$CALL CCSMVA ( DEQREC, PRIP(6)+J-1, PRIL(6), PRI, 31, 6 )_^ ‚‚11_]_^1C_'PARAMETER #7_^1_$CALL CCSMVA ( DEQREC, PRIP(7)+J-1, PRIL(7), PRI, 37, 6 )_^11_]_^1C_(PARAMETER #8_^1_$CALL CCSMVA ( DEQREC, PRIP(8)+J-1, PRIL(8), PRI, 43, 6 )_^11_]_^1C_(PARAMETER #9_^1_$CALL CCSMVA ( DEQREC, PRIP(9)+J-1, PRIL(9), PRI, 49, 6 )_^1._]_^1_$CALL LFTND1 ( PRI, NPRI )_^1C_(PRIORITY RETURN SUCCESSFUL?_^1_$IF (NPRI(1).EQ.$3939.AND._^1_#1_"NPRI(2) .EQ. $3939 ) GO ‚‚TO 225_^1C_(SAVE THE NEW PRIORITY_^1_$CALL CCSMVA ( NPRI, 1, 4, DEQREC, J+280, 4 )_^11_]_^1C_(IS THIS ACCOUNT A PROMISE TO PAY?_^1 225 IF ( AND(DEQREC(K+142),$FF00) .NE. $5900 ) GO TO 230_^11_]_^1C***************************************************************138*A018_^1C_(CHECK IF PROMISE DUE TO BE CHECKED (SYSTEM DATE EQUAL OR_^1C_(PAST PROMISE TO PAY DATE)._^1_$CALL CCSCST ( DT ‚‚, 5, 2, DEQREC, J+1019, 2, ICOMP )_^1C_/NOT DUE CHK FURTHER_"DUE_^1_$IF (ICOMP)_!230_!,_!2251_",_!2252_^11_]_^1C_(YEARS EQUAL, CHECK MONTH AND DAY._^1 2251 CALL CCSCST ( DT, 1, 4, DEQREC, J+1015, 4, ICOMP )_^1C_(TODAY'S DATE MUST BE EQUAL OR PAST PROMISED TO BE DUE FOR_^1C_(CHECK._^1_$IF ( ICOMP .LT. 0 ) GO TO 230_^11_]_^1C_(PROMISE DUE TO BE CHECKED. SEE IF LAST PAYMENT AMOUNT CL ‚‚EARS_^1C_(PROMISED AMOUNT._^1 2252 CALL CCSCST ( DEQREC, J+LAMT-1, 9, DEQREC, J+1021, 9, ICOMP )_^1_$IF ( ICOMP .LT. 0 ) GO TO 224_^11_]_^1C_(LAST PAYMENT CLEARS PROMISE. VERIFY PAYMENT RECEIVED AFTER_^1C_(COMMITMENT DATE._^1_$CALL CCSCST ( DEQREC, J+LDATE+3, 2, DEQREC, J+1044, 2, ICOMP )_^1C_0BEFORE CHK FURTHER_!AFTER_^1_$IF (ICOMP)_!224 ,_!2253_!,_!2254_^11_]_^1C_(YEARS EQUAL, C ‚‚HECK MONTH AND DAY._^1 2253 CALL CCSCST ( DEQREC, J+LDATE-1, 4, DEQREC, J+1040, 4, ICOMP )_^1C_(PAYMENT DATE MUST BE PAST COMMITMENT DATE FOR KEPT PROMISE._^1_$IF ( ICOMP .LT. 0 ) GO TO 224_^1C***************************************************************138*A018_^12_]_^1C_(PROMISE KEPT, INCREMENT THE KEPT COUNT_^1C***************************************************************13 ‚‚8*A018_^1 2254 DEQREC(K+518) = AND(DEQREC(K+518),$FF0F) + $31_^1C***************************************************************138*A018_^1_$IF ( AND(DEQREC(K+518),$FF) .GT. $39 )_^1_#1_"DEQREC(K+518) = AND(DEQREC(K+518),$FFF) + $30F6_^1C_(INCREMENT THE NEXT CONTACT DATE 7 DAYS_^1_$IK = ICALJL ( DEQREC, J+274 )_^1_$IK = IK + 7_^1_$IF ( IK .LE. 365 ) GO TO 222_^1_$DEQREC(K+139) = DE ‚‚QREC(K+139) + 1_^1_$IF ( AND(DEQREC(K+139),$FF) .GT. $39 )_^1_#1_"DEQREC(K+139) = DEQREC(K+139) + $F6_^1 222 CALL JULCAL ( IK, DEQREC, J+274 )_^1C_(CLEAR THE PROMISED TO PAY FLAG_^1_$CALL CCSPUT ( $4B, J+284, DEQREC )_^1_$GO TO 230_^11_]_^11_]_^1C_(PROMISE BROKEN, INCREMENT THE BROKEN COUNT_^1 224 DEQREC(K+519) = AND(DEQREC(K+519),$FF0F) + $31_^1_$IF ( AND(DEQREC(K+519),$FF) .GT ‚‚. $39 )_^1_#1_"DEQREC(K+519) = AND(DEQREC(K+519),$FFF) + $30F6_^1C_(SET THE PROMISED TO PAY FLAG TO BROKEN_^1_$CALL CCSPUT ( $42, J+284, DEQREC )_^1._]_^1C_(BUILD THE LADLYASN RECORD - ACCT #, QUEUE, NEXTCD, PRIORITY_^1 230 CALL CCSMVA ( DEQREC, J, 16, ASNREC, L, 16)_^1_$CALL CCSMVA ( DEQREC, J+270, 14, ASNREC, L+16, 14 )_^12_]_^1C****_#IF ADDITIONAL FIELDS ARE REQUIRED IN THE LAD ‚‚LYASN RECORD,_^1C_(THEY SHOULD BE MOVED IN AT THIS POINT_^12_]_^1_$M = M + 1_^1 300 CONTINUE_^11_]_^1C_(SAVE THE LADLYASN RECORD_^1_$M = M - 1_^1_$IF ( M .EQ. 0 ) GO TO 310_^1_$CALL PUTS ( ASNREQ, ASNREC, M, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 305_^1_$CALL FILERR ( ADATA, 11, ISTAT, LU )_^1_$GO TO 900_^1C_(UPDATE THE RECORDS IN THE LADLQMST FILE_^1 305 CALL UPDREC ( DEQREQ, DEQREC, ‚‚ ISTAT )_^1C_(FILE ERROR?_^1_$IF (ISTAT.GE.0) GO TO 310_^1_$CALL FILERR ( DDATA, 15, ISTAT, LU )_^1_$GO TO 900_^1C_(BLANK OUT THE DELQ BUFFER AND CONTINUE_^1 310 CALL CCSBLK ( DEQREC, 30000 )_^1_$CALL CCSBLK ( DEQREC(15001), 16000 )_^1_$CALL CCSBLK ( ASNREC, 920 )_^1_$M = 1_^1_$IF (EFG.EQ.0) GO TO 200_^11_]_^1C_(CLOSE THE FILES AND STOP_^1 900 CALL CLOSFL ( DEQREQ, ISTAT )_^1_$CA ‚‚LL CLOSFL ( ASNREQ, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LIDACR CSY/ F43 0010 ‚‚1_$PROGRAM LDACRT_^1_#1_2/F43 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#****INSTALLATION TEST KIT VERSION****_^11_]_^1C_(THIS PROGRAM REASSIGNS QUEUES AND PRIORITIES FOR ALL ACTIVE_^1C_(ACCOUNTS IN THE DELQMST FILE AND CREATES THE DLYASSN FIL ‚‚E_^1C_(WHICH IS USED BY THE ON-LINE AUTOMATIC FUNCTION_^11_]_^1_$INTEGER DEQREQ(24),ASNREQ(24),DDATA(15),ADATA(15),ST,EFG,DT(3),_^1_#2_"USER(4),HD(3,20),PRI(3,9),QUE(3,9),NQUE(2),NPRI(2),FDEL,_^1_#3_"DEQREC(23000),ASNREC(462),QUEP(9),QUEL(9),PRIP(9),PRIL(9),_^1_#4_"STG(40),LTHACT(2)_^11_]_^1_$EXTERNAL FMRDEL_^11_]_^1_$DATA DEQREQ, ASNREQ / 48*0 /_^1_$DATA DDATA / 'LADLQMST', 8*$202 ‚‚0, 0, 0, 0 /_^1_$DATA ADATA / 'LADLYASN', 8*$2020, 0, 1, 0 /_^1_$DATA NUMREC / 23 /, ST / 0 /, EFG / 0 /, LTHACT / '0360' /_^1_$DATA QUE, PRI / 54*$2020 /_^1._]_^1C****_#SET UP THE DELQMST STARTING CHARACTER POSITIONS FOR THE_^1C_(QUEUE ASSIGNMENT PARAMETERS, IF NOT USED MUST BE ZERO (0)_^11_]_^1C_0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_!P-9_^1_$DATA QUEP / 306, 1072, 906,_"0,_"0, ‚‚_"0,_"0,_"0,_"0 /_^11_]_^1C****_#SET UP THE DELQMST PARAMETER LENGTH IN CHARACTERS MAX. = 6_^1C_(IF UNUSED MUST BE ZERO (0)_^11_]_^1C_0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_!P-9_^1_$DATA QUEL /_!1,_"4,_"6,_"0,_"0,_"0,_"0,_"0,_"0 /_^12_]_^1C****_#SET UP THE STARTING CHARACTER POSITIONS IN DELQMST FILE FOR_^1C_(THE PRIORITY ASSIGNMENT PARAMETERS, IF UNSED MUST BE ZERO (0)_^11_]_^1C_ ‚‚0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_!P-9_^1_$DATA PRIP /_!0,_"0,_"0,_"0,_"0,_"0,_"0,_"0,_"0 /_^11_]_^1C****_#SET UP THE PRIORITY PARAMETER CHARACTER LENGTHS MAX. = 6_^1C_(IF UNUSED MUST BE ZERO (0)_^11_]_^1C_0P-1_!P-2_!P-3_!P-4_!P-5_!P-6_!P-7_!P-8_!P-9_^1_$DATA PRIL /_!0,_"0,_"0,_"0,_"0,_"0,_"0,_"0,_"0 /_^11_]_^1C****_#SET UP THE STARTING CHARACTER POSITIONS FOR THE MOST RECENT ‚‚_^1C_(PAYMENT AMOUNT AND PAYMENT DATE, USED FOR BROKEN PP'S_^11_]_^1_$DATA LDATE /_"0 / , LAMT /_"0 /_^1._]_^1C_(ACCEPT LOGIN FROM ITOS_^1_$CALL PGMIN ( USER, LU, MODE, NPORT )_^11_]_^1C_(INITIALIZE VARIABLES_^1_$ASSEM $C000,FMRDEL,$6800,FDEL_^1_$CALL CCSBLK ( ASNREC, 920 )_^1_$IOSW = $3030_^1_$CALL LAHEAD(HD,DT)_^1_$DDATA(14) = NUMREC_^1_$M = 1_^12_]_^1C_(OPEN FILES FOR USE_^1_$CA ‚‚LL OPENFL ( DEQREQ, DDATA, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 100_^1_$CALL FILERR ( DDATA, 3, ISTAT, LU )_^1_$GO TO 900_^1 100 CALL CLEAR ( ASNREQ, ADATA, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 110_^1_$CALL FILERR ( ADATA, 1, ISTAT, LU )_^1_$GO TO 900_^1 110 CALL OPENFL ( ASNREQ, ADATA, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 200_^1_$CALL FILERR ( ADATA, 3, ISTAT, LU )_^1_$GO TO 900_^1._]_^1 ‚‚C_(READ RECORDS FROM THE DELQMST AND PROCESS_^1 200 CALL GETS ( DEQREQ, DEQREC, I, ISTAT )_^1C_(EOF?_^1_$IF (AND(ISTAT,$8100).EQ.$8100) GO TO 900_^1_$IF (AND(ISTAT,$100).EQ.$100) EFG = 1_^1C_(FILE ERROR?_^1_$IF (ISTAT.GE.0) GO TO 210_^1_$CALL FILERR ( DDATA, 14, ISTAT, LU )_^1_$GO TO 900_^1 210 DO 300 I = 1 , NUMREC_^1_$L = 40*M - 39_^1_$K = 1000*I-999_^1_$J = 2*K-1_^1C_(RECORD P ‚‚RESENT?_^1_$IF (DEQREC(K).EQ.$2020.OR._^1_#1_"DEQREC(K).EQ.FDEL) GO TO 300_^1C_(RECORD ACTIVE?_^1_$IF (AND(DEQREC(K+152),$FF).NE.$20) GO TO 300_^11_]_^1C_(GET THE MOST RECENT ACTIVITY_^1C***************************************************************138*A023_^1_$IOSW = $3031_^1C***************************************************************138*A023_^1_$CALL GETACF ( STG, DEQREC(K+1 ‚‚53), LTHACT, IOSW )_^12_]_^1C_(REASSIGN QUEUE ALLOWED?_^1_$IF (AND(DEQREC(K+146),$FF).NE.$20) GO TO 220_^11_]_^1._]_^1C****_#SET UP THE PARAMETERS FOR QUEUE ASSIGNMENT :_^1C_(-_"THE MOST RECENT ACTION CODE IS IN : STG(4)_^1C_(-_3RESULT CODE IS IN : STG(5)_^1C_(-_3CONTACT DATE STARTS IN : STG(1)_^1C_(-_"THE SYSTEM DATE STARTS IN : DT(1)_^13_]_^1C_(PARAMETER #1_^1_$CALL CCSMVA ( DEQR ‚‚EC, QUEP(1)+J-1, QUEL(1), QUE, 1, 6 )_^11_]_^1C_(PARAMETER #2_^1_$CALL CCSMVA ( DEQREC, QUEP(2)+J-1, QUEL(2), QUE, 7, 6 )_^11_]_^1C_(PARAMETER #3_^1_$CALL CCSMVA ( DEQREC, QUEP(3)+J-1, QUEL(3), QUE, 13, 6 )_^11_]_^1C_(PARAMETER #4_^1_$CALL CCSMVA ( DEQREC, QUEP(4)+J-1, QUEL(4), QUE, 19, 6 )_^11_]_^1C_(PARAMETER #5_^1_$CALL CCSMVA ( DEQREC, QUEP(5)+J-1, QUEL(5), QUE, 25, 6 )_^11_]_^ ‚‚1C_(PARAMETER #6_^1_$CALL CCSMVA ( DEQREC, QUEP(6)+J-1, QUEL(6), QUE, 31, 6 )_^11_]_^1C_(PARAMETER #7_^1_$CALL CCSMVA ( DEQREC, QUEP(7)+J-1, QUEL(7), QUE, 37, 6 )_^11_]_^1C_(PARAMETER #8_^1_$CALL CCSMVA ( DEQREC, QUEP(8)+J-1, QUEL(8), QUE, 43, 6 )_^11_]_^1C_(PARAMETER #9_^1_$CALL CCSMVA ( DEQREC, QUEP(9)+J-1, QUEL(9), QUE, 49, 6 )_^1._]_^1C_(GET THE NEW QUEUE_^1_$CALL LFTND1 ( QUE, ‚‚ NQUE )_^1C_(NEW QUEUE?_^1_$IF (NQUE(1).EQ.DEQREC(K+135).AND._^1_#1_"NQUE(2).EQ.DEQREC(K+136)) GO TO 220_^1C_(QUEUE RETURN SUCCESSFUL?_^1_$IF (NQUE(1).EQ.$3939.AND._^1_#1_"NQUE(2).EQ.$3939) GO TO 220_^1C_(SAVE OLD QUEUE , DATE , AND NEW QUEUE_^1_$CALL CCSMVA ( DEQREC, J+270, 4, DEQREC, J+295, 4 )_^1_$CALL CCSMVA ( DT, 1, 6, DEQREC, J+299, 6 )_^1_$CALL CCSMVA ( NQUE, 1, 4, DEQREC, J ‚‚+270, 4 )_^12_]_^1C_(GET THE NEW PRIORITY_^1 220 CONTINUE_^1_$GO TO 230_^1._]_^1C****_#SET UP THE PARAMETERS FOR THE PRIORITY ASSIGNMENT -_^1C_(-_"THE MOST RECENT ACTION CODE IS IN : STG(4)_^1C_(-_3RESULT CODE IS IN : STG(5)_^1C_(-_3CONTACT DATE STARTS IN : STG (1)_^1C_(-_"THE SYSTEM DATE STARTS IN : DT(1)_^12_]_^1C_(PARAMETER #1_^1_$CALL CCSMVA ( DEQREC, PRIP(1)+J-1, PRIL(1), PRI ‚‚, 1, 6 )_^11_]_^1C_(PARAMETER #2_^1_$CALL CCSMVA ( DEQREC, PRIP(2)+J-1, PRIL(2), PRI, 7, 6 )_^11_]_^1C_(PARAMETER #3_^1_$CALL CCSMVA ( DEQREC, PRIP(3)+J-1, PRIL(3), PRI, 13, 6 )_^11_]_^1C_(PARAMETER #4_^1_$CALL CCSMVA ( DEQREC, PRIP(4)+J-1, PRIL(4), PRI, 19, 6 )_^11_]_^1C_(PARAMETER #5_^1_$CALL CCSMVA ( DEQREC, PRIP(5)+J-1, PRIL(5), PRI, 25, 6 )_^11_]_^1C_(PARAMETER #6_^1_$CALL CCS ‚‚I(1).EQ.$3939.AND._^1_#1_"NPRI(2) .EQ. $3939 ) GO TO 225_^1C_(SAVE THE NEW PRIORITY_^1_$CALL CCSMVA ( NPRI, 1, 4, DEQREC, J+280, 4 )_^11_]_^1C_(IS THIS ACCOUNT A PROMISE TO PAY?_^1 225 IF ( AND(DEQREC(K+142),$FF00) .NE. $5900 ) GO TO 230_^11_]_^1C***************************************************************138*A018_^1C_(CHECK IF PROMISE DUE TO BE CHECKED (SYSTEM DATE EQUAL OR_^1 ‚‚C_(PAST PROMISE TO PAY DATE)._^1_$CALL CCSCST ( DT, 5, 2, DEQREC, J+1019, 2, ICOMP )_^1C_/NOT DUE CHK FURTHER_"DUE_^1_$IF (ICOMP)_!230_!,_!2251_",_!2252_^11_]_^1C_(YEARS EQUAL, CHECK MONTH AND DAY._^1 2251 CALL CCSCST ( DT, 1, 4, DEQREC, J+1015, 4, ICOMP )_^1C_(TODAY'S DATE MUST BE EQUAL OR PAST PROMISED TO BE DUE FOR_^1C_(CHECK._^1_$IF ( ICOMP .LT. 0 ) GO TO 230_^11_]_^1C_(PROMIS ‚‚E DUE TO BE CHECKED. SEE IF LAST PAYMENT AMOUNT CLEARS_^1C_(PROMISED AMOUNT._^1 2252 CALL CCSCST ( DEQREC, J+LAMT-1, 9, DEQREC, J+1021, 9, ICOMP )_^1_$IF ( ICOMP .LT. 0 ) GO TO 224_^11_]_^1C_(LAST PAYMENT CLEARS PROMISE. VERIFY PAYMENT RECEIVED AFTER_^1C_(COMMITMENT DATE._^1_$CALL CCSCST ( DEQREC, J+LDATE+3, 2, DEQREC, J+1044, 2, ICOMP )_^1C_0BEFORE CHK FURTHER_!AFTER_^1_$IF (ICOMP ‚‚)_!224 ,_!2253_!,_!2254_^11_]_^1C_(YEARS EQUAL, CHECK MONTH AND DAY._^1 2253 CALL CCSCST ( DEQREC, J+LDATE-1, 4, DEQREC, J+1040, 4, ICOMP )_^1C_(PAYMENT DATE MUST BE PAST COMMITMENT DATE FOR KEPT PROMISE._^1_$IF ( ICOMP .LT. 0 ) GO TO 224_^1C***************************************************************138*A018_^12_]_^1C_(PROMISE KEPT, INCREMENT THE KEPT COUNT_^1C*************** ‚‚************************************************138*A018_^1 2254 DEQREC(K+518) = AND(DEQREC(K+518),$FF0F) + $31_^1C***************************************************************138*A018_^1_$IF ( AND(DEQREC(K+518),$FF) .GT. $39 )_^1_#1_"DEQREC(K+518) = AND(DEQREC(K+518),$FFF) + $30F6_^1C_(INCREMENT THE NEXT CONTACT DATE 7 DAYS_^1_$IK = ICALJL ( DEQREC, J+274 )_^1_$IK = IK + 7_^1_$I ‚‚F ( IK .LE. 365 ) GO TO 222_^1_$DEQREC(K+139) = DEQREC(K+139) + 1_^1_$IF ( AND(DEQREC(K+139),$FF) .GT. $39 )_^1_#1_"DEQREC(K+139) = DEQREC(K+139) + $F6_^1 222 CALL JULCAL ( IK, DEQREC, J+274 )_^1C_(CLEAR THE PROMISED TO PAY FLAG_^1_$CALL CCSPUT ( $4B, J+284, DEQREC )_^1_$GO TO 230_^11_]_^11_]_^1C_(PROMISE BROKEN, INCREMENT THE BROKEN COUNT_^1 224 DEQREC(K+519) = AND(DEQREC(K+519 ‚‚),$FF0F) + $31_^1_$IF ( AND(DEQREC(K+519),$FF) .GT. $39 )_^1_#1_"DEQREC(K+519) = AND(DEQREC(K+519),$FFF) + $30F6_^1C_(SET THE PROMISED TO PAY FLAG TO BROKEN_^1_$CALL CCSPUT ( $42, J+284, DEQREC )_^1._]_^1C_(BUILD THE DLYASSN RECORD - ACCT #, QUEUE, NEXTCD, PRIORITY_^1 230 CALL CCSMVA ( DEQREC, J, 16, ASNREC, L, 16)_^1_$CALL CCSMVA ( DEQREC, J+270, 14, ASNREC, L+16, 14 )_^12_]_^1C* ‚‚***_#IF ADDITIONAL FIELDS ARE REQUIRED IN THE DLYASSN RECORD,_^1C_(THEY SHOULD BE MOVED IN AT THIS POINT_^12_]_^1_$M = M + 1_^1 300 CONTINUE_^11_]_^1C_(SAVE THE DLYASSN RECORD_^1_$M = M - 1_^1_$IF ( M .EQ. 0 ) GO TO 310_^1_$CALL PUTS ( ASNREQ, ASNREC, M, ISTAT )_^1_$IF (ISTAT.GE.0) GO TO 305_^1_$CALL FILERR ( ADATA, 11, ISTAT, LU )_^1_$GO TO 900_^1C_(UPDATE THE RECORDS IN THE DELQ ‚‚MST FILE_^1 305 CALL UPDREC ( DEQREQ, DEQREC, ISTAT )_^1C_(FILE ERROR?_^1_$IF (ISTAT.GE.0) GO TO 310_^1_$CALL FILERR ( DDATA, 15, ISTAT, LU )_^1_$GO TO 900_^1C_(BLANK OUT THE DELQ BUFFER AND CONTINUE_^1 310 CALL CCSBLK(DEQREC, 30000)_^1_$CALL CCSBLK (DEQREC(15001),16000)_^1_$CALL CCSBLK ( ASNREC, 920 )_^1_$M = 1_^1_$IF (EFG.EQ.0) GO TO 200_^11_]_^1C_(CLOSE THE FILES AND STOP_^1 ‚‚900 CALL CLOSFL ( DEQREQ, ISTAT )_^1_$CALL CLOSFL ( ASNREQ, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LDAQEL CSY/ F35 0020 ‚‚1_$PROGRAM LDAQEL_^1_#1_2/F35 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_(THIS PROGRAM LOCATES THE STARTING ACCOUNT FOR REVIEW FOR_^1C_(EACH QUEUE WITHIN THE DAILY ASSIGNMENT FILE. IT SAVES THE_^1C_(RELATIVE RECORD POINTER ALONG WITH THE ‚‚QUEUE IDENTIFIER_^1C_(SO THAT COLECT CAN LOCATE THE START FOR EACH QUEUE'S_^1C_(AUTOMATIC FUNCTION_^11_ _]_^1_$INTEGER DLYREC(20),DLYREQ(24),QREQ(24),QREC(6),DDATA(15),_^1_#1_"QDATA(15),USER(4),QUEUE(2)_^11_]_^1_$DATA DDATA/'LADLYASN',8*$2020,0,1,0/_^1_$DATA QDATA/'LADAQUE ',8*$2020,0,1,0/_^11_]_^1_$DATA DLYREQ, QREQ / 48*0 /_^11_]_^1_$DATA QUEUE / 0,0 /_^11_]_^1C_(ACCEPT LOG ON FR ‚‚OM ITOS, VERIFY MASTER CONSOLE_^1_$CALL PGMIN (USER,LU,MODE,NPORT)_^1_$IF (NPORT.NE.0) CALL PGMOUT_^11_]_^1C_(OPEN FILES FOR USE_^1_$CALL OPENFL (DLYREQ,DDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 900_^1_$CALL OPENFL (QREQ,QDATA,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 905_^11_]_^1C_(GET NEXT RECORD FROM THE ASSIGNMENT FIEL_^1 100 CALL GETS (DLYREQ,DLYREC,I,ISTAT)_^1_$IF (AND(ISTAT,$100).EQ.$1 ‚‚00) GO TO 950_^1_$IF (ISTAT.LT.0) GO TO 910_^1C_(CHECK IF ON SAME QUEUE_^1_$IF (QUEUE(1).EQ.DLYREC( 9).AND._^1_#2_"QUEUE(2).EQ.DLYREC(10)) GO TO 100_^1C_(NEW QUEUE, SAVE IN DAQUE_^1_$QREC(1)=DLYREC( 9)_^1_$QREC(2)=DLYREC(10)_^1_$QREC(3)=DLYREQ(16)_^1_$QREC(4)=DLYREQ(17)_^1_$CALL WRITER (QREQ,QREC,QREC,ISTAT)_^1_$IF (ISTAT.LT.0) GO TO 915_^1_$QUEUE(1)=DLYREC( 9)_^1_$QUEUE(2)=DLYREC( ‚‚10)_^1_$GO TO 100_^1 900 CALL FILERR ( DDATA, 3, ISTAT, LU )_^1_$GO TO 950_^1 905 CALL FILERR ( QDATA, 3, ISTAT, LU )_^1_$GO TO 950_^1 910 CALL FILERR ( DDATA, 14, ISTAT, LU )_^1_$GO TO 950_^1 915 CALL FILERR ( QDATA, 12, ISTAT, LU )_^11_]_^1 950 CALL CLOSFL(DLYREQ,ISTAT)_^1_$CALL CLOSFL(QREQ,ISTAT)_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LDECMT CSY/ F36 0020 ‚‚1_$PROGRAM LDECMT_^1_#1_2/F36 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#PROGRM MAINTAINS DECISION TABLE FILE_^1_$INTEGER TABLE(1502)_^1_$INTEGER CRT,TBTY(2),IDATA(15),REQBUF(24),USER(4)_^1_$DATA REQBUF / 24*0 /_^1_$DATA IDATA / 'LADECTBL',8*$ ‚‚2020,0,1,0 /_^1_$INTEGER TEMP(8)_^1_$INTEGER CMDTB(8)_^1_$DATA CMDTB / 'CRDEADDSPTDUEXDB'/_^1_$INTEGER Y, MSG(3), LN(3), ICMD(2), IU(2), IST(2)_^1_$DATA Y/'Y '/, MSG / 'INPUT=' /_^1_$DATA CRT / 4 /, TBTY / 'COPR' /_^1C_#TABLE LENGTH_^1_$INTEGER COMTLN_^1_$DATA COMTLN/1500/_^1C_#DEBUG DUMP INDICATOR_^1_$INTEGER DB_^1_$DATA DB/0/_^12_]_^1C_(ACCEPT LOG ON FROM ITOS_^1_$CALL PGMIN(USER ‚‚,CRT,MODE,NPORT)_^1C_(VERIFY THIS IS THE MASTER CONSOLE - IF NOT EXIT_^1_$IF ( NPORT .NE. 0 ) CALL PGMOUT_^11_]_^1C_#GET THE FILE FOR PROCESSING, IF FILE NOT DEFINED REPORT AS_^1C_(ERROR AND LEAVE._^11_]_^1_$CALL OPENFL(REQBUF,IDATA,ISTAT)_^1C_#CHECK IF FILE PRESENT_^1_$IF (ISTAT.LT.0) GO TO 8010_^1_$CALL CLOSFL(REQBUF,ISTAT)_^12_]_^1C_#ASK USER WHICH TABLE TO USE, COLLECTOR OR PRI ‚‚ORITY_^1_$WRITE (CRT,9000)_^1 9000 FORMAT ( ' DECISION TABLE MAINTENANCE PROGRAM IN ')_^12_]_^1C_#USING ONLY 1 TABLE_^1_$ITP = 1_^1 150 WRITE (CRT, 9011)_^1 9011 FORMAT ( ' INPUT CR/DE/AD/DS/PT/DU/EX TO EITHER',/,_^1_#1 ' CREATE A COMPLETE TABLE, DELETE A TEST, ADD A TEST',/,_^1_#2 ' DISPLAY A TEST, PRINT THE TABLE, DUMP THE TABLE,',/,_^1_#3 ' END PROCESSING',/)_^1_$IF( DB .EQ ‚‚. 1) CALL DEBDT1 (99,TABLE,1500)_^1 200 CALL WTREAD ( CRT,-1, MSG, 6,-1, ICMD, 2, K )_^1C_#DECODE COMMAND_^1C_(CREATE_^1_$IF (ICMD .EQ. CMDTB(1) ) GO TO 1000_^1C_(END_^1_$IF (ICMD .EQ. CMDTB(7) ) GO TO 7000_^12_]_^1C_#GET THE TABLE_^1_$TABLE(2) = COMTLN_^1_$CALL LRTVD1(ITP,TABLE,IND)_^1_$IF (IND .NE. 0) GO TO 8050_^1C_#DELETE TEST_^1_$IF ( ICMD .EQ. CMDTB(2)) GO TO 2000_^1C_#ADD T ‚‚EST_^1_$IF ( ICMD .EQ. CMDTB(3)) GO TO 3000_^1C_#DISPLAY_^1_$IF ( ICMD .EQ. CMDTB(4)) GO TO 4000_^1C_#PRINT_^1_$IF (ICMD .EQ. CMDTB(5)) GO TO 5000_^1C_#DUMP_]_^1_$IF ( ICMD .EQ. CMDTB(6)) GO TO 6000_^1C_#DEBUG_^1_$IF ( ICMD .NE. CMDTB(8)) GO TO 900_^1C_#TOGGLE DEBUG BIT_^1_$DB = AND($1,DB+1)_^1_$GO TO 150_^1C_#ILLEGAL COMMAND_^1 900 WRITE (CRT,9012) ICMD_^1 9012 FORMAT ( 'COMMAN ‚‚D ', A2, ' NOT IN TABLE, REENTER.')_^1_$GO TO 200_^13_]_^1C_#CREATE NEW TABLE_^1C_]_^1 1000 WRITE (CRT, 9023)_^1 9023 FORMAT ( ' CREATE FUNCTION WILL CLEAR YOUR CURRENT TABLE FILE',/,_^1_#1 ' TYPE Y IF YOU WISH TO DO THAT',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, ICMD, 1, K )_^1_$IF (AND(ICMD,$FF00).NE.$5900) GO TO 150_^1C_#GET RID OF OLD TABLE IF PRESENT_^1_$CALL CLEAR(REQBUF,IDAT ‚‚A,ISTAT)_^1C_(VERIFY CLEAR WAS SUCESSFUL_^1_$IF (ISTAT.LT.0) GO TO 8020_^1C_#ASK IF INPUT FROM NON-CRT LU_^1_$WRITE (CRT,9020)_^1 9020 FORMAT ( ' CREATE TABLE IN PROCESS, INPUT LU OF INPUT STREAM AS',_^1_#1_'/,'_!2 NUMERIC DIGITS' )_^1_$WRITE ( CRT, 9022)_^1 9022 FORMAT ( ' IF LU 04 ENTERED, CREATION WILL BE VIA ADD TEST DIALOG_^1_#1 ',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, IST, ‚‚ 2, K )_^1 9024 ILU = (AND(IST,$F00)/$100)*10 + AND(IST,$F)_^1C_#PASS CONTROL TO SUBROUTINE TO LOAD TABLE_^1_$DO 1100 I = 1, COMTLN_^1 1100 TABLE(I) = 0_^1C_#INITIALIZE TABLE LENGTH AND TYPE_^1_$TABLE(2) = 10_^1_$TABLE(9) = COMTLN_^1_$TABLE(4) = ITP_^1C_#BRANCH TO ADD IF LU = 04_^1_$IF (ILU .EQ. 4) GO TO 3000_^1_$CALL LDTDT1 ( TABLE, ILU, IND3)_^1C_(CHECK FOR ERROR_^1_$IF ( IND3 . ‚‚NE. 0) GO TO 8030_^1C_#WRITE TABLE TO FILE_^1_$DO 300 ISTAT = 1,24_^1 300 REQBUF(ISTAT) = 0_^1_$CALL OPENFL(REQBUF,IDATA,ISTAT)_^1_$CALL PUTS ( REQBUF, TABLE, 1, ISTAT )_^1_$IF ( ISTAT .LT. 0) GO TO 8040_^1_$CALL CLOSFL(REQBUF,ISTAT)_^1C_#TELL OPERATOR TABLE HAS BEEN LOADED_^1_$WRITE (CRT, 9030) TBTY(ITP)_^1 9030 FORMAT ( 3X, A2, ' TABLE HAS BEEN FRESHLY LOADED')_^1_$GO TO 150_^1 ‚‚2_]_^1C_#DELETE TEST_^1 2000 CALL DELDT1 ( TABLE, CRT, IND)_^1_$IF ( IND .LT. 0) GO TO 8060_^1C_#UPDATE FILE_^1_$GO TO 3100_^12_]_^1C_#ADD A TEST_^1C_]_^1 3000 CALL ADDDT1 (TABLE,CRT,IND)_^1_$IF (IND .LT. 0) GO TO 150_^1C_#CORE TABLE HAS BEEN UPDATED_^1C_'UPDATE DISK TABLE_^1C_(1ST REMOVE OLD IMAGE_^1 3100 CALL CLEAR(REQBUF,IDATA,ISTAT)_^1_$IF ( ISTAT .LT. 0) GO TO 8020_^1_$DO 310 ‚‚ISTAT = 1,24_^1 310 REQBUF(ISTAT) = 0_^1_$CALL OPENFL(REQBUF,IDATA,ISTAT)_^1_$CALL PUTS ( REQBUF, TABLE, 1, ISTAT )_^1_$IF (ISTAT.LT.0) GO TO 8040_^1_$CALL CLOSFL(REQBUF,ISTAT)_^1_$GO TO 150_^12_]_^1C_#DISPLAY TEST ON CRT_^1 4000 WRITE ( CRT, 9040)_^1 9040 FORMAT ( ' DISPLAY TEST IN PROCESS. ENTER 3 DIGIT TEST NUMBER FOR_^1_#1DISPLAY',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, LN, 3, ‚‚ K )_^1_$LIN_!= AND(LN(1),$F00)/$100*100+AND(LN(1),$F)*10+_^1_#1_"AND(LN(2),$F00)/$100_^1_$CALL DSPDT1 ( TABLE,LIN ,CRT,IND)_^1_$IF (IND .EQ. 0) GO TO 150_^1C_#ERROR IN DISPLAY MODULE, LINE NUM OUT OF RANGE_^1_$WRITE (CRT, 9042) LIN_^1 9042 FORMAT (' ERROR IN LINE NUMBER', I4, ' NOT IN TABLE')_^1_$GO TO 150_^12_]_^1C_#PRINT TABLE ON LP_^1 5000 CALL PRTDT1 (TABLE, 12)_^1_$WRITE (C ‚‚RT, 9500)_^1 9500 FORMAT ( ' TABLE WAS PRINTED ON LINE PRINTER. ')_^1_$GO TO 150_^12_]_^1C_#DUMP TABLE IN RELOADABLE FORMAT_^1 6000 WRITE ( CRT, 9060)_^1 9060 FORMAT ( ' DUMP TABLE IN PROCESS. TABLE WILL BE DUMPED IN FORM COM_^1_#1PATIBLE' ,/, '_!WITH CREATE FUNCTION. INPUT LU OF OUTPUT STREAM_^1_#2AS 2 NUMERIC DIGITS ',/)_^1_$CALL WTREAD ( CRT,-1, MSG, 6,-1, IU, 2, K )_^1_$LU = A ‚‚ND(IU,$F00)/$100*10+AND(IU,$F)_^1_$CALL DPTDT1 ( TABLE, LU, IND)_^1_$IF ( IND .NE. 0) GO TO 8070_^1_$WRITE ( CRT, 9061) LU_^1 9061 FORMAT ( ' TABLE DUMPED TO LU ', I3 )_^1_$GO TO 150_^1 7000 CALL PGMOUT_^14_]_^1C_#ERROR PROCESSING SECTION_^1C_]_^1 8010 WRITE (CRT,9801)_^1 9801 FORMAT ( 'FILE LADECTBL NOT DEFINED. USE UTIL AND TRY AGAIN.')_^1_$GO TO 8999_^1 8020 WRITE (CRT,9802) I ‚‚STAT_^1 9802 FORMAT ( 'FILE LADECTBL ERROR IN REMOVING ERROR-', Z4)_^1_$GO TO 8999_^1 8030 WRITE (CRT,9803) IND3_^1 9803 FORMAT ( 'SUBROUTINE LDTABL ERROR-', Z4)_^1_$GO TO 8999_^1 8040 WRITE (CRT,9804) ISTAT_^1 9804 FORMAT ( 'FILE LADECTBL ERROR IN STORING RECORD. ERROR-', Z4)_^1_$GO TO 8999_^1 8050 WRITE (CRT, 9805) IND_^1 9805 FORMAT ( ' NO DECISION TABLE IN SYSTEM, ERROR-', Z4)_ ‚‚^1_$GO TO 8999_^1 8060 WRITE ( CRT, 9806) IND_^1 9806 FORMAT ( 'SUBROUTINE DELDT1 ERROR-', Z4)_^1_$GO TO 8999_^1 8070 WRITE ( CRT, 9807) IND_^1 9807 FORMAT ( ' SUBROUTINE DPTDT1 ERROR-', Z4)_^1_$GO TO 8999_^1 8999 IF ( DB .EQ. 1) CALL DEBDT1 (8999, DECMTN, 12000)_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LDHUPD CSY/ F37 0010 ‚‚1_$PROGRAM LDHUPD_^1_#1_2/F37 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^12_]_^1C_#THIS PROGRAM COMBINES DHUPDT AND DHDELE INTO ONE FORTRAN PROGRAM._^1C_#THIS PROGRAM SEQUENTIALLY READS THE ADDACT FILE AND CHECKS FOR_^1C_#STATUS OF A IN COLUMN 17. ‚‚ WHEN A VALID RECORD IS FOUND, THE_^1C_#PROGRAM CHECKS TO SEE IF THE ACCOUNT EXISTS IN THE SUMHIST FILE._^1C_#IF IT EXISTS, THE INFORMATION IN THE SUMHIST RECORD IS MOVED TO_^1C_#THE DELQMST FIELDS. THIS INFO WILL APPEAR IN THE CURRENT FIELDS,_^1C_#IF THE CURRENT FIELDS ARE BLANK, ELSE THE INFO WILL APPEAR IN THE_^1C_#PREVIOUS FIELDS. THE SUMHIST RECORD IS DELETED AFTER ALL INFO ‚‚_^1C_#IS RETRIEVED. THE TAPEARC FILE IS ALSO CHECKED TO SEE IF THE_^1C_#ACCOUNT EXISTS. IF SO,THE TAPE ARCHIVE DATE IS MOVED TO THE_^1C_#THE DELQMST. FOR EACH ACCOUNT UPDATED, A RECORD IS WRITTEN TO_^1C_#THE PRINTER._^12_]_^1_$INTEGER ADDREQ(24),TAPREQ(24),SUMREQ(24),DELREQ(24)_^1_$INTEGER ADATA(15),TDATA(15),SDATA(15),DDATA(15)_^1_$INTEGER ADDREC(364),TAPREC(48),SUMREC(668),DEL ‚‚QRC(2002)_^1_$INTEGER DELKEY(8),TAPKEY(8),SUMKEY(8)_^11_]_^1_$INTEGER A,BLK(180),DELETE,DT(3),EOF,FDEL,FMRDEL_^1_$INTEGER HDR(60),IDUSER(4),MPOS(9),MPPOS,MLEN(9)_^1_$INTEGER PRT,PRTLN(66),SPOS(9),PAGE_^1_$INTEGER UPD,ZERO(7),ONE(5),ICNT(6)_^11_]_^1_$DATA ADATA /'LAADDACT',8*$2020,0,20,-1/_^1_$DATA TDATA /'LATAPARC',8*$2020,1,1,-1/_^1_$DATA SDATA /'LASUMHST',8*$2020,1,1,-1/_^1_$DATA ‚‚ DDATA /'LADLQMST',8*$2020,1,1,1/_^11_]_^1_$DATA ADDREQ/24*0/,TAPREQ/24*0/,SUMREQ/24*0/,DELREQ/24*0/_^1_$DATA A/'A '/,BLK/180*$2020/,LIN/0/,ZERO/7*$3030/_^1_$DATA ONE/4*$3030,$3130/,ICNT/6*$3030/,PRT/$100C/_^1_$DATA PAGE/0/_^1._]_^1C_1DISCRIPTIONS OF MPOS AND SPOS_^1C_1FIELD_"DELQMST_!SUMHIST_^1C_1MADR1_#48_'54_^1C_1MADR2_#78_'84_^1C_1MCS_$108_%114_^1C_1MZP_$128_%134_^1C_1MPHN_#133 ‚‚_%139_^1C_1MBNM_#147_%149_^1C_1MBPHN_"232_%179_^1C_1MBEX_#242_%189_^1C_1MACT_#307_%193_^1C_1MUPDT_"863_'17_^1C_1MP1_$667_%553_^1C_1MP2_$697_%583_^1C_1MP3_$727_%613_^11_]_^1C_#MADR1, MADR2, MCS AND MZP ARE TREATED AS ONE BLOCK OF DATA_^1C_#MBPHN AND MBEX ARE TREATED AS ONE BLOCK OF DATA_^11_]_^1C_11_"2_"3_"4_"5_"6_"7_"8_"9_^1_$DATA MPOS/ 48, 133, 147, 232, 307, 863, 667, 697, 727/_ ‚‚^1_$DATA MLEN/ 85, 10, 30, 14, 360,_!6, 30, 30, 30/_^1_$DATA SPOS/ 54, 139, 149, 179, 193, 17, 553, 583, 613/_^1_$DATA MPPOS/757/_^11_]_^1_$EXTERNAL FMRDEL_^1._]_^1_$CALL PGMIN(IDUSER,LU,MODE,NOPORT)_^1C_**SP_^1C_,**SP_^1C_,_^1C_,END_^11_]_^1C_'WHERE:_^11_]_^1C_,*A_$= CODE FOR START OF LETTER_^1C_,LN_$= TWO DIGIT LETTER NUMBER_^1C_,F1 - F9 = THE MASTERFILE FIELDS THAT HAVE BEEN SPECIFIED F_^1C_6USE IN THE LETTER. THE F1-F9 ARE FOR USER_^1C_6REFERE ‚‚NCE AND ONLY THE F IS RECOGNIZED BY THE_^1C_6BUILD ROUTINE._^11_]_^1C_(WHERE F1-9=LX,CX,TX,PX,LX_^11_]_^1C_,LX = LETTER LINE #_^1C_,CX = COLUMN NUMBER TO START FIELD IN_^1C_,TX = TYPE OF FIELD FOR EDITING PURPOSES_^1C_1WHERE: A = ALPHANUMERIC STRING_^1C_8D = DATE - EDITED TO MM/DD/YY_^1C_8$ = NINE DIGIT AMOUNT EDITED TO $9999999.99_^1C_,PX = STARTING POSITION OF SELECTED MASTERFILE ‚‚ FIELD_^1C_,LX = LENGTH OF FIELD - ONLY APPLIES TO 'A' TYPE FIELD._^1C_1FIELD MUST BE .LE. 54 CHARACTERS._^11_]_^1C_'FILE MANAGER , WORK BUFFERS, AND FILES_^11_]_^1_$INTEGER INBUF(66), LTREC1(40), LTREC2(40), LFBUF, OBUF(66)_^1_$DATA LFBUF/0/, LTREC1/40*$2020/, LTREC2/40*$2020/, OBUF/66*$2020/_^11_]_^1_$INTEGER LRPTBL(42), REQBRP(24), INAMKY(3),LRCBF1(42),LRCBF2(42)_^1_$DATA REQBRP ‚‚/24*0/,INAMKY/3*0/,LRCBF1/42*$2020/,LRCBF2/42*$2020/_^11_]_^1_$INTEGER HDBUF(66),LTFILB(758)_^1_$DATA HDBUF/66*$2020/_^1_]_^11_]_^1_$INTEGER PRTBUF(66), REQBLD(24), REQBLF(24), REQBUT(24)_^1_$DATA REQBLD/24*0/, REQBLF/24*0/, REQBUT/24*0/_^11_]_^1._]_^11_]_^1C_'LETTER DESCRIPTION FILE_^1_$INTEGER IDATLD(15)_^1_$DATA IDATLD/'LALTRDSC', 8*$2020 , 0, 1, 0/_^11_]_^1C_'REPORT TABLE DESCR ‚‚IPTION FILE_^11_]_^11_]_^1_$INTEGER IDATRP(15)_^1_$DATA IDATRP/'LARPTTBL' , 8*$2020, 1, 1, 0/_^11_]_^1_$INTEGER IDATLF(15)_^1_$DATA IDATLF/'LALTRFIL' , 8*$2020, 1, 1, 0/_^11_]_^1_$INTEGER IDATUT(15)_^1_$DATA IDATUT/'LAUTIFIL', 8*$2020, 1, 1, 1/_^11_]_^1C_'CONSTANTS_^11_]_^1_$INTEGER AMONTO, ADAYTO, AYERTO, FMRDEL_^11_]_^1_$INTEGER A, ACODE(2), BLANK, COLNUM, COMMA, DT(3)_^1_$DATA A ‚‚/$0041/,ACODE/'*A,'/,BLANK/$0020/,COLNUM/2/,COMMA/$002C/_^1_$DATA DT/3*$2020/_^11_]_^1_$INTEGER ARAPNT,EACH,CARCTL(2)_^1_$DATA ARAPNT/0/,EACH/$0040/,CARCTL/'**1'/_^11_]_^1_$INTEGER D, EQSIGN, F, FMAX, IFLAG, ITEXTE_^1_$DATA D/$0044/,EQSIGN/$003D/,F/$4600/,FMAX/9/,IFLAG/0/,ITEXTE/0/_^11_]_^1_$INTEGER HD1(2), HD2(2), HD3(2), ILTR1, ILTR2_^1_$DATA HD1/'HDR1'/, HD2/'HDR2'/, HD3/'HDR3'/ ‚‚, ILTR1/5/, ILTR2/5/_^11_]_^1_$INTEGER IEND(2), LENGTH, LINUM, LKEY1(2)_^1_$DATA IEND/'END'/,LENGTH/5/,LINUM/1/,LKEY1/'LTR1'/_^11_]_^1_$INTEGER LKEY2(2),NINE,SIX_^1_$DATA LKEY2/'LTR2'/,NINE/$39/,SIX/$36/_^11_]_^1_$INTEGER MAXLEN, MINLEN, MXLINE, M_^1_$DATA MAXLEN/57/, MINLEN/1/, MXLINE/24/, M/$004D/_^11_]_^1_$INTEGER MAXLTR, MSTRPO, STAR, TYPE, DOLLAR_^1_$DATA MAXLTR/$3939/, MSTR ‚‚PO/4/, STAR/$002A/, TYPE/3/_^1_$DATA DOLLAR/$0024/_^11_]_^1_$INTEGER STAR2,TOPPAG_^1_$DATA STAR2/$2A2A/, TOPPAG/$000C/_^11_]_^1_$INTEGER TWO, SNGLSP, DBLSPA,A1,A2,A3,A4,RE,TWO_^1_$DATA TWO/2/, SNGLSP/$000A/, DBLSPA/$0D0A/,TWO/$32/_^11_]_^1C_'COUNTERS, KEYS, AND VARIABLES_^11_]_^1_$INTEGER ENDPOS, FCOUNT, PARAM, PRTSTR_^0_$INTEGER TXTLIN_^1_]_^11_]_^1_$INTEGER ID(4), ITEMP(8), IRCN ‚‚T, LCOUNT, LDKEY, LFKEY_^1_$DATA ID/4*0/,ITEMP/8*0/,IRCNT/0/,LCOUNT/0/,LDKEY/0/,LFKEY/0/_^11_]_^1_$INTEGER ITYPEA, ITYPED, IDOLAR, NOF,NO_^1_$DATA ITYPEA/0/, ITYPED/0/, IDOLAR/0/, NOF/0/, NO/$004E/_^11_]_^1_$INTEGER LFSTR(4), NSWICH, PRT, SAVKEY, WKBUF(2)_^1_$DATA LFSTR/4*0/,NSWICH/0/,PRT/9/,SAVKEY/0/, WKBUF/2*0/_^11_]_^11_]_^1_$INTEGER LINCTL,NUMCHK,ZEROES(2),WKKEY,PRTLEN_^1_$DA ‚‚TA LINCTL/$3100/, NUMCHK/0/, ZEROES/2*0/_^1_$DATA WKKEY/0/,PRTLEN/132/_^11_]_^11_]_^1_$INTEGER LTRCNT, THREEO(3),RTNMKY(3)_^1_$DATA_"LTRCNT/0/, THREEO/3*0/,RTNMKY/3*0/_^1C_'MESSAGE BUFFERS_^1._]_^1_$INTEGER AERROR(15)_^1_$DATA AERROR/'EXPECTED "*A," - FOUND "_!".'/_^11_]_^1_$INTEGER BLNKER(21)_^1_$DATA BLNKER/'FOUND AN ILLEGAL BLANK IN PARAMETER " ".'/_^11_]_^1_$INTEGER COMAER(21 ‚‚)_^1_$DATA COMAER/'EXPECTED LETTER NUMBER - FOUND A "COMMA".'/_^11_]_^1_$INTEGER DUPKEY(24)_^1_$DATA DUPKEY/'DUPLICATE KEY - LETTER NUMBER XX ALEADY PRESENT'/_^11_]_^1_$INTEGER ENDERR(14)_^1_$DATA ENDERR/'EXPECTED "END" FOUND "_!".'/_^11_]_^1_$INTEGER EQERR(12)_^1_$DATA EQERR/'FORMAT MISSING "=" SIGN '/_^11_]_^1_$INTEGER FMAXER(19)_^1_$DATA FMAXER/'FIELD DESCRIPTION EXCEEDS LIMIT O ‚‚F 9.'/_^11_]_^1_$INTEGER FERROR(13)_^1_$DATA FERROR/'EXPECTED "F" - FOUND " ".'/_^11_]_^1_$INTEGER LNERR(24)_^1_$DATA LNERR/'EXPECTED NUMBER WITH RANGE OF 01-99 FOUND " ".'/_^11_]_^1_$INTEGER PAMERR(21)_^0_$DATA_"PAMERR/'EXCEEDED PARAMETER LIMIT ON PARAMETER # .'/_^11_]_^1_$INTEGER PARAM1(22)_^1_$DATA PARAM1/'LINE NUMBER IN FIELD DESCRIPTION EXCEEDS 24.'/_^11_]_^0_$INTEGER PARAM2( ‚‚22)_^0_$DATA_"PARAM2/'COLUMN NUMBER PLUS FIELD LENGTH EXCEEDS 54. '/_^11_]_^11_]_^1_$INTEGER PARAME(15)_^1_$DATA PARAME/'ILLEGAL CHARACTER - FOUND " ".'/_^11_]_^1_$INTEGER PARAM5(24)_^1_$DATA PARAM5/'ILLEGAL USE OF PARAM 5. TYPE FIELD DOES NOT = A.'/_^11_]_^1_$INTEGER RPTBLE(25)_^1_$DATA RPTBLE/'UNABLE TO LOCATE FIELD NAME "_%" IN LARPTTBL'/_^11_]_^1_$INTEGER TEXT1(25)_^1_$DATA TEX ‚‚T1/'UNABLE TO LOCATE LINE CONTROL OR CONTROL INVALID.'/_^11_]_^1_$INTEGER TEXT2(14)_^1_$DATA TEXT2/'NUMBER OF LETTERS EXCEED 50'/_^11_]_^1_$INTEGER TEXT3(13)_^1_$DATA TEXT3/'NUMBER OF LINES EXCEED 24 '/_^0_$INTEGER MAXLIN(22)_^0_$DATA_$MAXLIN/'MAX. LINE NUMBER FIELD EXCEEDS LETTER SIZE. '/_^11_]_^1_$INTEGER UTFERR(19)_^1_$DATA UTFERR/'UNABLE TO LOCATE LTRX IN THE LAUTIFIL'/_^11_]_ ‚‚^1_$INTEGER HD2A(15)_^1_$DATA HD2A/'_#LETTER FILE BUILD_''/_^11_]_^1_$INTEGER HD2B(2)_^1_$DATA HD2B/'PAGE'/_^11_]_^1_$INTEGER HD3A(3)_^1_$DATA HD3A/'AS OF:'/_^11_]_^1_$INTEGER PAGCNT,PAGOUT(2),CRCTL2(2),SALSW,DECPOS,DATATP,EDITCD_^1_$DATA PAGCNT/0/,PAGOUT/2*$0000/,CRCTL2/'**2'/,SALSW/0/_^11_]_^1_$INTEGER RTBLSW,STARSW,T,Y_^1_$DATA RTBLSW/0/,STARSW/0/,T/'T'/,Y/'Y'/_^11_]_^1_$INTEGER ‚‚ HDR(60),ZERO,WKAREA(2),SALNUM_^1_$DATA ZERO/$3030/,WKAREA/2*$2020/_^11_]_^11_]_^11_]_^1_$EXTERNAL AMONTO,AYERTO,ADAYTO,FMRDEL_^0C_'TYPE D FIELD LENGTHS FOR DATE FORMATS._^0_$INTEGER DLENS(3)_^0_$DATA_#DLENS/18,12,8/_^11_]_^1._]_^1C_'CALL IN INFORMATION FROM ITOS CONCERNING EXECUTION ENVIRONMENT_^11_]_^1_!10 CALL PGMIN (ID, LU, MODE, NOPORT)_^11_]_^1C_'IF NOT A MASTER TERMINAL EXI ‚‚T FROM PROGRAM_^11_]_^1C 20 IF (NOPORT .NE. 0) GO TO 2010_^11_]_^1C_'OPEN LETTER DESCRIPTION FILE_^11_]_^1_!30 CALL OPENFL(REQBLD, IDATLD, ISTAT)_^1_!32 IF (ISTAT .GE. 0) GO TO 35_^1_$CALL FILERR(IDATLD, 3, ISTAT, LU)_^1_$GO TO 2010_^11_]_^1C_'OPEN REPORT TABLE FILE DESCRIPTION_^11_]_^1_!35 CALL OPENFL(REQBRP, IDATRP, ISTAT)_^1_!37 IF(ISTAT .GE. 0) GO TO 40_^1_$CALL FILERR(IDATRP, ‚‚ 3, ISTAT, LU)_^1_$GO TO 2010_^11_]_^11_]_^1C_'BRING IN HEADINGS AND DATE_^1_!40 CALL LAHEAD(HDR,DT)_^11_]_^11_]_^1C_'CALL IN SYSTEM DELETE CODE_^11_]_^1_!45 ASSEM $C000,FMRDEL,$6800,ISDEL_^11_]_^11_]_^1C_'OPEN LETTER FILE_^11_]_^1_!57 CALL OPENFL(REQBLF,IDATLF,ISTAT)_^1_$IF(ISTAT .GE. 0) GO TO 60_^1_$CALL FILERR(IDATLF, 3, ISTAT, LU)_^1_$GO TO 2010_^11_]_^1C_'OPEN UTILITY FILE._^1 ‚‚1_]_^1_!60 CALL OPENFL(REQBUT, IDATUT, ISTAT)_^1_!65 IF (ISTAT .GE. 0) GO TO 85_^1_$CALL FILERR(IDATUT, 3, ISTAT, LU)_^1_$GO TO 2010_^11_]_^11_]_^1C_'CLEAR LTREC1 AND LTREC2_^11_]_^1_!85 CALL CCSBLK(LTREC1,80)_^1_$CALL CCSBLK(LTREC2,80)_^11_]_^1_!90 NSWICH=0_^1._]_^1C***********************************************************************_^1C_'READ A RECORD FROM THE LETTER DESCRIPTI ‚‚ON FILE AND SEARCH_^1C_'FOR VALID '*A,LN'._^1C***********************************************************************_^1C_]_^1 130 CALL GETS (REQBLD, INBUF, LDKEY, ISTAT)_^1_$IF(AND(ISTAT,$100).EQ.$100) GO TO 251_^1_$IF(ISTAT .GE. 0) GO TO 135_^1_$CALL FILERR(INBUF, 14, ISTAT, LU)_^1_$GO TO 2010_^11_]_^1C_'INITIALIZE COUNTERS_^11_]_^1 135 LFSTR=1_^1_$ARAPNT=1_^1_$LCOUNT=1_^0_$TXT ‚‚LIN = 0_^1_$SALNUM=0_^1_$LINEND=0_^1_$IRCNT=0_^1_$FCOUNT=0_^1_$NOF=0_^1_$SALSW=0_^1_$STARSW=0_^0_$IMAXLN = 0_^11_]_^1C_'CHECK FOR SYSTEM DELETE CODE AT BEGINNING OF EACH RECORD READ._^11_]_^1 136 IF(INBUF(1).EQ.ISDEL) GO TO 130_^11_]_^1 140 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(TOPPAG, 1, 2, PRTBUF, 1, 2)_^1_$CALL CCSMVA(HDR,1,40,PRTBUF,5,40)_^1_$ASSIGN 150 TO ICOMP_^1_$CALL ‚‚ FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1 150 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(SNGLSP, 1, 2, PRTBUF, 1, 2)_^1_$CALL CCSMVA(HDR,41,40,PRTBUF,5,40)_^1_$CALL CCSMVA(HD2A, 1, 30, PRTBUF, 51, 30)_^1_$CALL CCSMVA(HD2B, 1, 4, PRTBUF, 121, 4)_^11_]_^1C_'CONVERT PAGE NUMBER_^1 160 PAGCNT=PAGCNT+1_^1_$A1=PAGCNT/$3E8_^1_$RE=PAGCNT-(A1*$3E8)_^1_$A2=RE/$64 ‚‚_^1_$RE=RE-(A2*$64)_^1_$A3=RE/$A_^1_$RE=RE-(A3*$A)_^1_$A4=RE_^11_]_^1C_'MOVE PAGE COUNT TO PRINTER_^11_]_^1 165 PAGOUT(2)=((A3+$30)*$100)+(A4+$30)_^1_$PAGOUT(1)=((A1+$30)*$100)+(A2+$30)_^11_]_^1C_'EDIT PAGE COUNT_^11_]_^1_$DO 166 I=1,3_^1_$CALL CCSCST(PAGOUT,I,1,ZERO,1,1,NCOMP)_^1_$IF(NCOMP.NE.0) GO TO 167_^1_$CALL CCSMVA(BLANK,2,1,PAGOUT,I,1)_^1 166 CONTINUE_^1 167 CALL CCSMVA( ‚‚PAGOUT,1,4,PRTBUF,126,4)_^1_$ASSIGN 170 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1 170 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(SNGLSP, 1, 2, PRTBUF, 1, 2)_^1_$CALL CCSMVA(HDR,81,40,PRTBUF,5,40)_^1_$CALL CCSMVA(HD3A, 1, 6, PRTBUF, 51, 6)_^1_$CALL LTRDTE(DT,PRTBUF,60,1)_^1_$ASSIGN 190 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLA ‚‚G,ITEMP)_^1_$CALL DISP_^11_]_^11_]_^11_]_^1C_'CHECK FOR END OF LETTER DESCRIPTION FILE._^1 190 CALL CCSCST(INBUF, 1, 3, IEND, 1, 3, NCOMP)_^1 195 IF (NCOMP .NE. 0) GO TO 220_^1_$NSWICH=NSWICH+1_^11_]_^1C_'MOVE 'END' RECORD TO ECHO PRINT++++++++++++++++++++++++++++++++_^11_]_^1 200 CALL CCSBLK(PRTBUF,132)_^1_$PRTBUF(1)=SNGLSP_^1_$CALL CCSMVA(INBUF, 1, 3, PRTBUF, 5, 3)_^11_]_^1C_' ‚‚NSWICH = 1, WE HAVE FOUND ONE END - GET ANOTHER RECORD._^11_]_^1_$IF(NSWICH .EQ. 1) ASSIGN 130 TO ICOMP_^11_]_^1C_'NSWICH = 2, WE HAVE THE SECOND END - GO TO CLOSE FILES._^11_]_^1_$IF(NSWICH .EQ. 2) ASSIGN 1600 TO ICOMP_^1_$CALL FWRITE(PRT, PRTBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^11_]_^1C_'CHECK FOR VALID '*A,' CODE (START OF A NEW LETTER - BYTES 1-3)_^1 220 NSWI ‚‚CH=0_^11_]_^1C_'IF THERE IS A VALID *A SAVE FIELD AND PROCESS LETTER NUMBER._^11_]_^1 230 CALL CCSCST(INBUF, 1, 3, ACODE, 1, 3, NCOMP)_^1_$IF(NCOMP .EQ. 0) GO TO 250_^1_$GO TO 235_^11_]_^1C_'*A NOT FOUND - PRINT ERROR MESSAGE AND ERRONEOUS DATATA_^11_]_^1 235 CALL CCSBLK(OBUF,132)_^1_$CALL CCSBLK(PRTBUF,PRTLEN)_^1_$PRTBUF(1)=DBLSPA_^1_$CALL CCSMVA(INBUF,1,80,PRTBUF,5,80)_^1_$ASSI ‚‚GN 236 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^1 236 CONTINUE_^1_$OBUF(1)=DBLSPA_^1_$CALL CCSMVA(INBUF,1,3,AERROR,25,3)_^1_$CALL CCSMVA(AERROR,1,30,OBUF,10,30)_^1_$IRCNT=IRCNT+1_^1_$ASSIGN 400 TO ICOMP_^1_$CALL CCSMVA(INBUF, 1,3, OBUF, 34, 3)_^1_$CALL FWRITE (PRT, OBUF,132, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1C_'IF NSWICH = 1 WE HAVE AN ‚‚END RECORD PRIOR TO READING_^1C_'NEXT LETTER_^11_]_^1 250 IF(NSWICH .NE. 1) GO TO 320_^1 251 CONTINUE_^1_$OBUF(1)=SNGLSP_^1_$CALL CCSBLK(OBUF,PRTLEN)_^1_$CALL CCSMVA(INBUF,1,3,ENDERR,23,3)_^1_$CALL CCSMVA(ENDERR,1,28,OBUF,10,28)_^1_$IRCNT=IRCNT+1_^1_$ASSIGN 320 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1C_'BLANK LETTER FILE_^11_]_^1 32 ‚‚0 CALL CCSBLK(LTFILB,1512)_^1_$NSWICH=0_^11_]_^11_]_^11_]_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^1C_'MOVE LETTER FILE POINTER (LTFILB)_^1C_'CHECK FOR VALID LETTER NUMBER (BYTES 4 AND 5)_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^11_]_^1 330 CALL CCSMVA(ZEROES, 1, 2, SAVKEY, 1, 2)_^1 335 DO 360 I = 1, 2_^1_(CALL ‚‚ CCSGET(INBUF, I+3, N)_^1_(IF(N .GE. $30 .AND. N .LE. $39) GO TO 340_^1_(IF(N .EQ. BLANK .AND. I .EQ. 2) GO TO 337_^11_]_^1C_'IF NOT NUMERIC AND/OR POSITION 1 IS A BLANK - ERROR_^11_]_^1_(GO TO 390_^11_]_^1C_'VALID NUMBER - PLACE IN SAVKEY (LETTER NUMBER KEY)_^11_]_^1 337_"SAVKEY=SAVKEY/$100+$3000_^1_(GO TO 360_^11_]_^1 340_"CALL CCSPUT(N, I, SAVKEY)_^11_]_^1 360 CONTINUE_^11_]_ ‚‚^1_]_^11_]_^1C_'MOVE '*A,LN' RECORD TO ECHO PRINT.+++++++++++++++++++++++++++++_^11_]_^1 370 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(DBLSPA, 1, 2, PRTBUF, 1, 2)_^1_$CALL CCSMVA(INBUF,1,80,PRTBUF,5,80)_^1_$ASSIGN 380 TO ICOMP_^1_$CALL FWRITE(PRT, PRTBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1C_'CHECK IF LETTER NUMBER EXCEEDS MAXIMUM NUMBER OF LETTERS._^11_]_^1 380 ‚‚IF(SAVKEY .GT. MAXLTR) GO TO 390_^11_]_^1C_'IF NOT > MAXIMUM - MOVE TO LETTER FILE AND LETTER PRINT._^11_]_^1 382 CALL CCSMVA(SAVKEY,1,2,LTFILB,LFSTR,2)_^1_$LFSTR=LFSTR+2_^1_$GO TO 400_^11_]_^1C_'FOUND AN ILLEGAL CHARACTER_^11_]_^1 390 CALL CCSBLK(OBUF,132)_^1_$CALL CCSBLK(PRTBUF,PRTLEN)_^1_$PRTBUF(1)=DBLSPA_^1_$CALL CCSMVA(INBUF,1,80,PRTBUF,5,80)_^1_$ASSIGN 395 TO ICOMP_^1_$CALL ‚‚ FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^1 395 CONTINUE_^1_$OBUF(1)=SNGLSP_^1_$CALL CCSMVA(INBUF,4,2,LNERR,44,2)_^1_$CALL CCSMVA(LNERR,1,47,OBUF,10,47)_^1_$IRCNT=IRCNT+1_^1_$ASSIGN 400 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF,132, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^1._]_^11_]_^1C***********************************************************************_^1C_]_^1C_'READ A ‚‚ RECORD AND SEARCH FOR VALID 'F' FIELD._^1C_]_^1C***********************************************************************_^11_]_^1_]_^1 400 CALL CCSBLK(INBUF,80)_^1_$IBYTE=0_^1_$CALL CCSBLK(PRTBUF, 132)_^1 420 CALL GETS (REQBLD, INBUF, LDKEY, ISTAT)_^1_$IF(AND(ISTAT,$100).EQ.$100) GO TO 251_^1_$IF(ISTAT .GE. 0) GO TO 430_^1_$CALL FILERR(INBUF,14, ISTAT, LU)_^1_$GO TO 2010_^11_]_^1 ‚‚C_'CHECK FOR SYSTEM DELETE CODE_^11_]_^1 430 IF(INBUF(1).EQ.ISDEL) GO TO 420_^11_]_^11_]_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^1C_'"F" DESCRIPTION RECORD?_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^11_]_^1 520 ITYPEA=0_^1_$ITYPED=0_^1_$IDOLAR=0_^11_]_^1_(CALL CCSCST(INBUF,1,1,F,1,1,NCOMP)_^1_(IF(NCOMP .EQ. 0) ‚‚GO TO 540_^1C_'FCOUNT .GE. 1 (WE HAVE AT LEAST ONE_^1C_'"F" FIELD) - GO TO TEXT SEARCH_^11_]_^1 525 IF(FCOUNT .GE. 1) GO TO 1200_^1_$PRTBUF(1)=SNGLSP_^1_$CALL CCSMVA(INBUF, 1, 80, PRTBUF, 5, 80)_^1_$ASSIGN 530 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^1C_'NO "F" FIELD + FCOUNT=0 (WE HAVE FOUND NO F FIELDS)_^11_]_^1 530 CALL CCSBLK (OBUF, ‚‚132)_^1_$OBUF(1)=SNGLSP_^1_$CALL CCSMVA(INBUF,1,1,FERROR,23,1)_^1_$CALL CCSMVA(FERROR,1,26,OBUF,10,26)_^1_$IRCNT=IRCNT+1_^1_$ASSIGN 1236 TO ICOMP_^1_$CALL FWRITE (PRT, OBUF,132, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1C_'FOUND A VALID "F" - MOVE TO LTRFILE IF LCOUNT IS LESS THEN 9._^11_]_^1 540 IF(FCOUNT .EQ. FMAX) GO TO 1140_^1_$CALL CCSMVA (INBUF, 1, 1, LTFILB, LFSTR, 1)_^11_ ‚‚]_^1C_'MOVE "F" TO PRINT++++++++++++++++++++++++++++++++++++++++++++++_^1_$PRTBUF(1)=SNGLSP_^1_$CALL CCSMVA(INBUF, 1, 80, PRTBUF, 5, 85)_^1_$ASSIGN 560 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^11_]_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^1C_'SEARCH FOR "=" FIELD. WILL SCAN SIX BYTES SEARCHING FOR '='._^1 ‚‚C_'IF NOT FOUND WILL DROP TO PARA 600 AND PRINT ERROR._^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^11_]_^1 560 LFSTR=LFSTR+1_^1_$DO 580 I=1,41_^1_(CALL CCSGET(INBUF, I+1, N)_^11_]_^1_(ICNT=I_^1_(IF(N .EQ. EQSIGN) GO TO 595_^1 580 CONTINUE_^11_]_^1C_'FALL THROUGH ERROR DID NOT FIND AN "=" SIGN_^11_]_^1 590 CALL CCSBLK (OBUF,132)_^1_$OBUF(1)=SNGLSP_ ‚‚^1_$CALL CCSMVA(EQERR,1,24,OBUF,10,24)_^1_$FCOUNT=FCOUNT+1_^1_$IRCNT=IRCNT+1_^1_$ASSIGN 400 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF,132, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1C_'FOUND "=" SIGN, MOVE TO LETTER FILE(LTFILB)._^11_]_^1 595 CALL CCSMVA(N, 2, 1, LTFILB, LFSTR, 1)_^11_]_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^1C_'SEARCH FOR VALID PARAM ‚‚ETERS FOLLOWING '=' SIGN._^1C_'ICNT EQUALS THE POSITION OF THE '=' IN THE F RECORD. VALUE IS_^1C_'SET IN PARA 560._^1C_*LINUM=1, COLNUM=2, TYPE=3, MSTRPO=4, LENGTH=5_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^11_]_^1 600 PARAM=1_^1_$ICNT=ICNT+1_^1_$CALL CCSMVA(ZEROES, 1, 4, WKBUF, 1, 4)_^1_$DO 1000 I = 1,16_^1_(IBYTE=IBYTE+1_^1_(CALL CCSGET(INBUF, ‚‚ I+ICNT, N)_^11_]_^1 610_"IF(N .GE. $30 .AND. N .LE. $39) GO TO 620_^1_(IF(N .EQ. NO) GO TO 680_^1_(IF(N .EQ. COMMA) GO TO 700_^1_(IF(N .EQ. A) GO TO 780_^1_(IF(N .EQ. D) GO TO 820_^1_(IF(N .EQ. M .OR. N .EQ. $4C) GO TO 630_^1_(IF(N .EQ. DOLLAR) GO TO 780_^1_(IF(N .EQ. BLANK) GO TO 660_^11_]_^1C_'AT THIS POINT IF FIELD IS NOT EQUAL TO 0-9, A COMMA, CHARACTER_^1C_''A', 'D', '$' OR ‚‚A BLANK IT IS IN ERROR._^11_]_^1 615_"CALL CCSBLK(OBUF,132)_^1_(CALL CCSMVA(N,2,1,PARAME,28,1)_^1_(CALL CCSMVA(PARAME,1,30,OBUF,10,30)_^1_(GO TO 935_^11_]_^1C_'NUMERIC FIELD_^11_]_^1 620_"IF(IBYTE.EQ.1.OR. IBYTE .EQ. 2) GO TO 655_^1_(IF(IBYTE.EQ.3.AND. PARAM .EQ. MSTRPO) GO TO 655_^1_(IF(IBYTE.EQ.3 .AND. PARAM .NE. 4) GO TO 900_^1_(IF(IBYTE .EQ. 4 .AND. PARAM .NE. 4) GO TO 900_^1 ‚‚_(IF(IBYTE .EQ. 4 .AND. PARAM .EQ. MSTRPO) GO TO 655_^1_(IF(IBYTE .GT. 4) GO TO 900_^1._]_^11_]_^1C_'USE FIELDS FROM MASTER FILE_^11_]_^1 630_"IF(PARAM .NE. 3) GO TO 900_^1_(CALL CCSBLK(RTNMKY, 6)_^11_]_^1C_'MOVE 1ST LETTER TO RTNAME KEY_^11_]_^1 632_"ICNT=I+ICNT_^1_(INAMPO=1_^1_(CALL CCSMVA(N, 2, 1, RTNMKY, INAMPO, 1)_^11_]_^1C_'MOVE REST OF RTNAME TO KEY_^11_]_^1 634_"DO 639 I ‚‚I=1, 6_^1_+INAMPO=INAMPO+1_^1_+CALL CCSGET(INBUF, II+ICNT, N)_^1_+IF(N .EQ. $0020 .OR. N .EQ. $002C) GO TO 640_^1_+CALL CCSMVA(N, 2, 1, RTNMKY, INAMPO, 1)_^1 639 CONTINUE_^11_]_^1C_'READ REPORT TABLE_^11_]_^1 640 CALL CCSMVA(RTNMKY,1,6,HDBUF,1,6)_^1_$CALL READR(REQBRP,LRPTBL,RTNMKY,ISTAT)_^1_$IF(AND(ISTAT,$200).EQ.$200) GO TO 643_^1_$IF(ISTAT.GE.0) GO TO 644_^1_$CALL FILERR(IDATR ‚‚P,13,ISTAT,LU)_^1_$GO TO 2010_^1 643 CALL CCSBLK(OBUF,132)_^1_$OBUF(1)=SNGLSP_^1_$CALL CCSMVA(HDBUF,1,6,RPTBLE,30,6)_^1_$CALL CCSMVA(RPTBLE,1,50,OBUF,10,50)_^1_$CALL CCSBLK(RTNMKY, 6)_^1_$IRCNT=IRCNT+1_^1_$FCOUNT=FCOUNT+1_^1_$ASSIGN 400 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF,132, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1C_'GET FIELD TYPE_^11_]_^11_]_^0C_'...IF D TYPE DO D TYPE PROCE ‚‚SSING._^0 644 CALL CCSCST (LRPTBL, 16, 1, Y, 1, 1, NCOMP)_^0_$IF (NCOMP .NE. 0) GO TO 645_^0_(ITEMP2 = D_^0_(ILENFL = 3_^0_(ILENTH = 8_^0_(GO TO 648_^0C_'...IF A TYPE DO A TYPE PROCESSING._^0 645 CALL CCSCST (LRPTBL, 15, 1, A, 2, 1, NCOMP)_^0_$IF (NCOMP .NE. 0) GO TO 646_^0_(ITEMP2 = A_^0_(CALL CCSMVA (LRPTBL, 11, 4, WKBUF, 1, 4)_^0_(WKBUF(2) = ICCSAD (WKBUF(2))_^0_(ILENFL = IC ‚‚CSAD (WKBUF(1))*100+WKBUF(2)_^0_(ILENTH = ILENFL_^0_(GO TO 648_^0C_'...MUST BE $ TYPE DO $ TYPE PROCESSING._^0 646_"ITEMP2 = DOLLAR_^0_(ILENFL = NINE_^0_(ILENTH = 11_^0C_'...DO COMMON PROCESSING FOR TYPE._^0 648 CALL CCSMVA (ILENFL, 2, 1, LTFILB, LFSTR+3, 1)_^0_$CALL CCSMVA (ITEMP2, 2, 1, LTFILB, LFSTR+4, 1)_^0C_'...VERIFY FIELD DOES NOT EXCEED 54 CHAR/LINE._^0_$IF (ISVCOL + ILEN ‚‚TH .GT. 55) GO TO 920_^11_]_^1C_'MOVE IN MASTER POSITION_^11_]_^1 649 CALL CCSMVA(LRPTBL, 7, 4, WKBUF, 1, 4)_^1 650 WKBUF(2)=ICCSAD(WKBUF(2))_^1_$WKBUF(1)=ICCSAD(WKBUF(1))*100+WKBUF(2)_^1_$CALL CCSMVA(WKBUF(1), 1, 2, LTFILB, LFSTR+5, 2)_^1_$GO TO 895_^1._]_^11_]_^1C_'PLACE N INTO WKBUF TO LIMIT CHECK AND FOR CONVERSION_^1C_'(PARAGRAPH 670-737 FOR CONVERSION)_^11_]_^1 655_"IF(I ‚‚BYTE .GT. 4) GO TO 900_^1_(CALL CCSPUT(N, IBYTE, WKBUF)_^1_(GO TO 1000_^11_]_^1C_'FOUND A BLANK_^11_]_^1 660_"IF(PARAM.LE.TYPE.AND.ITYPED.EQ.1) GO TO 930_^1_(IF(PARAM.LE.MSTRPO.AND.ITYPED.NE.1) GO TO 930_^1_(IF(PARAM .EQ. LENGTH) GO TO 670_^11_]_^1C_'FOUND A BLANK MSTRPO PARAMATER(4)_^11_]_^1 665_"IF(IBYTE .EQ. 1) GO TO 930_^1_(IF(IBYTE .EQ. 2 .OR. IBYTE .EQ. 3) GO TO 720_^1_(IF( ‚‚IBYTE .EQ. 4) GO TO 860_^1_(IF(IBYTE .EQ. 5) GO TO 880_^1_(GO TO 900_^11_]_^1C_'FOUND A BLANK IN LENGTH PARAMATER(5)_^11_]_^1 670_"IF(IBYTE .EQ. 1) GO TO 675_^0_(IF (IBYTE .EQ. 2) GO TO 720_^0_(IF (IBYTE .EQ. 3) GO TO 740_^11_]_^1_(GO TO 900_^11_]_^1 675_"IF(IDOLAR .EQ. 1) GO TO 890_^11_]_^1C_'ELSE GO TO ERROR PRINT_^11_]_^1_(GO TO 925_^11_]_^1C_'FOUND % - NO 'F' FIELD OPTION C ‚‚HOSEN_^11_]_^1 680_"IF(PARAM .NE. 1) GO TO 905_^1_(NOF=1_^1_(LFSTR=LFSTR+1_^1_(CALL CCSMVA(N,2,1,LTFILB,LFSTR,1)_^1_(LFSTR=LFSTR+1_^1_(GO TO 1120_^1_]_^1_]_^1_]_^11_]_^11_]_^1C_'FOUND A COMMA($2C)_^11_]_^1 700_"IF(IBYTE .EQ. 1) GO TO 910_^11_]_^1_(IF(IBYTE .EQ. 2 .AND. PARAM .EQ. TYPE) GO TO 800_^1_(IF(IBYTE .EQ. 2) GO TO 720_^11_]_^1_(IF(IBYTE .GE. 3 .AND. PARAM .EQ. TYPE) GO TO ‚‚ 900_^1_(IF(IBYTE .EQ. 3) GO TO 740_^11_]_^1_(IF(IBYTE .EQ. 4 .AND. PARAM. EQ. MSTRPO) GO TO 860_^1_(IF(IBYTE .EQ. 4 .AND. PARAM .NE. MSTRPO) GO TO 900_^11_]_^1_(IF(IBYTE .EQ. 5 .AND. PARAM .EQ. MSTRPO) GO TO 880_^1_(IF(IBYTE .EQ. 5 .AND. PARAM .NE. MSTRPO) GO TO 900_^11_]_^0_%GO TO 900_^11_]_^11_]_^11_]_^1C_'CONVERT SINGLE ASCII TO NUMERIC_^11_]_^11_]_^1 720_"WKBUF(1)=ICCSAD(WKBU ‚‚F(1))/10_^0_$GO TO 741_^11_]_^1C_'CONVERT 2 DIGIT NUMBER_^11_]_^1 740_"WKBUF(1)=ICCSAD(WKBUF(1))_^0 741 GO TO (745, 750, 1000, 760, 755), PARAM_^11_]_^0C_'LINE NUMBER_^11_]_^1 745_"IBYTE=0_^1_(PARAM=PARAM+1_^1_(IF(WKBUF(1).LT.1.OR.WKBUF(1).GT.24) GO TO 905_^1_(CALL CCSMVA(WKBUF(1), 2, 1, LTFILB, LFSTR+1, 1)_^0C_'...UPDATE MAXLIN IF REQ'D. FOR LATER CHECK._^0_(IF (WKBUF(1) .GT. I ‚‚MAXLN) IMAXLN = WKBUF(1)_^1_(CALL CCSMVA(ZEROES, 1, 4, WKBUF, 1, 4)_^1_(GO TO 1000_^11_]_^0C_'COLUMN NUMBER_^11_]_^1 750_"IBYTE=0_^1_(PARAM=PARAM+1_^0_(ISVCOL = WKBUF(1)_^1_(IF(WKBUF(1).LT.MINLEN.OR.WKBUF(1).GT.MAXLEN-3) GO TO 920_^1_(CALL CCSMVA(WKBUF(1), 2, 1, LTFILB, LFSTR+2, 1)_^1_(CALL CCSMVA(ZEROES, 1, 4, WKBUF, 1, 4)_^1_(GO TO 1000_^11_]_^0C_'LENGTH_^11_]_^1 755_"IF(IDOLA ‚‚R .EQ. 1) GO TO 890_^0C_'...(SET ILENTH FOR A TYPE.)_^0_(ILENTH = WKBUF(1)_^0_(IF (ITYPED .NE. 1) GO TO 757_^0_+IF (WKBUF(1) .LT. 1 .OR. WKBUF(1) .GT. 3) GO TO 900_^0_+ITEMP1 = WKBUF (1)_^0_+ILENTH = DLENS(ITEMP1)_^0C_'...IF FIELD EXCEEDS 54 CHAR/LINE, OUTPUT ERROR_^0 757_"IF (ISVCOL + ILENTH .GT. 55) GO TO 920_^1_(CALL CCSMVA(WKBUF(1), 2, 1, LTFILB, LFSTR+3, 1)_^1_(GO TO 895_^1 ‚‚1_]_^11_]_^1C_'MSTRPO FIELD - TWO DIGIT_^11_]_^1 760_"IBYTE=0_^1_(PARAM=PARAM+1_^1_(CALL CCSMVA(WKBUF(1), 1, 2, LTFILB, LFSTR+5, 2)_^1_(CALL CCSMVA(ZEROES, 1, 4, WKBUF, 1, 4)_^1_(GO TO 1000_^11_]_^1C_'TYPE FIELD - IF 'A' FIELD TURN ON TYPE-A SWITCH_^11_]_^1 780_"IF(PARAM.NE.TYPE) GO TO 910_^1_(IF(N.EQ.A)ITYPEA=1_^1_(IF(N .EQ. DOLLAR) IDOLAR=1_^1_(CALL CCSPUT(N, LFSTR+4, LTFILB)_^ ‚‚1_(GO TO 1000_^11_]_^1C_'FOUND A COMMA FOLLOWING A TYPE FIELD. INCREMENT PARAM COUNT_^1C_'AND IBYTE._^11_]_^1 800_"PARAM=PARAM+1_^1_(IBYTE=0_^1_(GO TO 1000_^11_]_^11_]_^1C_'IF TYPE FIELD = 'D' -- TURN ON D SWITCH._^11_]_^1 820_"IF(PARAM.NE.TYPE) GO TO 910_^1_(IF(N.EQ.D)ITYPED=1_^1_(CALL CCSPUT(N, LFSTR+4, LTFILB)_^1_(GO TO 1000_^11_]_^11_]_^11_]_^11_]_^1C_'PARAM 4 HAS 3 DIGITS_^ ‚‚11_]_^1 860_"WKBUF(2)=ICCSAD(WKBUF(2))/10_^1_(WKBUF(1)=ICCSAD(WKBUF(1))*10+WKBUF(2)_^1_(IF(PARAM .NE. 4) GO TO 900_^1 865_"CALL CCSMVA(WKBUF, 1, 2, LTFILB, LFSTR+5, 2)_^11_]_^1C_'SET LETTER FILE POINTER TO ACCEPT NEW F DESC OR TEXT LINES._^11_]_^1_(IF(IDOLAR .EQ. 1) GO TO 890_^1_(PARAM=PARAM+1_^1_(IBYTE=0_^1 867_"CALL CCSMVA(ZEROES, 1, 4, WKBUF, 1, 4)_^1_(GO TO 1000_^11_]_^1C_'P ‚‚ARAM 4 HAS 4 DIGITS_^11_]_^1 880_"IF(WKBUF(1).GT.$3230.AND.WKBUF(2).GT.$3030) GO TO 900_^1_(WKBUF(2)=ICCSAD(WKBUF(2))_^1_(WKBUF(1)=ICCSAD(WKBUF(1))*100+WKBUF(2)_^1 885_"CALL CCSMVA(WKBUF, 1, 2, LTFILB, LFSTR+5, 2)_^1_(IF(IDOLAR .EQ. 1) GO TO 890_^1_(PARAM=PARAM+1_^1_(IBYTE=0_^1_(CALL CCSMVA(ZEROES, 1, 4, WKBUF, 1, 4)_^1_(GO TO 1000_^11_]_^1C_'POSITION POINTER FOR NEW PARAMATER OR ‚‚ TEXT LINE._^11_]_^0 890_"IF (IDOLAR .NE. 1) GO TO 895_^0_+CALL CCSMVA_!(NINE, 2, 1, LTFILB, LFSTR+3, 1)_^0C_'...IF FIELD EXCEEDS 54 CHAR/LINE, OUTPUT ERROR._^0_+IF (ISVCOL + 11 .GT. 55) GO TO 920_^1 895_"LFSTR=LFSTR+7_^1_(CALL CCSMVA(ZEROES, 1, 4, WKBUF, 1, 4)_^1_(GO TO 1120_^11_]_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^1C_'FIELD DESCRIPTION ‚‚ ERROR ROUTINES:_^1C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++_^11_]_^1C_'PARAMATER LENGTH IN ERROR._^11_]_^1 900_"CALL CCSBLK(OBUF, PRTLEN)_^1_(PARAM=PARAM+$30_^1_(CALL CCSMVA(PARAM,2,1,PAMERR,40,1)_^1_(CALL CCSMVA(PAMERR,1,42,OBUF,10,42)_^1_(PARAM=PARAM-$0030_^1_(GO TO 935_^11_]_^1C_'PARAMATER 1 ERROR._^11_]_^1 905_"CALL CCSBLK(OBUF, PRTLEN)_^1_(CAL ‚‚L CCSMVA(PARAM1,1,44,OBUF,10,44)_^1_(GO TO 935_^11_]_^1C_'ILLEGAL CHARACTER IN PARAMATER FIELD._^11_]_^1 910_"CALL CCSBLK(OBUF, PRTLEN)_^1_(CALL CCSMVA(N,2,1,PARAME,28,1)_^1_(CALL CCSMVA(PARAME,1,30,OBUF,10,30)_^1_(GO TO 935_^11_]_^1C_'PARAMATER 2 ERROR._^11_]_^1 920_"CALL CCSBLK(OBUF, PRTLEN)_^0_(CALL CCSMVA(PARAM2, 1, 44, OBUF, 10, 44)_^1_(GO TO 935_^11_]_^1C_'PARAMATER 5 ERROR ‚‚._^11_]_^1 925_"CALL CCSBLK(OBUF, PRTLEN)_^1_(CALL CCSMVA(PARAM5,1,48,OBUF,10,48)_^1_(GO TO 935_^11_]_^1C_'BLANK ERROR._^11_]_^1 930_"CALL CCSBLK(OBUF, PRTLEN)_^1_(PARAM=PARAM+$30_^1_(CALL CCSMVA(PARAM,2,1,BLNKER,39,1)_^1_(CALL CCSMVA(BLNKER,1,42,OBUF,10,42)_^1_(PARAM=PARAM-$30_^1_(GO TO 935_^11_]_^1C_'WRITE PARAMATER ERRORS._^11_]_^1 935_"IRCNT=IRCNT+1_^1_(OBUF(1)=SNGLSP_^1_(FC ‚‚OUNT=FCOUNT+1_^1_(ASSIGN 400 TO ICOMP_^1_(CALL FWRITE(PRT, OBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_(CALL DISP_^11_]_^1 1000 CONTINUE_^11_]_^11_]_^1C_'IF FIELD DESCRIPTION RECORDS LESS THEN 9 GO TO 400._^1C_'IF NO 'F' FIELD OPTION USED - GO TO 1200_^11_]_^1 1120 IF(NOF .EQ. 1) GO TO 1210_^1_$FCOUNT=FCOUNT+1_^1_$IF(FCOUNT .LE. FMAX) GO TO 400_^11_]_^11_]_^1 1140 CALL CCSBLK(OBUF,PRTLEN ‚‚)_^1_$OBUF(1)=SNGLSP_^1_$IRCNT=IRCNT+1_^1_$CALL CCSMVA(FMAXER,1,38,OBUF,10,38)_^1_$ASSIGN 1200 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^1._]_^11_]_^1C***********************************************************************_^1C_]_^1C_'READ A RECORD AND SEARCH FOR VALID TEXT LINES._^1C_]_^1C******************************************************** ‚‚***************_^11_]_^1C_'PROCESS RECORD CURRENTLY IN BUFFER_^11_]_^1 1200 SALSW=1_^1_$GO TO 1230_^11_]_^1C_'GET NEXT RECORD AND PLACE IN BUFFER_^11_]_^11_]_^1 1210 CALL CCSBLK(INBUF, 80)_^1_$SALSW=0_^1 1220 CALL GETS(REQBLD, INBUF, LDKEY, ISTAT)_^1_$IF(ISTAT .GE. 0) GO TO 1230_^1_$CALL FILERR(INBUF, 14, ISTAT, LU)_^1_$GO TO 2010_^11_]_^11_]_^1C_)CHECK FOR SYSTEM DELETE CODE_^11_] ‚‚_^1 1230 IF(INBUF(1).EQ.ISDEL) GO TO 1210_^11_]_^11_]_^1C_)CHECK FOR END RECORD_^11_]_^0 1236 TXTLIN = TXTLIN + 1_^0_$CALL CCSCST (INBUF, 1, 3, IEND, 1, 3, NCOMP)_^1_$IF(NCOMP.EQ.0) GO TO 1245_^1_$NUMSW=0_^1_$ISTAR=0_^1_$IENDSW=0_^11_]_^1C_'MOVE LINE TO ECHO PRINT BUFFER+++++++++++++++++++++++++++++++++_^11_]_^1_$CALL CCSBLK(PRTBUF, 132)_^1_$CALL CCSMVA(INBUF,1,80,PRTBUF,5,80)_^1_ ‚‚$PRTBUF(1)=SNGLSP_^1_$ASSIGN 1237 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^11_]_^11_]_^1C_)CHECK FOR LINE OVERFLOW_^11_]_^1 1237 IF(LCOUNT.GT.MXLINE) GO TO 1450_^11_]_^1C_'CHECK FOR *A, - INDICATES NO END RECORD HAS BEEN READ_^1C_'PRIOR TO START OF NEW LETTER._^11_]_^1 1240 CALL CCSCST(INBUF,1,3,ACODE,1,3,NCOMP)_^1_$IF(NCOMP.NE.0) GO TO 126 ‚‚0_^1_$OBUF(1)=SNGLSP_^1_$CALL CCSBLK(OBUF,PRTLEN)_^1_$CALL CCSMVA(INBUF,1,3,ENDERR,23,3)_^1_$CALL CCSMVA(ENDERR,1,28,OBUF,10,28)_^1_$IRCNT=IRCNT+1_^0_$ASSIGN 1241 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^0C_'...CHECK FOR LINE NO. GT MAX. LINE IN LETTER._^0 1241 IF (IMAXLN .LE. TXTLIN-1) GO TO 135_^0_+ASSIGN 135 TO IRTN_^0_+GO TO 1252_^11_]_^11 ‚‚_]_^1C_(IF END RECORD - MOVE END TO LTRFILE - GO TO PRINT ROUTINE._^11_]_^1 1245 CALL CCSMVA(INBUF,1,3,LTFILB,LFSTR,3)_^1_$CALL CCSBLK(PRTBUF,PRTLEN)_^1_$PRTBUF(1)=SNGLSP_^1_$CALL CCSMVA(INBUF,1,80,PRTBUF,5,80)_^1_$ASSIGN 1250 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^0C_'...CHECK FOR LINE NO. GT MAX. LINE IN LETTER._^0 1250 IF (IMAXLN .GT. TXTLIN ‚‚-1) GO TO 1251_^1_$LFSTR=LFSTR+3_^1_$NSWICH=NSWICH+1_^1_$IF(NSWICH.EQ.2) GO TO 1600_^1_$GO TO 1500_^0 1251 ASSIGN 130 TO IRTN_^0C_'...COMMON LOGIC FOR *A AND END FOR LINE NO. (IN F STATEMENT)_^0C_'... GT MAX. LINE IN LETTER._^0C_'...OUTPUT ERROR MSG._^0 1252 CALL CCSBLK (OBUF, PRTLEN)_^0_$CALL CCSMVA (MAXLIN, 1, 44, OBUF, 10, 44)_^0_$ASSIGN 1254 TO ICOMP_^0_$CALL FWRITE (PRT, O ‚‚BUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^0_$CALL DISP_^0C_'...FOR *A, RETURN AFTER READ OF RECORD._^0C_'...FOR END, RETURN TO READ NEXT RECORD._^0 1254 GO TO IRTN_^1._]_^11_]_^11_]_^1C_(CHECK FOR VALID CARRIAGE CONTROL RANGE OF 1-4._^1C_(**********SEARCH IS RIGHT TO LEFT***********************_^11_]_^0 1260_"DO 1420 I= 75, 1, -1_^1_(CALL CCSGET(INBUF, I, N)_^1 1265_#IF(N .EQ. BLANK) GO ‚‚ TO 1420_^0_(IF (I .GT. 57) GO TO 1440_^1_(IF(N.GE.$31.AND.N.LE.$34) GO TO 1290_^1_'IF(N .EQ. STAR) GO TO 1350_^1_(IF(N .EQ. EACH) GO TO 1380_^1_(IF(N.NE.BLANK) GO TO 1300_^11_]_^1C_'FOUND CARRIAGE CONTROL OR SALUTATION CODE_^11_]_^1 1290_"IF(NUMSW.EQ.1) GO TO 1420_^1_(L=ICCSAD(N)_^1_(ENDPOS=I_^1_(IENDSW=1_^1_(NUMSW=1_^1_(GO TO 1420_^11_]_^1C_'CHECK FOR INVALID CARRIAGE CONTROL_^1 ‚‚ 1300_"IF(ISTAR.EQ.1.AND.NUMSW.EQ.1) GO TO 1440_^1_(IF(ISTAR.EQ.1.AND.NUMSW.EQ.0) GO TO 1440_^1_(IF(ISTAR.EQ.0.AND.NUMSW.EQ.0) GO TO 1390_^1_(GO TO 1420_^11_]_^1C_(FOUND A * - SEARCH IS RIGHT TO LEFT, IF WE HAVE NOT FOUND A_^1C_'GO TO 1360 AND MOVE IN A DEFAULT VALUE OF 1._^11_]_^1 1350_"IF(NUMSW .NE. 1) GO TO 1360_^1_'GO TO 1370_^11_]_^1C_'MOVE IN DEFAULT VALUE FOR CARRIAGE CONTRO ‚‚L - NO CONTROL INDICAT_^11_]_^1 1360_"ENDPOS=I_^1_'IF(ENDPOS .EQ. 57) GO TO 1440_^1_'ENDPOS=I+1_^1_(CALL CCSMVA(LINCTL, 1, 1, INBUF, ENDPOS, 1)_^1_(L=1_^1_'NUMSW=1_^11_]_^1C_'INCREMENT ISTAR - CHECK IF ISTAR=2._^11_]_^1 1370_"ISTAR=ISTAR+1_^1_(IF(ISTAR .EQ. 2 .AND. SALSW .EQ. 0) GO TO 1425_^1_(GO TO 1420_^11_]_^1C_'FOUND CODE FOR SALUTATION LINE -@_^11_]_^1 1380_"CALL CCSGET(INBUF, ‚‚ I+1, N)_^1_$IF (N .GT. $30 .AND. N .LT. $33) GO TO 1382_^1_(GO TO 1440_^1 1382_"SALNUM=1_^1_(CALL CCSCST(INBUF, I+2, 1, STAR, 2, 1, NCOMP)_^1_(IF(NCOMP .EQ. 0) GO TO 1385_^1_(GO TO 1386_^11_]_^1 1385_"CALL CCSMVA(INBUF, I+2, 3, WKAREA, 1, 3)_^1_(CALL CCSMVA(WKAREA, 1, 3, INBUF, I+3, 3)_^1_(CALL CCSMVA(BLANK, 2, 1, INBUF, I+2, 1)_^1_(ENDPOS=ENDPOS+1_^11_]_^1C_*FOUND @ CHECK FOR COR ‚‚RECT CARRAIGE CONTROL_^11_]_^1 1386_"IF(NUMSW .EQ. 0 .AND. ISTAR .EQ. 0) GO TO 1390_^1_(IF(NUMSW .EQ. 0 .AND. ISTAR .EQ. 2) GO TO 1360_^1_(IF(ISTAR .NE. 2) GO TO 1440_^1_(GO TO 1425_^11_]_^0C_'...FOUND NO CARRIAGE CONTROL CHARACTERS._^0C_'... DEFAULT TO **1._^0 1390_"ENDPOS = I_^1_(IF(ENDPOS .GT. 54) GO TO 1440_^1_(ENDPOS=ENDPOS+1_^1_(CALL CCSMVA(CARCTL, 1, 3, INBUF, ENDPOS, 3)_^1_ ‚‚(ENDPOS=ENDPOS+2_^1_(L=1_^1_(NUMSW=1_^1_(GO TO 1425_^11_]_^1 1420 CONTINUE_^11_]_^1_$IF(ISTAR.NE.2) GO TO 1440_^11_]_^1 1425 CALL CCSMVA(INBUF, 1, ENDPOS, LTFILB, LFSTR, ENDPOS)_^1_$LCOUNT = LCOUNT + L_^1_$LFSTR=LFSTR+ENDPOS_^1_$GO TO 1210_^11_]_^1C_'TEXT ERROR ROUTINE._^11_]_^1 1440 CALL CCSBLK(OBUF,132)_^1_$CALL CCSMVA(TEXT1,1,50,OBUF,10,50)_^1_$IRCNT=IRCNT+1_^1_$ITEXTE=1_^1_$GO ‚‚TO 1460_^11_]_^11_]_^1C_'TEXT LINES EXCEED MAXIMUM ALLOWED._^11_]_^1 1450 CALL CCSBLK(OBUF,132)_^1_$CALL CCSMVA(TEXT3,1,26,OBUF,10,26)_^1_$LCOUNT=0_^1_$ITEXTE=2_^1_$IRCNT=IRCNT+1_^1_$GO TO 1460_^11_]_^1C_'PRINT TEXT ERROR_^11_]_^1 1460 ASSIGN 1210 TO ICOMP_^1_$CALL FWRITE(PRT,OBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^1._]_^11_]_^1C*********************************************** ‚‚************************_^1C_]_^1C_'WRITE RECORD TO LETTER FILE_^1C_]_^1C***********************************************************************_^11_]_^1 1500 IF(LTRCNT.GE.50) GO TO 1570_^1_$IF(IRCNT.NE.0) GO TO 130_^1_$CALL WRITER(REQBLF,LTFILB,SAVKEY,ISTAT)_^1_$IF(AND(ISTAT,$8010).EQ.$8010) GO TO 1520_^1_$IF(ISTAT .GE. 0) GO TO 1550_^1_$CALL FILERR(IDATLF,12,ISTAT,LU)_^1_$GO TO 2 ‚‚010_^11_]_^1C_#DUPLICATE KEY ERROR_^11_]_^1 1520 CALL CCSBLK(OBUF,132)_^1_$OBUF(1)=SNGLSP_^1_$CALL CCSMVA(SAVKEY,1,2,DUPKEY,31,2)_^1_$CALL CCSMVA(DUPKEY,1,48,OBUF,10,48)_^1_$ASSIGN 130 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1C_'SUCCESFUL WRITE TO FILE / INCREMENT LETTER COUNT._^11_]_^1 1550 LTRCNT=LTRCNT+1_^11_]_^1 1553 CALL CCSBLK(PRT ‚‚BUF, PRTLEN)_^1_$CALL CCSMVA(TOPPAG, 1, 2, PRTBUF, 1, 2)_^1_$CALL CCSMVA(HDR,1,40,PRTBUF,5,40)_^1_$ASSIGN 1554 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^1 1554 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(SNGLSP, 1, 2, PRTBUF, 1, 2)_^1_$CALL CCSMVA(HDR,41,40,PRTBUF,5,40)_^1_$CALL CCSMVA(HD2A, 1, 30, PRTBUF, 51, 30)_^1_$CALL CCSMVA(HD2B, 1, 4, PRTB ‚‚UF, 121, 4)_^11_]_^1C_'CONVERT PAGE NUMBER_^1_$PAGCNT=PAGCNT+1_^1_$A1=PAGCNT/$3E8_^1_$RE=PAGCNT-(A1*$3E8)_^1_$A2=RE/$64_^1_$RE=RE-(A2*$64)_^1_$A3=RE/$A_^1_$RE=RE-(A3*$A)_^1_$A4=RE_^11_]_^1C_'MOVE PAGE COUNT TO PRINT_^11_]_^1 1555 PAGOUT(2)=((A3+$30)*$100)+(A4+$30)_^1_$PAGOUT(1)=((A1+$30)*$100)+(A2+$30)_^11_]_^1C_'EDIT PAGE COUNT_^11_]_^1_$DO 1556 IN=1,3_^1_$CALL CCSCST(PAGOUT,IN,1, ‚‚ZERO,1,1,NCOMP)_^1_$IF(NCOMP.NE.0) GO TO 1557_^1_$CALL CCSMVA(BLANK,2,1,PAGOUT,IN,1)_^1 1556 CONTINUE_^1 1557 CALL CCSMVA(PAGOUT,1,4,PRTBUF,126,4)_^1_$ASSIGN 1558 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^1 1558 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(SNGLSP, 1, 2, PRTBUF, 1, 2)_^1_$CALL CCSMVA(HDR,81,40,PRTBUF,5,40)_^1_$CALL CCSMVA(HD3A, ‚‚ 1, 6, PRTBUF, 51, 6)_^1_$CALL LTRDTE(DT,PRTBUF, 60, 1)_^1_$ASSIGN 1559 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^1 1559 CONTINUE_^11_]_^1C_'PLACE LETTER NUMBER IN UTILITY RECORD LTR1 OR LTR2_^11_]_^1_$IF (LTRCNT .GT. 25) GO TO 1560_^1_$CALL CCSMVA(SAVKEY, 1, 2, LTREC1, ILTR1, 2)_^1_$ILTR1=ILTR1+2_^1_$GO TO 1565_^11_]_^1C_'PRINT LETTER CURRE ‚‚NTLY IN BUFFER_^11_]_^11_]_^1C_'PLACE LETTER NUMBER IN UTILITY RECORD LTR2_^11_]_^1 1560 CALL CCSMVA(SAVKEY, 1, 2, LTREC2, ILTR2, 2)_^1_$ILTR2=ILTR2+2_^11_]_^1C_'PRINT THE LETTER CURRENTLY IN LTFILB BUFFER_^11_]_^1 1565 IF(IRCNT.GT.0) GO TO 130_^1_$CALL LTPRNT(DT,LTFILB)_^1_$GO TO 130_^11_]_^1C_'NUMBER OF LETTERS EXCEED CURRENT MAXIMUM - PRINT ERROR MSG_^11_]_^1 1570 CALL CCSBLK(OB ‚‚UF, PRTLEN)_^1_$OBUF(1)=SNGLSP_^1_$CALL CCSMVA(TEXT2,1,28,OBUF,10,28)_^1_$ASSIGN 1600 TO ICOMP_^1_$CALL FWRITE(PRT,OBUF,132,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^1C***********************************************************************_^1C_]_^1C_'CLOSE FILE ROUTINES_^1C_]_^1C***********************************************************************_^11_]_^1C_'COMPLETE UTILITY RECORD ‚‚S LTR1 AND LTR2_^11_]_^1 1600 CONTINUE_^11_]_^1C_'MOVE TWO ASKTERISKS TO THE END OF LTR1 AND LTR2 RECORD_^11_]_^1 1650 CALL CCSMVA(STAR2,1,2,LTREC1,ILTR1,2)_^1_$CALL CCSMVA(STAR2,1,2,LTREC2,ILTR2,2)_^11_]_^1C_'GET LTR1 RECORD FROM UTILITY FILE._^11_]_^1 1675 CALL READR(REQBUT, LRCBF1, LKEY1, ISTAT)_^1_$IF(AND(ISTAT,$200).EQ.$200) GO TO 1850_^1_$IF(AND(ISTAT,$100).EQ.$200) GO TO 185 ‚‚0_^1 1677 IF(ISTAT .GE. 0) GO TO 1680_^1_$CALL FILERR(LRCBF1, 13, ISTAT, LU)_^1_$GO TO 2010_^11_]_^1C_'MOVE UPDATE INFO TO LTR1 BUFFER FILE_^11_]_^1 1680 CALL CCSMVA(LKEY1, 1, 4, LTREC1, 1, 4)_^1_$CALL CCSMVA(LTREC1,1,80,LRCBF1,1,80)_^11_]_^11_]_^1C_'REWRITE LTR1 TO UTILITY FILE_^11_]_^1 1700 CALL UPDREC(REQBUT, LRCBF1, ISTAT)_^1_$IF(ISTAT .GE. 0) GO TO 1750_^1_$CALL FILERR(LRCBF1, ‚‚ 15, ISTAT, LU)_^1_$GO TO 2010_^11_]_^1C_'MOVE LTR1 TO ECHO PRINT AND PRINT AFTER ADVANCING_^1C_'TO TOP OF PAGE.++++++++++++++++++++++++++++++++++++++++++++++++_^11_]_^1 1750 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(TOPPAG,1,2,PRTBUF,1,2)_^1_$CALL CCSMVA(LTREC1,1,60,PRTBUF,5,60)_^1_$ASSIGN 1800 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^1C_ ‚‚'GET RECORD FROM UTILITY FILE_^1 1800 CALL READR(REQBUT, LRCBF2, LKEY2, ISTAT)_^1_$IF(AND(ISTAT,$200).EQ.$200) GO TO 1860_^1_$IF(AND(ISTAT,$100).EQ.$100) GO TO 1860_^1_$IF(ISTAT .GE. 0) GO TO 1820_^1_$CALL FILERR(LRCBF2, 15, LKEY2, ISTAT)_^1_$GO TO 2010_^11_]_^1C_'MOVE INFO TO UTIL BUF_^11_]_^1 1820 CALL CCSMVA(LKEY2, 1, 4, LTREC2, 1, 4)_^1_$CALL CCSMVA(LTREC2,1,80,LRCBF2,1,80)_^11 ‚‚_]_^1C_'REWRITE LTR2 TO UTILITY FILE_^1 1830 CALL UPDREC(REQBUT, LRCBF2, ISTAT)_^1_$IF(ISTAT .GE. 0) GO TO 1840_^1_$CALL FILERR(LRCBF2, 15, ISTAT, LU)_^1_$GO TO 2010_^11_]_^1C_'MOVE IN INFOR_^11_]_^1 1840 CALL CCSBLK(PRTBUF,PRTLEN)_^1_$CALL CCSMVA(DBLSPA,1,2,PRTBUF,1,2)_^1_$CALL CCSMVA(LTREC2,1,60,PRTBUF,5,60)_^1_$ASSIGN 2010 TO ICOMP_^1_$CALL FWRITE(PRT,PRTBUF,PRTLEN,ICOMP,IFLAG,I ‚‚TEMP)_^1_$CALL DISP_^11_]_^1C_)LTR1 OR LTR2 WAS NOT FOUND PRINT MESSAGE_^11_]_^1 1850 CALL CCSBLK(OBUF,PRTLEN)_^1_$CALL CCSMVA(TOPPAG,1,2,OBUF,1,2)_^1_$CALL CCSMVA(LKEY1,4,1,UTFERR,21,1)_^1_$I=1_]_^1_$GO TO 1870_^1 1860 CALL CCSBLK(OBUF,PRTLEN)_^1_$CALL CCSMVA(DBLSPA,1,2,OBUF,1,2)_^1_$CALL CCSMVA(LKEY2,4,1,UTFERR,21,1)_^1_$I=2_]_^1 1870 CALL CCSMVA(UTFERR,1,38,OBUF,10,38)_^1_$IF(I. ‚‚EQ.1) ASSIGN 1800 TO ICOMP_^1_$IF(I.EQ.2) ASSIGN 2010 TO ICOMP_^1_$CALL FWRITE(PRT,OBUF,PRTLEN,ICOMP,IFLAG,ITEMP)_^1_$CALL DISP_^11_]_^1C_'CLOSE FILES_^11_]_^1 2010 CALL CLOSFL(REQBLD,ISTAT)_^1_$CALL CLOSFL(REQBLF, ISTAT)_^1_$CALL CLOSFL(REQBUT, ISTAT)_^11_]_^1 2020 CALL PGMOUT_^1_$END_]_^__ ‚‚LLTPRT CSY/ F45 0010 ‚‚1_$PROGRAM LLTPRT_^1_#1_2/F45 F LA_!CCS 3.0_5SL-149_^11_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_'THIS PROGRAM IS DESIGNED TO PRINT REQUESTED LETTERS_^1C_'THAT WERE REQUESTED BY COLLECTORS DURING THE COLLECTION_^1C_'ACTIVITIES._^1C_]_^1C_'FILES, IO BUFFERS, AND ‚‚FILE MANAGER********************_^11_]_^1_$INTEGER BUF(6),CFBUF(181),DATBUF(13),DMBUF(1000),EBUF(66)_^1_$DATA BUF/6*$2020/,DATBUF/13*$2020/,EBUF/66*$2020/_^11_]_^1_$INTEGER FARRAY(27),FULNAM(25),IOBUF(41),PBUF(20)_^1_$DATA FARRAY/27*0/,FULNAM/25*$2020/,IOBUF/41*$2020/_^1_$DATA PBUF/$000C,$0D0A,$0D0A,17*$2020/_^11_]_^1_$INTEGER LASNAM(15),LTFILB(756),LTRFBF(40),OBUF(66)_^1_$DATA LAS ‚‚NAM/15*$2020/,LTFILB/756*$2020/,LTRFBF/40*$2020/_^11_]_^1_$INTEGER UTBUF(40),LTRARR(760)_^1_$DATA UTBUF/40*0/,LTRARR/760*$2020/_^11_]_^1_$INTEGER REQBCF(24),REQBDM(24),REQBLF(24),REQBTF(24),REQBUT(24)_^1_$DATA REQBCF/24*0/,REQBDM/24*0/,REQBLF/24*0/,REQBTF/24*0/_^1_$DATA REQBUT/24*0/_^11_]_^1_$INTEGER SALARA(33),TFBUF(69)_^1_$DATA SALARA/33*$2020/,TFBUF/69*$2020/_^11_]_^1C_'COSIGNOR ‚‚ FILE*******************_^11_]_^1_$INTEGER IDATCF(15)_^1_$DATA IDATCF/'LACOSIGN' , 8*$2020, 1, 1, 0/_^11_]_^1C_'DELIQUENT MASTER FILE***************_^11_]_^1_$INTEGER IDATDM(15)_^1_$DATA IDATDM/'LADLQMST', 8*$2020, 1, 1, 0/_^11_]_^1C_'LETTER FILE_^11_]_^1_$INTEGER IDATLF(15)_^1_$DATA IDATLF/'LALTRFIL', 8*$2020, 1, 1, 0/_^11_]_^1C_'TRANSACTION FILE_^11_]_^1_$INTEGER IDATTF(15)_^1_$ ‚‚DATA IDATTF/'LATRNSFL', 8*$2020, 0, 1, 0/_^11_]_^1C_'UTILITY FILE_^11_]_^1_$INTEGER IDATUT(15)_^1_$DATA IDATUT/'LAUTIFIL', 8*$2020, 1, 1, 0/_^11_]_^1C_'CONSTANTS*****************_^11_]_^1_$INTEGER A,ADAYTO,AMONTO,ASTRSK,AT,AYERTO,B,CLRLEN_^1_$DATA A/$0041/,ASTRSK/$002A/,AT/$0040/,B/$0042/,CLRLEN/1/_^11_]_^1_$INTEGER BLANK(10),COMMA,LENGTH,COID,CC_^1_$DATA BLANK/10*$2020/,COMMA/$2C2 ‚‚C/,LENGTH/0/,COID/0/,CC/2/_^11_]_^1_$INTEGER CLRSCR,COLON,DATLIN,FIRLEN,FULLEN_^1_$DATA CLRSCR/$1800/,COLON/$3A3A/,DATLIN/3/_^11_]_^1_$INTEGER D,DBLSPA,DOL,DT(3),EOF,EXT(2),FEQ,H,ID(4)_^1_$DATA D/$0044/,DBLSPA/$0D0A/,DOL/$0024/,DT/3*0/,EOF/$100/,H/$2048/_^1_$DATA FEQ/$463D/,EXT/'EXT'/_^11_]_^1_$INTEGER IEND(2),IBLANK,MARGIN,MAXLEN,NO,PERIOD,PRTLEN,PUN_^1_$DATA IEND/'END'/,MARGIN/13 ‚‚/,MAXLEN/57/,PERIOD/$2E/,PRTLEN/132/_^1_$DATA IBLANK/$2020/,NO/$4E20/_^11_]_^1_$INTEGER RECTYP,ONE,TWO,JBLANK,START_^1_$DATA RECTYP/$3031/,ONE/$0031/,TWO/$0032/,JBLANK/0/_^11_]_^1_$INTEGER SNGLSP,TOPOPG,WRONKY,XYN,ZERO_^1_$DATA SNGLSP/$000A/,TOPOPG/$000C/,WRONKY/$200/,XYN/-1/,ZERO/0/_^11_]_^1_$INTEGER YES,ZEROE_^1_$DATA YES/$5920/,ZEROE/$3030/_^11_]_^1C_'KEYS, VAIRABLES, MISC****** ‚‚********_^11_]_^1_$INTEGER COL,COLCPO_^1_$DATA COL/0/,COLCPO/0/_^11_]_^1_$INTEGER FCOUNT,FSWICH,IARAPT_^1_$DATA FSWICH/0/,FCOUNT/0/,IARAPT/0/_^11_]_^1_$INTEGER ICOL,IFLAG,IPOINT,IPOS_^1_$DATA ICOL/0/,IFLAG/0/,IPOINT/0/,IPOS/0/_^11_]_^1_$INTEGER IPT,ITC,ITEMP(8),LCOUNT,LTLPT_^1_$DATA IPT/0/,ITC/0/,ITEMP/8*0/,LCOUNT/0/,LTLPT/0/_^11_]_^11_]_^1_$INTEGER MNAM(15),MADR1(15),MADR2(15),MCS ‚‚(10),MZP(3),MBNM(15)_^1_$INTEGER MSLCD,LTBUPT,LTRF(2)_^1_$DATA MSLCD/0/,LTBUPT/0/,LTRF/'LTRF'/_^11_]_^1_$INTEGER NOF,NUMCLC_^1_$DATA NOF/0/,NUMCLC/0/_^11_]_^1_$INTEGER POS,PRT,SALC(2),SALLEN_^1_$DATA POS/0/,PRT/9/,SALC/'SALC'/,SALLEN/0/_^11_]_^1_$INTEGER TCIDWK(2),TCIDCK(2),TCIDKY(2)_^11_]_^1_$INTEGER TACTKY(8),TACTWK(9)_^11_]_^1_$INTEGER TCIDSC,TFKEY(8),TLACKY_^1_$DATA TCIDSC/0/,T ‚‚LACKY/0/_^11_]_^1_$INTEGER TLRKY,TLRPNT,TLRWKY,TYPE_^1_$DATA TLRKY/0/,TLRPNT/0/,TLRWKY/0/,TYPE/0/_^11_]_^1C_'MESSAGE BUFFERS************MESSAGE BUFFERS_^11_]_^1_$INTEGER ACCTNO(10)_^1_$DATA ACCTNO/$D0A,'1234567890123456',$D0A/_^11_]_^1_$INTEGER MSG2(40)_^1_$DATA MSG2/_^1_#1$D0A,'DO YOU WISH TO PRINT ALL OF THE LETTER',_^1_#2_!'S REQUESTED BY THE COLLECTORS? Y OR N ',$D0A/_^11_]_^1_ ‚‚$INTEGER MSG3(33)_^1_$DATA MSG3/$D0A,'PLEASE REENTER ACCOUNT NUMBER - THERE ARE LESS THE_^1_#1N 16 DIGITS',$D0A/_^11_]_^1_$INTEGER MSG4(30)_^1_$DATA MSG4/'LINE THE * TO THE TOP OF PAGE AND SEVENTH CHARACTER POS_^1_#1ITION'/_^11_]_^1_$INTEGER MSG4A(40)_^1_$DATA MSG4A/_^1_#1$D0A,'DO YOU WISH TO HAVE ANOTHER ALIGNMENT ',_^1_#2_!'LINE PRINTED? ENTER Y OR N_*',$D0A/_^11_]_^11_]_^1_$INT ‚‚EGER MSG6(40)_^1_$DATA MSG6/_^1_#1$A0D,'ENTER ACCOUNT NUMBER OF THE NEXT LETTE',_^1_#2_!'R TO BE PRINTED - (16 DIGITS MAX)._!',$0A0D/_^11_]_^1_$INTEGER MSG7(33)_^1_$DATA MSG7/$A0D,'UNABLE TO LOCATE ACCOUNT_1',_^1_#1_.'IN THE LADLQMST FILE '/_^11_]_^1_$INTEGER MSG5(33)_^1_$DATA MSG5/$A0D,'UNABLE TO LOCATE ACCOUNT_1',_^1_#1_.' IN THE LATRNSFL FILE '/_^11_]_^1_$INTEGER MSG8(15)_^1_$ ‚‚DATA MSG8/$A0D,'ERROR ON REOPEN OF LATRNSFL '/_^11_]_^1_$INTEGER MSG9(40)_^1_$DATA MSG9/_^1_#1$A0D,'UNABLE TO LOCATE COLLECTOR_$IN LAU',_^1_#2_!'TIFIL_B'/_^11_]_^1_$INTEGER MSG9A(40)_^1_$DATA MSG9A/_^1_#1$A0D,'LETTER TO BE SENT TO ACCOUNT NUMBER XX',_^1_#2_!'XXXXXXXXXXXXXX HAS NOT BEEN PRINTED_#'/_^11_]_^1_$INTEGER MSG10(40)_^1_$DATA MSG10/_^1_#1$A0D,'UNABLE TO LOCATE LETTER NUMBER ‚‚_'',_^1_#2_!'TO BE SENT TO ACCT#_1.',$0A0D/_^11_]_^1_$INTEGER MSG11(40)_^1_$DATA MSG11/_^1_#1$A0D,'* THE REQUESTED LETTERS HAVE BEEN PRIN',_^1_#2_!'TED._A',$0A0D/_^11_]_^11_]_^1_$INTEGER MSG12(40)_^1_$DATA MSG12/_^1_#1$A0D,'UNABLE TO LOCATE ACCOUNT XXXXXXXXXXXXX',_^1_#2_!'XXX IN THE LACOSIGN FILE_/'/_^11_]_^1_$INTEGER MSG13(23)_^1_$DATA MSG13/$C,'UNABLE TO LOCATE LTRF RECORD IN THE ‚‚ LAUTIFIL'/_^11_]_^1_$INTEGER MSG14(23)_^1_$DATA MSG14/$C,'UNABLE TO LOCATE SALC RECORD IN THE LAUTIFIL'/_^11_]_^1_$INTEGER REFLIN(2),COF(2)_^1_$DATA REFLIN/'RE: '/,COF/$432F,$4F20/_^11_]_^11_]_^1C_'EXTERNALS**************************_^11_]_^1_%EXTERNAL AMONTO,AYERTO,ADAYTO_^11_]_^1._]_^1C***********************************************************************_^1C_]_^1C_7START OF PR ‚‚OGRAM_^1C_]_^1C***********************************************************************_^1C_'ITOS_^11_]_^1_!10 CALL PGMIN (ID, LU, MODE, NOPORT)_^11_]_^1C_'IF NOT A MASTER TERMINAL EXIT FROM PROGRAM_^11_]_^1C 30 IF(NOPORT .NE. 0) GO TO 7000_^11_]_^1C_'BRING IN SYSTEM DATE_^11_]_^1_!40 DT(1)=AND($FFFF,AMONTO)_^1_$DT(2)=AND($FFFF,ADAYTO)_^1_$DT(3)=AND($FFFF,AYERTO)_^11_]_^1C_'OPEN LE ‚‚TTER FILE (LTRFIL)_^11_]_^1_!50 CALL OPENFL(REQBLF,IDATLF,ISTAT)_^1_$IF(ISTAT .GE. 0) GO TO 70_^1_$CALL FILERR(IDATLF, 3, ISTAT, LU)_^1_$GO TO 7000_^11_]_^1C_'OPEN TRANSACTION FILE (TRNSFL)_^11_]_^1_!70 CALL OPENFL(REQBTF,IDATTF,ISTAT)_^1_$IF(ISTAT .GE. 0) GO TO 80_^1_$CALL FILERR(IDATTF, 3, ISTAT, LU)_^1_$GO TO 7000_^11_]_^1C_'OPEN DELINQUENT MASTER FILE (LADLQMST) -OVERRIDE LOCKE ‚‚D RECORDS_^11_]_^1_!80 CALL OPENFL(REQBDM,IDATDM,ISTAT)_^1_$REQBDM(23)=1_^1_$IF(ISTAT .GE. 0) GO TO 90_^1_$CALL FILERR(IDATDM, 3, ISTAT, LU)_^1_$GO TO 7000_^11_]_^1C_'OPEN COSIGNER FILE - OVERRIDE LOCKED RECORDS_^11_]_^1_!90 CALL OPENFL(REQBCF, IDATCF, ISTAT)_^1_$REQBCF(23)=1_^1_$IF(ISTAT .GE. 0) GO TO 110_^1_$CALL FILERR(IDATCF, 3, ISTAT, LU)_^1_$GO TO 7000_^11_]_^1C_'OPEN UTILITY ‚‚ FILE (UTIFIL)_^11_]_^1 110 CALL OPENFL(REQBUT,IDATUT,ISTAT)_^1_$IF(ISTAT .GE. 0) GO TO 120_^1_$CALL FILERR(IDATUT, 3, ISTAT, LU)_^1_$GO TO 7000_^11_]_^1C_'INITIALIZE COUNTERS AND POINTERS_^11_]_^1 120 COLCPO=0_^1_$NUMCLC=0_^1_$LTLPT=0_^1_$TLRPNT=0_^1_$LTBUPT=0_^11_]_^1C_'CLEAR SCREEN_^11_]_^1 200 CALL WTREAD(LU,XYN,CLRSCR,CLRLEN,0,0,0,ITC)_^11_]_^1C_'PROMPT OPERATOR TO ALIGN PA ‚‚PER IN PRINTER_^11_]_^1 230 CALL WTREAD(LU,XYN,CLRSCR,CLRLEN,0,0,0,ITC)_^1_$CALL CCSBLK(OBUF,132)_^1_$CALL CCSMVA(TOPOPG, 1, 2, OBUF, 1, 2)_^1C_'PUT * IN 7TH POSITION, REQUIRES DISPLACEMENT OF 9_^1_$CALL CCSMVA (ASTRSK, 2, 1, OBUF, 9, 1)_^1_$CALL CCSMVA(MSG4, 1, 60, OBUF, 12, 60)_^1_$ASSIGN 240 TO ICOMP_^1_$CALL FWRITE(PRT, OBUF, PRTLEN, ICOMP, IFLAG, ITEMP)_^1_$CALL DISP_^11_]_^1 ‚‚ 240 IOBUF=BLANK_^1_$CALL WTREAD(LU,XYN,MSG4A,80,XYN,IOBUF,1,ITC)_^1_$IF(IOBUF(1) .EQ. YES) GO TO 230_^1_$IF(IOBUF(1) .EQ. NO) GO TO 300_^1_$GO TO 240_^11_]_^1_]_^1._]_^1C***********************************************************************_^1C_]_^1C_'READ UTILITY FILE TO_^1C_'GET SALUTATION CODES FROM UTILITY FILE_^1C_]_^1C******************************************************* ‚‚****************_^11_]_^1 300 CALL READR(REQBUT, UTBUF, SALC, ISTAT)_^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 320_^1_$IF(AND(ISTAT,EOF).EQ.EOF) GO TO 320_^1_$IF(ISTAT .GE. 0) GO TO 330_^1_$CALL FILERR(IDATUT,13, ISTAT, LU)_^1_$GO TO 6000_^11_]_^1 320 CALL CCSBLK(EBUF,132)_^1_$CALL CCSMVA(MSG14,1,46,EBUF,1,46)_^1_$GO TO 360_^11_]_^1C_'LOAD SALUTATION CODES ARRAY_^11_]_^1 330 CAL ‚‚L CCSMVA(UTBUF, 5, 65, SALARA, 1, 65)_^11_]_^1C_CHECK TYPE OF DATE TO PRINT_^0 1682 IF(LENGTH.EQ.2.OR.LENGTH.EQ.1) GO TO 1685_^1_$IF(IDATVR(DMBUF,POS).LT.0) GO TO 1710_^1_$CALL EDIT(DMBUF,POS,LTRARR,LB,1)_^1_$GO TO 1710_^1 1685 CALL CCSMVA(DMBUF,POS,6,BUF,1,6)_^1_$IF(IDATVR(BUF,1).LT.0) GO TO 1710_^0C_;DATE TYPE EQUAL 1 OR 2_^0_$CALL CCSBLK(DATBUF,18)_^0_$CALL LTRDT ‚‚E(BUF,DATBUF,1,LENGTH)_^0_$IF(LENGTH.EQ.1) CALL CCSMVA(DATBUF,1,18,LTRARR,LB,18)_^0_$IF(LENGTH.EQ.2) CALL CCSMVA(DATBUF,1,12,LTRARR,LB,12)_^1_$GO TO 1710_^11_]_^1C_',_^1_#2 '_G',_^1_#3 '_G',_^1_#4 '_%',$0A0D/_^1_$DATA HDL6/$0A0D,_^1_#1 '_#COID_>',_^1_#2 '_G',_^1_#3 '_G',_^1_#4 '_%',$0A0D/_^1_$DATA HDL7/$0A0D,'_!TOTALS ',60*$2020/_^1_$DATA HDL8/$0A0D,' LTR1 RECORD NOT FOUND ',53*$2020/_^11_]_^1_$EQUIVALENCE (PRT(1,1),HDL1(1))_^1_$EQUIVALENCE (PRT(1,2),HDL2(1))_^1_$EQUIVALENCE (PRT(1,3),HDL3(1))_^1_$EQ ‚‚UIVALENCE (PRT(1,4),HDL4(1))_^1_$EQUIVALENCE (PRT(1,5),HDL5(1))_^1_$EQUIVALENCE (PRT(1,6),HDL6(1))_^1._]_^1 100 CALL PGMIN(IDUSER,LUNIT,MODE,NOPORT)_^1C_#IF(NOPORT.NE.0) GO TO 990_^11_]_^1C_SUBTRACT FROM CHAR COUNT FOR (CR) TEST_^1_$OPHLD=OPHLD-KL_^1_$GO TO 410_^1C_C--GO TO NEXT MSG 1000_^1C_>A--ABORT_^1 490 CALL PGSEDT(IR,OPBUF)_^1_$IF (IR.EQ.2) ASSIGN 1000 TO RADDR_^1_$IF (IR.EQ.3) ASSIGN 1900 TO RADDR_^1_$IF (IR.NE.0) GO TO RADDR_^1_$GO TO 408_^1C_]_^1C_]_^1C****_#GET RECORD SELECTIONS FROM OPERATOR_^1C_2DISPLAY QUESTION/ACCEPT ANSWER_^1C_]_^1 500 CALL CCSBLK (OPBUF,32)_^1_$CALL WTREAD(LU,XYN,MSG5,LNG5,XYN,OPBUF,30,TC)_^1_ ‚‚$L=0_]_^1_$NSLCT=0_^1C_2CHECK RESPONSE FOR ALL OR (CR)_^1C_]_^1C_;(CR), CONTINUE_^1_$IF(OPBUF(16).LE.0)_!GO TO 505_^1C_;INVALID--WRITE MSG AGAIN_^1_$IF (OPBUF(1).NE.$414C) GO TO 500_^1C_;ALL, GO TO NEXT MSG_^1_$Q5SLCT(1)=OPBUF(1)_^1_$GO TO 1000_^1C_]_^1C_2CLEAR Q5SLCT PARAMETER HOLD AREA_^1 505 CALL CCSBLK(Q5SLCT,340)_^1C_2INITIALIZE_^1_$ASSIGN 500 TO RADDR_^1_$IR=0_]_^1C_LENGTH,TYPE,EDIT CODE_^1_$D1LNG(1)=TBLREC(6)_^1_$D1LNG(2)=TBLREC(7)_^1_$D1TYPE=TBLREC(8)_^1C_LESS--ERROR_^1_$IF (IHOLD0.LT.IHOLD1) GO TO 555_^1_$IV1=IV1+1_^1_$IV2=IV2+1_^1 554 CONTINUE_^1C_CODES 1,2,A,B,J,K HAVE COMMAS_^1C_># OF COMMAS =(LENGTH-# DEC POS-1)/3_^1_$NCOMMA=(ICHARS-BIN-1)/3_^1C_>CODES A,B,C,D HAVE 2 POS CR SIGN_^1C_>CODES J,K,L,M HAVE 1 POS - SIGN_^1_$IF (ICODE.EQ.$0031.OR.ICODE.EQ.$0032) M=M+NCOMMA_^1_$IF (ICODE.EQ.$0041.OR.ICODE.EQ.$0042) M=M+NCOMMA+2_^1_$IF (ICODE.EQ.$0043.OR.ICODE.EQ.$0044) M=M+2_^1_$IF (ICODE.EQ.$004A.O ‚‚R.ICODE.EQ.$004B) M=M+NCOMMA+1_^1_$IF (ICODE.EQ.$004C.OR.ICODE.EQ.$004D) M=M+1_^1C_NAME,LENGTH,DECIMAL POSITIONS_^1C_SUBTRACT FROM CHAR COUNT FOR (CR) TEST_^1_$OPHLD=OPHLD-KL_^1C_8ADD # CHARS THIS FLD TO # CHARS_^1C_8THIS LINE_^1_$MCHARS=MCHARS+M_^1_$GO TO 610_^1C_REPEAT C OR A, OTHERWISE INVALID_^1_$CALL PGSEDT(IR,OPBUF)_^1_$IF (IR.EQ.2) ASSIGN 1000 TO RADDR_^1_$IF (IR.EQ.3) ASSIGN 1900 TO RADDR_^1_$IF (IR.NE ‚‚.0) GO TO RADDR_^1C_LENGTH+SPACES_^1C_ELSE RIGHT JUSTIFY COL HEADING_^1_$IF (AND(Q6EPOS(IPW1+2),$FF00).NE.$4100) GO TO 3948_^1C_2TYPE A--CHECK LENGTH OF DATA, IF LE 6 NOT NECESSARY_^1_$CALL ASCBIN(Q6EPOS(IPW1+4),IDIF)_^1_$IF (IDIF.LE.6) GO TO 3948_^1C_2LEFT JUSTIFY - RECALCULATE ‚‚ POSITION_^1_$IDIF=IDIF-6_^1_$IDIF=BIN-IDIF_^1_$CALL BINASC(IDIF,IHOLD2)_^1_$GO TO 3949_^1 3948 CALL BINASC(BIN,IHOLD2)_^1 3949 CALL CCSMVA(IHOLD2,1,4,LRPGWK,40,4)_^1_$IDIF=0_^1_$IF (Q6EPOS(IPW1).EQ.Q6EPOS(IPW1+1)) GO TO 3950_^1_$ICODE=AND(Q6EPOS(IPW1+2),$00FF)_^1_$IF (ICODE.GE.$004A.AND.ICODE.LE.$004D) IDIF=1_^1_$IF (ICODE.GE.$0041.AND.ICODE.LE.$0044) IDIF=2_^1 3950 CONTINUE_^1_$B ‚‚IN=BIN+IDIF+1_^1_$LRPGWK(23)=$2720_^1_$LRPGWK(26)=$2027_^1_$CALL CCSMVA(Q6NAME,IPW1,6,LRPGWK,46,6)_^1_$IPW1=IPW1+6_^1_$GO TO 3000_^1 3960 CONTINUE_^1C_ '/_^1_$DATA ASCNIN/5*$3939/,ASCZER/8*$3030/,ASTRSK/$2A20/,BLANK/$2020/_^1_$DATA FLAG/0/,LIN ‚‚LEN/132/,LP/9/,ONE/1/_^1_$DATA TWO/2/,THREE/3/,FOUR/4/,SIX/6/_^1_$DATA TOP/$C00/,ZERO/0/_^1C_#94 IS THE LAST HALF OF THE COSIGNER SCREEN-SKIP HEADING_^1_$IF(SDEF(1).EQ.94) GO TO 50_^12_]_^1C_!* HEADING ROUTINE_"*_^1C_#BLANK PRINT LINE_^1_$CALL CCSBLK(PRTLNE,LINLEN)_^1C_#SET TOP OF PAGE_^1_$PRTLNE(1) = TOP_^1_$ASSIGN 15 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$ ‚‚CALL DISP_^1_!15 PRTLNE(1) = BLANK_^1_$CALL CCSGET(DBLSP,ONE,NDLSP)_^1C_#SPACE PAPER DOWN_^1_$IF(NDLSP.EQ.$59) GO TO 22_^1_$IDWN = 11_^1_$DO 20 L=1,IDWN_^1_$ASSIGN 20 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1_!20 CONTINUE_^1C_#PRINT TOP ASTERISKS LINE_^1_!22 DO 25 L=12,56_^1_$PRTLNE(L) = $2A20_^1_!25 CONTINUE_^1_$ASSIGN 30 TO IGOTO_^1_$CALL FWRITE( ‚‚LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1C_#READY PRINT LINE WITH ASTERISKS_^1_!30 CALL CCSBLK(PRTLNE,LINLEN)_^1_$PRTLNE(12) = ASTRSK_^1_$PRTLNE(56) = ASTRSK_^1C_#PRINT ASTERISK LINES TO SPACE PAPER FOR REPORT_^1_$DO 40 I=1,2_^1_$ASSIGN 40 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1_!40 CONTINUE_^1_$CALL CCSBLK(WRKTBL,1920)_^1C_#INITIALIZE I ‚‚NDEX PAST SCREEN NUMBER_^1_!50 K = 2_^1_$GO TO 80_^1C_!*_]_^1C_#RETURN HERE FOR NEXT SCREEN DEFINITION_^1C_!*_]_^1_!70 K = SDEF(K+1)_^1_$IF(K.NE.0) GO TO 80_^1C_#NUMBERS 04 AND 94 ARE THE TWO PARTS OF THE COSIGNER SCREEN_^1_$IF(SDEF(1).EQ.04) GO TO 710_^1C_#END OF THIS SCREEN - GO FINISH PRINTING PAGE_^1_$GO TO 650_^1C_#CALCULATE LINE AND COLUMN NUMBERS TO BE USED IN POSITIONING IN ‚‚ THE_^1C_#PRINT ARRAY_^1C_]_^1C_#I = LINE_^1C_#J = COLUMN_^1C_]_^1_!80 I = AND($00FF,SDEF(K))+1_^1_$J = AND(SDEF(K),$FF00) / $100 + 1_^1_$M = (I-1) * 80 + J_^1_$LENGTH = SDEF(K+2)_^1_$STRPOS = SDEF(K+3)_^1C_#SCREENS 08, 09, AND 67 HAVE NO MASTER RECORD ASSOCIATED WITH THEM_^1C_#AND REQUIRE SPECIAL HANDLING_^1_$IF(SDEF(1).EQ.67) GO TO 350_^1_$IF(SDEF(1).EQ.08.OR.SDEF(1).EQ.09) GO TO ‚‚ 100_^1_$GO TO 200_^1 100 L=SDEF(K+4)_^1_$IF(L.EQ.0) GO TO 500_^1_$GO TO 350_^1C_#MOVE DATA TO PRINT LINE ACCORDING TO TYPE_^1 200 L = SDEF(K+4) + 1_^1C_#FIELD TYPE = 0_!1_!2_!3_!4_!5_!6_!7_!8_!9_^1_$GO TO_%(500,250,250,250,250,300,250,460,500,310),L_^1C_#IF ACCOUNT NO IS ZERO GO TO PUTTING IN DELIMITOR INSTEAD OF DATA_^1 250 CALL CCSCST(ACCTNO,ONE,16,ASCZER,ONE,16,L)_^1_$IF(L. ‚‚LE.0) GO TO 600_^1_$IF(SDEF(K+4).EQ.2) GO TO 350_^1_$CALL CCSCST(RECORD,STRPOS,LENGTH,ASCZER,ONE,LENGTH,L)_^1C_#CHECK RETURN INDICATOR_^1_$IF(L) 280,260,270_^1C_#ALL ZEROS PRESENT - EDIT ONLY IF FIELD IS AN AMOUNT FIELD_^1 260 IF(SDEF(K+4).EQ.3) GO TO 450_^1C_#NOT AN AMOUNT FIELD, BYPASS EDIT AND OUTPUT_^1_$GO TO 280_^1C_#FIELD IS NOT ALL BLANK OR ZEROS-COMPARE AGAINST ALL NINE FI ‚‚ELD TO_^1C_#DETERMINE IF FIELD IS NUMERIC OR ALPHA_^1 270 CALL CCSCST(RECORD,STRPOS,LENGTH,ASCNIN,ONE,LENGTH,L)_^1C_#GO TO EDIT ROUTINE IF FIELD IS NUMERIC_^1_$IF(L.LT.0) GO TO 450_^1C_#FIELD IS ALPHA. EDIT AS ALPHA FIELD IF PHONE NUMBER OR SOC.SEC.NO._^1_$IF(SDEF(K+4).GE.4) GO TO 350_^1C_#NO FIELD PRESENT TO EDIT OR UNUSED FIELD TYPE_^1 280 GO TO 70_^1C_#PUT ACTIVITY HERE_^1 30 ‚‚0 GO TO 70_^1C 310 ISTAT=ASCZER(1)+1_^1C_#CALL GETACF(FSTACT,RECORD(154),LMASBL,ISTAT)_^1C_#CALL ACTEDT(FSTACT,WRKTBL(M))_^1 310 GO TO 70_^1C_#NO EDIT TO PERFORM_^1C_#PERFORM THE MOVE_^1C_#ALPHANUMERIC FIELD FROM FILE_^1 350 CALL CCSMVA(RECORD,STRPOS,LENGTH,WRKTBL,M,LENGTH)_^1_$GO TO 70_^1C_#EDIT FIELDS_^1C_KTYPE_^1 450 CALL EDIT(RECORD,STRPOS,WRKTBL,M,SDEF(K+4))_^1_$GO TO 70_^1 ‚‚C_#TIME REQUEST_^1 460 CALL CCSTIM(TIME)_^1_$CALL CCSMVA(TIME,ONE,FOUR,WRKTBL,M,FOUR)_^1_$GO TO 70_^1C_#CONSTANT SCREEN FIELD FROM SCRNFILE_^1 500 CALL CCSMVA(SDEF(K+5),STRPOS,LENGTH,WRKTBL,M,LENGTH)_^1_$GO TO 70_^1C_#USE DELIMITORS INSTEAD OF ACTUAL DATA FROM MASTER RECORD_^1 600 IF(SDEF(K+4).EQ.ONE) DELIM = SLASH_^1_$IF(SDEF(K+4).EQ.TWO) DELIM = PAR1_^1_$IF(SDEF(K+4).EQ.THREE. ‚‚OR.SDEF(K+4).EQ.FOUR) DELIM = BRK1_^1_$IF(SDEF(K+4).EQ.SIX) DELIM = CAR1_^1_$CALL CCSMVA(DELIM,ONE,TWO,WRKTBL,M,TWO)_^1C_#IF THERE IS ROOM BETWEEN DELIMATORS-INSERT THE POSITION IN THE_^1C_#MASTER RECORD (K+4) THAT CONTAINS THE DATA WHICH WOULD PRINT._^1C_#CALCULATE THAT PRINT POSITION-_^1_$NXTBYT = (LENGTH - 4) / 2 + M_^1C_#IF THERE IS ROOM BETWEEN DELIMATORS PRINT THE POSITION NU ‚‚MBER_^1_$IF(NXTBYT.LE.M) GO TO 610_^1_$CALL HEXDEC(STRPOS,HXA)_^1_$CALL CCSMVA(HXA,THREE,4,WRKTBL,NXTBYT,4)_^1C_#PUT IN LAST DELIMITOR_^1 610 M = M + LENGTH - 1_^1_$IF(DELIM.EQ.PAR1) DELIM = PAR2_^1_$IF(DELIM.EQ.BRK1) DELIM = BRK2_^1_$IF(DELIM.EQ.CAR1) DELIM = CAR2_^1_$CALL CCSMVA(DELIM,ONE,TWO,WRKTBL,M,TWO)_^1_$GO TO 70_^13_]_^1C_#MOVE TABLE ARRAY AND PRINT_^1 650 M = 1_^1_$N = ‚‚40_^1C_#TO CENTER TO MIDDLE OF PAGE_^1_$L = 14_^1_$DO 670 I=1,24_^1_$DO 653 M=M,N_^1_$PRTLNE(L) = WRKTBL(M)_^1_$L = L + 1_^1 653 CONTINUE_^1_$L = 14_^1_$N = N + 40_^1_$PRTLNE(12) = ASTRSK_^1_$PRTLNE(56) = ASTRSK_^1_$ASSIGN 655 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1 655 IF(NDLSP.NE.$59)GO TO 670_^1_$CALL CCSBLK(PRTLNE,LINLEN)_^1_$PRTLNE(12) = A ‚‚STRSK_^1_$PRTLNE(56) = ASTRSK_^1_$ASSIGN 670 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1 670 CONTINUE_^1C_#SPACE DOWN A COUPLE LINES AND PRINT SCREEN TITLE AND DATE_^1_$CALL CCSBLK(PRTLNE,LINLEN)_^1_$PRTLNE(12)= ASTRSK_^1_$PRTLNE(56) = ASTRSK_^1_$DO 675 L=1,2_^1_$ASSIGN 675 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1 ‚‚ 675 CONTINUE_^1C_#PRINT BOTTOM ASTERISK LINE_^1_$DO 680 L=12,56_^1_$PRTLNE(L) = ASTRSK_^1 680 CONTINUE_^1_$ASSIGN 685 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1 685 CALL CCSBLK(PRTLNE,LINLEN)_^1_$ASSIGN 695 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1C_#CENTER SCREEN NAME ON PAPER_^1 695 IF(NAMLEN.EQ.0) GO TO 700_^ ‚‚1_$STRPOS = (132-NAMLEN) / 2_^1_$CALL CCSMVA(SCNNAM,ONE,NAMLEN,PRTLNE,STRPOS,NAMLEN)_^1_$ASSIGN 700 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1C_#CENTER AND PRINT CURRENT DATE_^1 700 CALL CCSBLK(PRTLNE,LINLEN)_^1_$DATE(1)=AND($FFFF,AMONTO)_^1_$DATE(2)=AND($FFFF,ADAYTO)_^1_$DATE(3)=AND($FFFF,AYERTO)_^1_$CALL CCSMVA(SLASH,ONE,TWO,PRTLNE,64,TWO)_^1_$CA ‚‚LL CCSMVA(SLASH,ONE,TWO,PRTLNE,67,TWO)_^1_$CALL CCSMVA(DATE,ONE,TWO,PRTLNE,62,TWO)_^1_$CALL CCSMVA(DATE,THREE,TWO,PRTLNE,65,TWO)_^1_$CALL CCSMVA(DATE,5,TWO,PRTLNE,68,TWO)_^1_$ASSIGN 710 TO IGOTO_^1_$CALL FWRITE(LP,PRTLNE,LINLEN,IGOTO,FLAG,TEMP)_^1_$CALL DISP_^1C_#SCREEN PRINTED_^1 710 RETURN_^1_$END_]_^__ ‚‚LPRSCN CSY/ F68 0010 ‚‚1_$PROGRAM LPRSCN_^1_#1_2/F68 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVSION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_"AND AGENCY)_^1C_]_^1C_#PRINT SCREEN TEMPLATES ON THE LINE PRINTER_^1C_]_^1C_#THIS PROGRAM FORMATS THE CONSTANTS FROM SCRNFILE IN A 40X24_^1C_#(40X48-IF DOUBLE-SPACED) ARRAY JUST AS ‚‚IT WOULD APPEAR ON A SCREEN_^1C_#IF NO ACCOUNT NUMBER IS INPUT, THE FIELDS WHICH WOULD CONTAIN DATA_^1C_#FROM THE MASTER FILES ARE INDICATED WITH STARTING AND ENDING_^1C_#DELIMATORS AND, IF THERE IS ROOM BETWEEN, THE STARTING POSITION_^1C_#IN THE MASTER FILE IS PRINTED._^1C_]_^1C_#IF THERE IS AN ACCOUNT NUMBER INPUT, THE ACTUAL DATA FROM THE_^1C_#DELINQUENT MASTER, CLIENT FILE, OR ‚‚COSIGNER FILE IS PRINTED_^1C_]_^1C_#INTEGER VARIABLES_^1C_]_^1_$INTEGER ACCTNO(8),DBLSP,SCNNAM(20),NAMLEN,CLINO(2)_^1_$INTEGER ID(4),LU,MODE,PORT,XYN,TC,ISTAT,CLRSCR,CLRLEN,ASC0(8)_^1_$INTEGER EOF,WRONKY,IOBUF(41),EXIT,ISVSC_^1_$INTEGER RECORD(1000),SDEF(1000)_^1_$INTEGER IDATDM(15),IDATCS(15),IDATSC(15)_^1_$INTEGER IDATCL(15)_^1_$INTEGER REQBDM(24),REQBCS(24),REQBSC(24)_^1_$INTEGE ‚‚R REQBCL(24)_^1_$INTEGER MSCNNO(37),MNOSCN(20),MSCNNM(16),MDBLSP(27),MACCNO(48)_^1_$INTEGER MNOMS(62),MNOCS(63)_^1C_#LEGAL AGENCY SCREENS ONLY_^1_$INTEGER MCLINO(47),MNOCL(62),MNOMST(51),MSCN67(37)_^1C_]_^1C_#DATA VALUES_^1C_]_^1_$DATA CLRLEN/1/,CLRSCR/$1800/,EOF/$100/,WRONKY/$200/,XYN/-1/_^1_$DATA EXIT/'EX'/,ASC0/8*$3030/_^1_$DATA REQBDM/24*0/,REQBCS/24*0/,REQBSC/24*0/_^1_$DATA RE ‚‚QBCL/24*0/_^1_$DATA IDATDM/'LADLQMSTLA_-',1,1,0/_^1_$DATA IDATCS/'LACOSIGNLA_-',1,1,0/_^1_$DATA IDATSC/'LASCNFILLA_-',1,1,0/_^1_$DATA IDATCL/'LACLIENTLA_-',1,1,0/_^1C_]_^1_$DATA MSCNNO/$D0A,'ENTER THE NUMBER OF THE SCREEN YOU WISH PRINTED_^1_#1OR EX TO EXIT ROUTINE ',$D0A/_^1_$DATA MNOSCN/$D0A,'THE SCREEN NUMBER ENTERED IS INVALID',$D0A/_^1_$DATA MSCNNM/$D0A,'ENTER THE NAME OF THE ‚‚SCREEN',$D0A/_^1_$DATA MDBLSP/$D0A,'DO YOU WANT THE SCREEN TO BE DOUBLE SPACED? Y OR_^1_#1 N',$D0A/_^1_$DATA MACCNO/$D0A,'ENTER THE ACCOUNT NUMBER IF DATA IS TO BE PRINTE_^1_#1D ',$D0A,' OR ONLY IF NO DATA IS TO BE USED ',$D0A/_^1_$DATA MNOMS/$D0A,'THERE IS NO RECORD IN THE MASTER FILE FOR THE NUM_^1_#1BER ENTERED',$D0A,'RE-ENTER ACCOUNT NUMBER OR ONLY OR EX TO E_^1_#2XI ‚‚T ROUTINE',$D0A/_^1_$DATA MNOCS/$D0A,'THERE IS NO RECORD IN THE COSIGNER FILE FOR THE N_^1_#1UMBER ENTERED',$D0A,'THE SCREEN WILL BE PRINTED WITH THE FIELD DES_^1_#2IGNATORS_$'$D0A/_^1_$DATA MCLINO/$D0A,'ENTER THE CLIENT NUMBER IF DATA IS TO BE PRINTED_^1_#1',$D0A,' OR ONLY IF NO DATA IS TO BE USED ',$D0A/_^1_$DATA MNOCL/$D0A,'THERE IS NO RECORD IN THE CLIENT FILE FOR THE NUM ‚‚_^1_#1BER ENTERED',$D0A,'RE-ENTER CLIENT NUMBER OR ONLY OR EX TO EX_^1_#2IT ROUTINE ',$D0A/_^1_$DATA MNOMST/$D0A,'THE SCREEN NUMBER ENTERED HAS NO ASSOCIATED MAST_^1_#1ER FILE RECORD',$D0A,' THE BASIC SCREEN WILL BE PRINTED',$D0A/_^1_$DATA MSCN67/'A SPECIFIC MESSAGE WOULD PRINT HERE WHEN THE OPERATOR_^1_#1 IS ENTERING L/A DATA'/_^1C_]_^1C_"BEGINNING OF PROGRAM_^1C_]_^1_$CALL ‚‚PGMIN(ID,LU,MODE,PORT)_^1C_#OPEN THE FILES_^1_$CALL OPENFL(REQBSC,IDATSC,ISTAT)_^1_$IF(ISTAT.GE.0) GO TO 10_^1_$CALL FILERR(IDATSC,3,ISTAT,LU)_^1_$GO TO 900_^1_!10 CALL OPENFL(REQBDM,IDATDM,ISTAT)_^1_$IF(ISTAT.GE.0) GO TO 20_^1_$CALL FILERR(IDATDM,3,ISTAT,LU)_^1_$GO TO 900_^1_!20 CALL OPENFL(REQBCS,IDATCS,ISTAT)_^1_$IF(ISTAT.GE.0) GO TO 30_^1_$CALL FILERR(IDATCS,3,ISTAT,LU)_^1_$GO ‚‚TO 900_^1_!30 CALL OPENFL(REQBCL,IDATCL,ISTAT)_^1_$IF(ISTAT.GE.0) GO TO 40_^1_$CALL FILERR(IDATCL,3,ISTAT,LU)_^1_$GO TO 900_^1C_]_^1C_#CLEAR THE SCREEN_^1_!40 CALL WTREAD(LU,XYN,CLRSCR,CLRLEN,0,0,0,TC)_^1C_]_^1C_#PROMPT FOR SCREEN NUMBER_^1C_]_^1_!50 CALL WTREAD(LU,XYN,MSCNNO,74,XYN,IOBUF,80,TC)_^1C_#CHECK FOR END OF ROUTINE_^1_!60 IF(IOBUF(1).EQ.EXIT) GO TO 800_^1C_#GET RECORD FRO ‚‚M SCREENFILE_^1_$ISVSC = ICCSAD(IOBUF(1))_^1C_#IF REQUEST IS FOR COSIGNER SCREEN(WHICH IS IN TWO PARTS) FORCE_^1C_#TO PRINT THE FIRST PART FIRST_^1_$IF(ISVSC.EQ.94) ISVSC = 04_^1_$CALL READR(REQBSC,SDEF,ISVSC,ISTAT)_^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 70_^1C_#CHECK FOR OTHER ERROR_^1_$IF(ISTAT.GE.0) GO TO 100_^1_$CALL FILERR(IDATSC,13,ISTAT,LU)_^1_$GO ‚‚ TO 900_^1C_#SCREEN NUMBER NOT IN SCREENFILE_^1_!70 CALL WTREAD(LU,XYN,MNOSCN,40,0,0,0,TC)_^1_$GO TO 50_^1C_]_^1C_#PROMPT FOR SCREEN NAME_^1C_]_^1 100 CALL WTREAD(LU,XYN,MSCNNM,32,XYN,IOBUF,80,TC)_^1C_#THIS NAME WILL BE CENTERED BELOW THE SCREEN PRINTED_^1_$NAMLEN = IOBUF(41)_^1_$CALL CCSMVA(IOBUF,1,NAMLEN,SCNNAM,1,NAMLEN)_^1C_]_^1C_#PROMPT FOR DOUBLE SPACING_^1C_]_^1_$CALL WTREAD ‚‚(LU,XYN,MDBLSP,54,XYN,IOBUF,80,TC)_^1_$DBLSP = IOBUF(1)_^1C_]_^1C_#CHECK THE SCREEN NUMBER ENTERED TO DETERMINE NEXT PROMPT_^1C_#SCREENS #92 AND 93 USE L/A CLIENT FILE_^1_$IF(ISVSC.EQ.92.OR.ISVSC.EQ.93) GO TO 200_^1C_#SCREENS #08, 09, 67 HAVE NO ASSOCIATED MASTER RECORD_^1_$IF(ISVSC.EQ.08.OR.ISVSC.EQ.09.OR.ISVSC.EQ.67) GO TO 300_^1C_]_^1C_#PROMPT FOR ACCOUNT NUMBER_^1C_]_^1_$CALL W ‚‚TREAD(LU,XYN,MACCNO,96,XYN,IOBUF,80,TC)_^1_$IF(IOBUF(41).EQ.0) GO TO 120_^1 105 CALL CCSMVA(IOBUF,1,16,ACCTNO,1,16)_^1_$CALL READR(REQBDM,RECORD,ACCTNO,ISTAT)_^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 110_^1C_#CHECK FOR OTHER ERROR_^1_$IF(ISTAT.GE.0) GO TO 150_^1_$CALL FILERR(IDATDM,13,ISTAT,LU)_^1_$GO TO 900_^1C_]_^1C_#ACCOUNT NOT FOUND_^1C_]_^1 110 CALL ‚‚ WTREAD(LU,XYN,MNOMS,124,XYN,IOBUF,80,TC)_^1_$IF(IOBUF(1).EQ.EXIT) GO TO 800_^1_$IF(IOBUF(41).EQ.0) GO TO 120_^1_$GO TO 105_^1 120 CALL CCSMVA(ASC0,1,16,ACCTNO,1,16)_^1 150 CALL LPRNTT(RECORD,ACCTNO,DBLSP,SCNNAM,NAMLEN,SDEF)_^1_$IF(ISVSC.NE.04) GO TO 50_^1C_#IS A COSIGNER SCREEN--- PRINT SECOND HALF_^1_$ISVSC = 94_^1C_#READ SCREENFILE_^1_$CALL READR(REQBSC,SDEF,ISVSC,ISTAT)_^1_$I ‚‚F(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 160_^1C_%CHECK FOR OTHER ERROR_^1_$IF(ISTAT.GE.0) GO TO 165_^1_$CALL FILERR(IDATSC,13,ISTAT,LU)_^1_$GO TO 900_^1C_#SCREEN NOT FOUND_^1 160 CALL WTREAD(LU,XYN,MNOSCN,40,0,0,0,TC)_^1_$GO TO 60_^1C_#GET RECORD FOR COSIGNER FILE IF ACCOUNT NUMBER ENTERED_^1 165 CALL CCSCST(ACCTNO,1,16,ASC0,1,16,L)_^1_$IF(L.LE.0) GO TO 190_ ‚‚^1 170 CALL READR(REQBCS,RECORD,ACCTNO,ISTAT)_^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 175_^1C_#CHECK FOR OTHER ERROR_^1_$IF(ISTAT.GE.0) GO TO 190_^1_$CALL FILERR(IDATSC,13,ISTAT,LU)_^1_$GO TO 900_^1C_]_^1C_#NO COSIGNER RECORD_^1C_]_^1 175 CALL WTREAD(LU,XYN,MNOCS,126,0,0,0,TC)_^1_$CALL CCSMVA(ASC0,1,16,ACCTNO,1,16)_^1 190 CALL LPRNTT(RECORD,ACCTNO,DBLS ‚‚P,SCNNAM,NAMLEN,SDEF)_^1_$GO TO 50_^1C_]_^1C_#PROMPT FOR CLIENT NUMBER_^1C_]_^1 200 CALL WTREAD(LU,XYN,MCLINO,94,XYN,IOBUF,80,TC)_^1 210 IF(IOBUF(41).EQ.0) GO TO 250_^1_$CALL CCSMVA(IOBUF,1,4,CLINO,1,4)_^1_$CALL READR(REQBCL,RECORD,CLINO,ISTAT)_^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 230_^1C_#CHECK FOR OTHER ERROR_^1_$IF(ISTAT.GE.0) GO TO 260_^1_$CALL F ‚‚ILERR(IDATCL,13,ISTAT,LU)_^1_$GO TO 900_^1C_]_^1C_#NO CLIENT FILE FOUND_^1C_]_^1 230 CALL WTREAD(LU,XYN,MNOCL,124,XYN,IOBUF,80,TC)_^1_$IF(IOBUF(1).EQ.EXIT) GO TO 800_^1_$GO TO 210_^1 250 CALL CCSMVA(ASC0,1,16,ACCTNO,1,16)_^1_$GO TO 270_^1 260 CALL CCSMVA(CLINO,1,4,ACCTNO,1,4)_^1 270 CALL LPRNTT(RECORD,ACCTNO,DBLSP,SCNNAM,NAMLEN,SDEF)_^1_$GO TO 50_^1C_]_^1C_#SCREENS WITH NO MAST ‚‚ER RECORD-TELL OPERATOR AND PRINT SCREEN_^1C_]_^1 300 IF(ISVSC.EQ.67) CALL CCSMVA(MSCN67,1,74,RECORD,1,74)_^1_$IF(ISVSC.EQ.08.OR.ISCSC.EQ.09) CALL CCSBLK(RECORD,2000)_^1_$CALL WTREAD(LU,XYN,MNOMST,102,0,0,0,TC)_^1_$CALL LPRNTT(RECORD,ACCTNO,DBLSP,SCNNAM,NAMLEN,SDEF)_^1_$GO TO 50_^1 800 CALL CLOSFL(REQBDM,ISTAT)_^1_$CALL CLOSFL(REQBSC,ISTAT)_^1_$CALL CLOSFL(REQBCL,ISTAT)_^1_$CALL ‚‚CLOSFL(REQBCS,ISTAT)_^1 900 CALL PGMOUT_^1_$END_]_^__ ‚‚LPRTSR CSY/ F69 0020 ‚‚1_$PROGRAM LPRTSR_^1_#1_2/F69 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_(THIS PROGRAM SETS THE SORT KEYS WITHIN TRNSFL, THIS ALLOWS_^1C_(FOR MULTIPLE ACTIVITIES AND MULTIPLE REVIEWS OF AN ACCOUNT_^1C_(TO APPEAR CORRECTLY ON THE TIME USAG ‚‚E REPORT._^11_]_^1_$INTEGER RECINP(69),RECOUT(69),REQINP(24),REQOUT(24),IDATA(15),_^1_#1_"STRTP(2),XEOF,USER(4)_^11_]_^1_$DATA MULACT / -1 /,_^1_#1_#RECOUT / 69*$2020 /,_^1_#2_#XEOF / 0 /,_^1_#3_#L / ' L' /,_^1_#4_#IFRST / 1 /,_^1_#5_#REQINP / 24*0 /_^1_$DATA IDATA / 'LATRNSFL',8*$2020, 0, 1, -1 /_^12_ _]_^1C_(ACCEPT LOG ON FROM ITOS_^1_)CALL PGMIN ( USER, LU, MODE, NPORT )_^12_ _] ‚‚_^1C_(OPEN TRNSFL FOR USE_^1_$CALL OPENFL ( REQINP, IDATA, ISTAT )_^1_$IF ( ISTAT .LT. 0 ) GO TO 900_^12_]_^1C_(READ AN ACTIVITY RECORD_^1 100 IF ( XEOF .NE. 0 ) GO TO 950_^1_$CALL GETS ( REQINP, RECINP, 0, ISTAT )_^1C_(CHECK FOR END OF FILE_^1_$IF ( RECINP(15) .NE. $3031 ) GO TO 500_^1_$IF ( AND(ISTAT,$100) .EQ. $100 ) GO TO 500_^1_$IF ( ISTAT .LT. 0 ) GO TO 900_^11_]_^1C_(THIS I ‚‚S AN ACTIVITY RECORD - SAVE ACTIVITY COUNTER_^1_$RECINP(61) = RECINP(69)_^1C_(BLANK OUT SORT CODE AREA_^1_$CALL CCSMVA ( L, 1, 0, RECINP, 132, 7 )_^1C_(CHECK FOR FIRST TIME_^1_$IF ( IFRST .EQ. 1 ) GO TO 400_^11_]_^1C_(NOT FIRST - COMPARE ACCOUNT NUMBER_^1_$DO 110 I = 1, 8_^1_$IF ( RECINP(I) .NE. RECOUT(I) ) GO TO 300_^1 110 CONTINUE_^11_]_^1C_(SAME ACCOUNT NUMBER - COMPARE START T ‚‚IME_^1_$IF ( RECINP(11) .NE. RECOUT(11) .OR._^1_#2_"RECINP(12) .NE. RECOUT(12)) GO TO 200_^11_]_^1C_(SAME START TIME (SESSION) - INCREMENT SESSION CNT AND SAVE_^1_$MULACT = MULACT + 1_^1_$RECOUT(67) = AND(RECOUT(67),$FF00) + MULACT + $30_^11_]_^1C_(STORE THE OUTPUT RECORD_^1 120 CALL UPDREC ( REQOUT, RECOUT, ISTAT )_^1_$IF ( ISTAT .LT. 0 ) GO TO 900_^11_]_^1C_(MOVE THE INPUT RECOR ‚‚D TO THE OUTPUT RECORD_^1 130 DO 140 I = 1, 69_^1 140 RECOUT(I) = RECINP(I)_^1C_(MOVE START TIME PRIME TO THE OUTPUT BUFFER_^1_$RECOUT(68) = STRTP(1)_^1_$RECOUT(69) = STRTP(2)_^1C_(SAVE THE REQUEST BUFFER FOR OUTPUT_^1_$DO 150 I = 1, 24_^1 150 REQOUT(I) = REQINP(I)_^11_]_^1C_(GO GET NEXT RECORD TO PROCESS_^1_$GO TO 100_^12_]_^1C_(SAME ACCT, NEW START TIME (SESSION) -_^1C_(CHECK ‚‚IF WORKING ON A MULTIPLE ACTIVITY SESSION_^1 200 IF ( MULACT .EQ. -1 ) GO TO 120_^1C_(YES - SET END OF SESION INDICATOR_^1_$RECOUT(67) = AND(RECOUT(67),$FF00) + AND(L,$FF)_^1_$MULACT = -1_^1_$GO TO 120_^12_]_^1C_#NEW ACCOUNT - SAVE NEW START TIME PRIME_^1 300 STRTP(1) = RECINP(11)_^1_$STRTP(2) = RECINP(12)_^1_$GO TO 200_^12_]_^1C_(FIRST TIME - INITIALIZE_^1 400 STRTP(1) = RECINP ‚‚(11)_^1_$STRTP(2) = RECINP(12)_^1_$IFRST = 0_^1_$GO TO 130_^12_]_^1C_(EOF ENCOUNTERED - SET FLAG AND SAVE LAST RECORD_^1 500 XEOF = 1_^1_$GO TO 300_^12_]_^1C_(FILE ERROR OCCURED - REPORT AND EXIT_^1 900 CONTINUE_^12_]_^1C_(CLOSE FILE AND STOP JOB_^1 950 CALL CLOSFL ( REQINP, ISTAT )_^1_$CALL PGMOUT_^1_$END_]_^__ ‚‚LQLOAD CSY/ F70 0010 ‚‚1_$PROGRAM LQLOAD_^1_#1_2/F70 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_#THIS PROGRAM COMPUTES THE AGE OF THE NEXT CONTACT DATES FROM_^1C_#THE DAILY ASSIGNMENT FILE (DLYASSN). A REPORT IS GENERATED_^1C_#TO REFLECT THE LOADING IN EACH QU ‚‚EUE._^11_]_^0C_#THE LADLYASN FILE IS READ SEQUENTIALLY, 20 RECORDS AT A TIME. FOR_^1C_#EACH RECORD, THE NEXT CONTACT AGE IS COMPUTED. AFTER A CHANGE_^1C_#IN QUEUE IS DETECTED, A RECORD IS PRINTED (IF THE PROGRAM WAS RAN_^1C_#FROM THE MASTER TERMINAL) OR DISPLAYED TO THE USERS CONSOLE (IF_^1C_#THE PROGRAM WAS RAN FROM A USER TERMINAL). TOTALS ARE GENERATED_^1C_#FOR EACH QUEUE AS W ‚‚ELL AS REPORT TOTALS FOR EACH NEXT CONTACT_^1C_#AGE CATAGORY._^11_]_^1_$INTEGER AGE, AGE1, BLK, CLS, COUNT_^1_$INTEGER DT(3), DLYREQ(24), DDATA(15), DLYREC(402)_^1_$INTEGER EOF, HDR(60), IDUSER(4), IBUF(3)_^1_$INTEGER MSG1(22), MSG2(6), PAGE, PRT, PRTSW_^1_$INTEGER Q(7), QT(7), QUEUE(2), QPRT(28), ZERO_^1_$INTEGER ALLDON_^1_$INTEGER DT2(3)_^0_$INTEGER LINCT_^0_$DATA LINCT/0/_^11_]_ ‚‚^1_$DATA BLK/$2020/, CLS/$1820/, COUNT/0/, DLYREQ/24*0/_^1_$DATA DDATA/'LADLYASN',8*$2020,0,20,0/, ITC/0/_^1_$DATA MSG1/$0A0D,'ENTER DATE (MMDDYY) OR CR FOR SYSTEM DATE '/_^1_$DATA MSG2/$000D,'READY (CR)'/_^1_$DATA PAGE/0/, PRT/$100C/, Q/7*0/, QT/7*0/, ZERO/$3030/_^1._]_^1_$DATA ALLDON / 0 /_^1_$CALL PGMIN(IDUSER,LUNIT,MODE,NOPORT)_^1C_ 0_^12_]_^1C_(THE INFORMATION REGARDING RECORD KEYS HAVING RESTRICTIONS ARE_^1C_(KEPT IN THE TABLE 'KEYTAB'. EVERY KEY IN THE TABLE HAS_^1C_(THE FOLLOWING FOUR WORD ENTRY ASS ‚‚OCIATED WITH IT._^1C_]_^1C_*WORD_'MEANING_^1C_*----_'--------------------------_^1C_,1_(FIRST TWO BYTES OF KEY_^1C_,2_(SECOND TWO BYTES OF KEY_^1C_,3_(PERMITTED OPERATIONS INDICATOR (POP)_^1C_,4_(ASSOCIATED FORMAT PROMPT FOR RECORD ENTRY_^11_]_^1C_(THE LAST ENTRY REFERS TO THE INDEX IN A TABLE OF FORMATS_^1C_(WHICH IS TO BE OUTPUT FOR ADDITION AND UPDATES OF RECORDS_^1C_(AS A GUIDI ‚‚NG PROMPT. THIS FORMAT LINE WILL APPEAR ABOVE ANY_^1C_(DATA ENTRY TO GUIDE THE USER AS TO FIELD FORMAT WITHIN THE_^1C_(RECORD. FOR EXAMPLE, FOR THE 'OLPM' RECORD, THE FORMAT PROMPT_^1C_(WOULD BE:_^1C_-' RL--,P--,C-- '_^1C_(SHOWING THE USER WHICH COLUMNS THE DATA IS TO BE INPUT IN._^11_]_^1C_(FOR UPDATES, THE ENTRY OF DATA INTO THE RECORD WILL BE OVER_^1C_(THE EXISTING RECORD (WHIC ‚‚H IS DISPLAYED UNDER THE FORMAT LINE)_^1C_(SO THE USER NEED ONLY ENTER THE CHANGED INFORMATION._^13_]_^1C_(FILE MANAGER BUFFERS._^1_$INTEGER REQBUF(24) , IDATA(15) , RECBUF(42) , KEY(2) , SKEY(2)_^1_$DATA REQBUF / 24*0 /_^1_$DATA IDATA / 'LAUTIFIL_'' , 4*$2020 , 1 , 1 , 1 /_^12_]_^1C_(MESSAGE BUFFERS._^1_$INTEGER CS_^1_$DATA CS / $18 /_^1_$INTEGER PGINOU(21)_^1_$DATA PGINOU / $D0A ‚‚, 'UTILITY FILE MODIFICATION PROGRAM IN ' ,_^1_#1_$$D0A /_^1_$INTEGER INOPER(37)_^1_$DATA INOPER / $D0A , 'ENTER "UPD" TO ADD/UPDATE, "DEL" TO DELETE',_^1_#1_$', OR CARRIAGE RETURN TO EXIT' , $D0A /_^1_$INTEGER INVREQ(10)_^1_$DATA INVREQ / $D0A , 'INVALID REQUEST ' , $D0A /_^1_$INTEGER INKEY(19)_^1_$DATA INKEY / $D0A , 'ENTER KEY OF RECORD TO XXXXXXXXXX ' , $D0A /_^1_$INTEGER NOMO ‚‚D(37)_^1_$DATA NOMOD / $D0A , 'RECORD -XXXX- NOT FOR ADDITION, DELETION, ' ,_^1_#1_$'OR UPDATE THRU THIS PROGRAM ' , $D0A /_^1_$INTEGER NODEL(24)_^1_$DATA NODEL / $D0A , 'RECORD -XXXX- IS REQUIRED, CANNOT BE',_^1_#1_$' DELETED' , $D0A /_^1_$INTEGER NOREC(26)_^1_$DATA NOREC / $D0A , 'RECORD -XXXX- DOES NOT EXIST, CANNOT BE ' ,_^1_#1_$'DELETED ' , $D0A /_^1_$INTEGER ADDSUC(18) , DELS ‚‚UC(19) , UPDSUC(19)_^1_$DATA ADDSUC / $D0A , 'RECORD -XXXX- ADDED SUCCESSFULLY' , $D0A /_^1_$DATA DELSUC / $D0A , 'RECORD -XXXX- DELETED SUCCESSFULLY' , $D0A /_^1_$DATA UPDSUC / $D0A , 'RECORD -XXXX- UPDATED SUCCESSFULLY' , $D0A /_^12_]_^1C_(INPUT BUFFER FOR UPDATE AND OPERATION REQUESTS._^1_$INTEGER INBUF(39)_^1_$EQUIVALENCE ( INCHAR , INBUF(39) )_^12_]_^1C_(BUFFER FOR FORMAT LINE ‚‚ OUTPUT._^1_$INTEGER FOROUT(40)_^1_$DATA FOROUT / $D0A , 38*$2020 , $D0A /_^12_]_^1C_(LOGIN VARIABLES._^1_$INTEGER ID(4) , LU_^11_]_^1C_(OPERATION CODE TABLES._^1_$INTEGER VALOP(4) , OPOUT(10)_^1_$DATA VALOP / 'UPD DEL ' /_^1_$DATA OPOUT / 'ADD/UPDATEDELETE_"' /_^11_]_^1C_(OTHER SMALL VARIABLES AND CONSTANTS._^1_$INTEGER OP , SVW23 , EOF , WRONKY , EOTAB , BLANK , TC , UPDFLG_^1_$D ‚‚ATA EOF / $8100 / , WRONKY / $200 / , EOTAB / $2A2A /_^1C_(EOTAB IS END-OF-TABLE CODE FOR KEY TABLE._^1_$DATA BLANK / $2020 /_^1._]_^1C_(KEY TABLE CONTAINING RESTRICTED KEYS, POP, AND FORMAT_^1C_(INDICES._^1_$INTEGER KEYTAB(200)_^1_$INTEGER KEY1(4) , KEY2(4) , KEY3(4) , KEY4(4) , KEY5(4) ,_^1_#1_(KEY6(4) , KEY7(4) , KEY8(4) , KEY9(4) , KEY10(4) ,_^1_#2_'KEY11(4) , KEY1 ‚‚2(4) , KEY13(4) , KEY14(4) , KEY15(4) ,_^1_#3_'KEY16(4) , KEY17(4) , KEY18(4) , KEY19(4) , KEY20(4) ,_^1_#4_'KEY21(4) , KEY22(4) , KEY23(4) , KEY24(4) , KEY25(4)_^1_$EQUIVALENCE ( KEYTAB( 1) , KEY1(1) ) , ( KEYTAB( 5) , KEY2(1) ),_^1_#1_+( KEYTAB( 9) , KEY3(1) ) , ( KEYTAB(13) , KEY4(1) ),_^1_#2_+( KEYTAB(17) , KEY5(1) ) , ( KEYTAB(21) , KEY6(1) ),_^1_#3_+( KEYTAB(25) , KEY7 ‚‚(1) ) , ( KEYTAB(29) , KEY8(1) ),_^1_#4_+( KEYTAB(33) , KEY9(1) ) , ( KEYTAB(37) , KEY10(1) ),_^1_#5_+( KEYTAB(41) , KEY11(1) ) , ( KEYTAB(45) , KEY12(1) ),_^1_$EQUIVALENCE ( KEYTAB(49) , KEY13(1) ) , ( KEYTAB(53) , KEY14(1) ),_^1_#1_+( KEYTAB(57) , KEY15(1) ) , ( KEYTAB(61) , KEY16(1) ),_^1_#2_+( KEYTAB(65) , KEY17(1) ) , ( KEYTAB(69) , KEY18(1) ),_^1_#3_+( KEYTAB(73) , KEY19(1) ‚‚ ) , ( KEYTAB(77) , KEY20(1) ),_^1_#4_+( KEYTAB(81) , KEY21(1) ) , ( KEYTAB(85) , KEY22(1) ),_^1_#5_+( KEYTAB(89) , KEY23(1) ) , ( KEYTAB(93) , KEY24(1) )_^1_$EQUIVALENCE ( KEYTAB(97) , KEY25(1) )_^11_]_^1C_1KEY_#POP FORMAT_^1_$DATA KEY1 / 'COID' , 1 , 1 /_^1C_(KEY1 IS DEFAULT WHEN KEY NOT FOUND ELSEWHERE IN TABLE. THIS_^1C_(IS THE COLLECTOR RECORDS IN THE FILE._^1_$DATA KEY2 / ‚‚'HDR1' , 0 , 2 /_^1_$DATA KEY3 / 'HDR2' , 0 , 2 /_^1_$DATA KEY4 / 'HDR3' , 0 , 2 /_^1_$DATA KEY5 / 'RSW1' , 0 , 3 /_^1_$DATA KEY6 / 'ACTC' , -1, 0 /_^1_$DATA KEY7 / 'RESC' , -1, 0 /_^1_$DATA KEY8 / 'SALC' , 0 , 4 /_^1_$DATA KEY9 / 'DALT' , 0 , 5 /_^1_$DATA KEY10 / 'SMTH' , 0 , 3 /_^1_$DATA KEY11 / 'TMTH' , 0 , 6 /_^1_$DATA KEY12 / 'UPDY' , 0 , 6 /_^1_$DATA KEY13 / 'OLPM' , 0 ‚‚ , 7 /_^1_$DATA KEY14 / 'LTRF' , 0 , 8 /_^1_$DATA KEY15 / 'RPTG' , -1, 0 /_^1_$DATA KEY16 / 'LTR1' , -1, 0 /_^1_$DATA KEY17 / 'LTR2' , -1, 0 /_^1_$DATA KEY18 / 'LACL' , 0 , 9 /_^1_$DATA KEY19 / 'LAC1' , 0 ,10 /_^1_$DATA KEY20 / 'LAC2' , 0 ,10 /_^1_$DATA KEY21 / 'LAC3' , 0 ,10 /_^1_$DATA KEY22 / 'LAC4' , 0 ,10 /_^1_$DATA KEY23 / 'LAC5' , 0 ,10 /_^1C_(REMAINING KEYS ARE OPEN AND AVAI ‚‚LABLE FOR FUTURE USE._^1C_(NEXT TABLE ENTRY AFTER LAST ENTRY USED SHOULD HAVE THE_^1C_(END-OF-TABLE CODE (EOTAB) IN FIRST WORD._^1_$DATA KEY24 / '** ' , 0 , 0 /_^1_$DATA KEY25 / '_"' , 0 , 0 /_^1._]_^1C_(FORMAT TABLE AND POINTER._^1_$INTEGER FORMAT(950) , FPTR_^1_$INTEGER FM1(38) , FM2(38) , FM3(38) , FM4(38) , FM5(38) ,_^1_#1_(FM6(38) , FM7(38) , FM8(38) , FM9(38) , FM10( ‚‚38) ,_^1_#2_'FM11(38) , FM12(38) , FM13(38) , FM14(38) , FM15(38) ,_^1_#3_'FM16(38) , FM17(38) , FM18(38) , FM19(38) , FM20(38) ,_^1_#4_'FM21(38) , FM22(38) , FM23(38) , FM24(38) , FM25(38)_^11_]_^1_$EQUIVALENCE ( FORMAT( 1) , FM1(1) ) , ( FORMAT( 39) , FM2(1) ),_^1_#1_+( FORMAT( 77) , FM3(1) ) , ( FORMAT(115) , FM4(1) ),_^1_#2_+( FORMAT(153) , FM5(1) ) , ( FORMAT(191) , FM6 ‚‚(1) ),_^1_#3_+( FORMAT(229) , FM7(1) ) , ( FORMAT(267) , FM8(1) ),_^1_#4_+( FORMAT(305) , FM9(1) ) , ( FORMAT(343) , FM10(1) ),_^1_#5_+( FORMAT(381) , FM11(1) ) , ( FORMAT(419) , FM12(1) ),_^1_$EQUIVALENCE ( FORMAT(457) , FM13(1) ) , ( FORMAT(495) , FM14(1) ),_^1_#1_+( FORMAT(533) , FM15(1) ) , ( FORMAT(571) , FM16(1) ),_^1_#2_+( FORMAT(609) , FM17(1) ) , ( FORMAT(647) , FM18(1) ‚‚ ),_^1_#3_+( FORMAT(685) , FM19(1) ) , ( FORMAT(723) , FM20(1) ),_^1_#4_+( FORMAT(761) , FM21(1) ) , ( FORMAT(799) , FM22(1) ),_^1_#5_+( FORMAT(837) , FM23(1) ) , ( FORMAT(875) , FM24(1) ),_^1_$EQUIVALENCE ( FORMAT(913) , FM25(1) )_^11_]_^1_$DATA FM1 / 'NAME_*ISPHONE_#EXT CSUP QUEUES... ' ,_^1_#1_$15*$2020 /_^1C_(FM1 IS DEFAULT FORMAT FOR KEYS NOT FOUND IN TABLE. IT IS_^1C_(THE CO ‚‚LLECTOR RECORD FORMAT._^1_$DATA FM2 / 20*'--' , 18*$2020 /_^1_$DATA FM3 / 'R---,S---,W---' , 31*$2020 /_^1_$DATA FM4 / 'CODE1_!CODE2_!CODE3_!CODE4_!CODE5_!CODE6_!' ,_^1_#1_$'CODE7_!CODE8_!CODE9 ' , 3*$2020 /_^1_$DATA FM5 / '---,QUE =---,QUE =---,QUE =---,QUE =---,QUE =---,Q' ,_^1_#2_$'UE =--- ' , 9*$2020 /_^1_$DATA FM6 / '--- ' , 36*$2020 /_^1_$DATA FM7 / 'RL--,P--,C--,NA-', ‚‚30*$2020 /_^1_$DATA FM8 / 'N-------------------------' , 25*$2020 /_^1_$DATA FM9 / '--,--,--,--,--_$NNN ', 26*$2020 /_^1_$DATA FM10 / 15*'--' , 23*$2020 /_^1C_(REMAINING FORMAT DEFINITIONS ARE AVAILABLE FOR FUTURE USE._^1_$DATA FM11 / 38*$2020 /_^1_$DATA FM12 / 38*$2020 /_^1_$DATA FM13 / 38*$2020 /_^1_$DATA FM14 / 38*$2020 /_^1_$DATA FM15 / 38*$2020 /_^1_$DATA FM16 / 38*$2020 /_^ ‚‚1_$DATA FM17 / 38*$2020 /_^1_$DATA FM18 / 38*$2020 /_^1_$DATA FM19 / 38*$2020 /_^1_$DATA FM20 / 38*$2020 /_^1_$DATA FM21 / 38*$2020 /_^1_$DATA FM22 / 38*$2020 /_^1_$DATA FM23 / 38*$2020 /_^1_$DATA FM24 / 38*$2020 /_^1_$DATA FM25 / 38*$2020 /_^1._]_^1C_(SET UP FOR PROCESSING. RETRIEVE PROGRAM INFORMATION AND_^1C_(OPEN UTILITY FILE._^1 50 CALL PGMIN ( ID , LU , I , J )_^1_$CALL OPE ‚‚NFL ( REQBUF , IDATA , ISTAT )_^1C_(OPEN REQUEST SUCCESSFUL?_^1_$IF ( ISTAT .LT. 0 ) GO TO 800_^1C_(YES. CLEAR SCREEN AND WRITE PROGRAM IN MESSAGE._^1_$CALL WTREAD ( LU , -1 , CS , 2 , 0 , 0 , 0 , TC )_^1_$CALL WTREAD ( LU , -1 , PGINOU , 42 , 0 , 0 , 0 , TC )_^11_]_^1C_(RETRIEVE NEXT OPERATION REQUEST._^1 100 INBUF(1) = BLANK_^1_$INBUF(2) = BLANK_^1_$CALL WTREAD ( LU , -1 , INOPE ‚‚R , 74 , -1 , INBUF , 3 , TC )_^1C_(IF RUBOUT, REPEAT INPUT REQUEST._^1_$IF ( TC .EQ. 4 ) GO TO 100_^1C_(VALIDATE OPERATION REQUEST. MUST BE 'ADD', 'DEL', 'UPD', OR_^1C_(JUST A CARRIAGE RETURN (TERMINATES)._^1_$IF( INBUF(3) .EQ. 0 ) GO TO 900_^1C_(SCAN TABLE OF VALID OPERATION CODES._^1_$DO 110 OP = 1 , 2_^1_$J = 2*OP - 1_^1_$IF ( VALOP(J) .EQ. INBUF(1) .AND._^1_#1_$VALOP(J+1) . ‚‚EQ. INBUF(2) ) GO TO 120_^1 110 CONTINUE_^11_]_^1C_(INVALID OPERATION REQUESTED. REPORT ERROR AND PROMPT AGAIN._^1_$CALL WTREAD ( LU , -1 , INVREQ , 20 , 0 , 0 , 0 , TC )_^1_$GO TO 100_^11_]_^1C_(VALID OPERATION. PROMPT FOR KEY._^1 120 J = 10*OP - 9_^1_$CALL CCSMVA ( OPOUT , J , 10 , INKEY , 26 , 10 )_^1 125 CALL WTREAD ( LU , -1 , INKEY , 38 , -1 , KEY , 4 , TC )_^1C_(IF RUBOUT ‚‚, REPEAT ENTER REQUEST._^1_$IF ( TC .EQ. 4 ) GO TO 125_^11_]_^1C_(SCAN TABLE FOR THIS KEY. START SEARCH WITH SECOND ENTRY IN_^1C_(TABLE SINCE FIRST IS DEFAULT FOR COLLECTOR RECORD ENTRIES._^1_$DO 130 KINDEX = 5 , 100 , 4_^1C_(END-OF-TABLE?_^1_$IF ( KEYTAB(KINDEX) .EQ. EOTAB ) GO TO 140_^1C_(NO, CHECK FOR A MATCH._^1_$IF ( KEYTAB(KINDEX) .EQ. KEY(1) .AND._^1_#1_$KEYTAB(KINDEX+1) ‚‚.EQ. KEY(2) ) GO TO 200_^1C_(NO MATCH, CONTINUE SCAN._^1 130 CONTINUE_^11_]_^1C_(ENTRY NOT FOUND IN TABLE. TREAT AS COLLECTOR RECORD._^1 140 KINDEX = 1_^1_$GO TO 220_^1._]_^1C_(MATCH FOR KEY FOUND IN TABLE. VERIFY OPERATION REQUESTED IS_^1C_(VALID ACCORDING TO PERMITTED OPERATIONS WORD (POP) FOR THIS_^1C_(KEY._^11_]_^1C_(NO OPERATIONS ALLOWED IF RECORD USAGE NOT ALLOWED THRU THIS ‚‚_^1C_(PROGRAM ( POP < 0 )._^1 200 IF ( KEYTAB(KINDEX+2) .GE. 0 ) GO TO 210_^1C_(NO OPERATIONS ALLOWED._^1_$NOMOD(6) = KEY(1)_^1_$NOMOD(7) = KEY(2)_^1_$CALL WTREAD ( LU , -1 , NOMOD , 74 , 0 , 0 , 0 , TC )_^1_$GO TO 100_^11_]_^1C_(NO DELETE OPERATION ALLOWED IF RECORD REQUIRED TO BE PRESENT_^1C_(IN FILE AND MODIFIABLE THRU THIS PROGRAM ( POP = 0 )._^1 210 IF ( KEYTAB(KINDEX+2) .NE ‚‚. 0 .OR. OP .NE. 2 ) GO TO 220_^1C_(DELETION NOT ALLOWED._^1_$NODEL(6) = KEY(1)_^1_$NODEL(7) = KEY(2)_^1_$CALL WTREAD ( LU , -1 , NODEL , 48 , 0 , 0 , 0 , TC )_^1_$GO TO 100_^11_]_^1C_(HAVE VALID OPERATION ON KEY RECORD SUPPLIED. ATTEMPT_^1C_(RETRIEVAL OF THAT RECORD._^1 220 SKEY(1) = KEY(1)_^1_$SKEY(2) = KEY(2)_^1_$CALL READR ( REQBUF , RECBUF , SKEY , ISTAT )_^1C_(FATAL FILE E ‚‚RROR?_^1_$IF ( ISTAT .LT. 0 .AND. AND( ISTAT , EOF ) .NE. EOF )_^1_#1_$GO TO 810_^11_]_^1C_(NO ERROR. JUMP TO PROCESS ON THE BASIS OF OPERATION ENTRY._^1_$IF ( OP .EQ. 1 ) GO TO 400_^1._]_^1C_1DELETE OPERATION._^12_]_^1C_(CANNOT DELETE IF RECORD DOES NOT EXIST._^1C_(DOES RECORD EXIST?_^1 300 IF ( AND( ISTAT , EOF ) .NE. EOF .AND._^1_#1_$AND( ISTAT , WRONKY ) .NE. WRONKY ) GO TO ‚‚ 310_^1C_(NO, RECORD NOT FOUND. REPORT ERROR AND GET NEXT REQUEST._^1_$NOREC(6) = KEY(1)_^1_$NOREC(7) = KEY(2)_^1_$CALL WTREAD ( LU , -1 , NOREC , 52 , 0 , 0 , 0 , TC )_^1_$GO TO 100_^12_]_^1C_(RECORD FOUND, DELETE._^1 310 CALL DELREC ( REQBUF , RECBUF , ISTAT )_^1C_(DELETE SUCCESSFUL?_^1_$IF ( ISTAT .LT. 0 ) GO TO 830_^1C_(YES, REPORT SUCCESSFUL DELETE AND GET NEXT REQUEST._^1_$D ‚‚ELSUC(6) = KEY(1)_^1_$DELSUC(7) = KEY(2)_^1_$CALL WTREAD ( LU , -1 , DELSUC , 38 , 0 , 0 , 0 , TC )_^1_$GO TO 100_^1._]_^1C_1ADD/UPDATE OPERATION._^12_]_^1C_(IF RECORD IS NOT PRESENT IN FILE, THEN REQUEST IS AN ADD. IF_^1C_(RECORD IS PRESENT, REQUEST IS AN UPDATE._^1C_(SET FLAG FOR UPDATE REQUEST AND CHECK IF RECORD FOUND._^1 400 UPDFLG = 1_^1_$IF ( AND( ISTAT , EOF ) .NE. EOF .A ‚‚ND._^1_#1_$AND( ISTAT , WRONKY ) .NE. WRONKY ) GO TO 410_^1C_(NO, RECORD NOT FOUND. SET FLAG TO INDICATE ADD OPERATION AND_^1C_(SET UP RECORD BUFFER FOR ADD. (BLANK AND MOVE IN KEY)._^1_$UPDFLG = 0_^1_$CALL CCSBLK ( RECBUF(3) , 76 )_^1_$RECBUF(1) = KEY(1)_^1_$RECBUF(2) = KEY(2)_^12_]_^1C_)DETERMINE FORMAT FOR RECORD PROMPT (POINTER_^1C_(INTO FORMAT ARRAY). PRINT FORMAT LINE AND OLD ‚‚ RECORD_^1C_(CONTENTS AND RECEIVE INPUT FOR CHANGES TO RECORD._^1 410 FPTR = 76*KEYTAB(KINDEX+3) - 75_^1_$CALL CCSMVA ( FORMAT , FPTR , 76 , FOROUT , 3 , 76 )_^1_$CALL WTREAD ( LU , -1 , FOROUT , 80 , 0 , 0 , 0 , TC )_^1_$RECBUF(41) = $D_^1 415 CALL WTREAD ( LU , -1 , RECBUF(3) , 78 , -1 , INBUF , 76 , TC )_^1C_(IF RUBOUT, REPEAT ENTER REQUEST._^1_$IF ( TC .EQ. 4 ) GO TO 415_^11_ ‚‚]_^1C_(IF NO INPUT, ADD/UPDATE OPERATION ABORTED. DO NOT PERFORM_^1C_(FILE WRITE OR OUTPUT COMPLETED MESSAGE. INSTEAD, GET NEXT_^1C_(REQUEST._^1_$IF ( INCHAR .EQ. 0 ) GO TO 100_^11_]_^1C_(INPUT CHANGES RECEIVED. MERGE INTO FILE RECORD BUFFER, WITH_^1C_(ANY ENTRY <$20 OR >$5A FROM INBUF NOT OVERLAYING CONTENTS_^1C_(OF RECORD BUFFER._^1_$DO 420 I = 1 , INCHAR_^1_$CALL CCSGET ( INBU ‚‚F , I , J )_^1_$IF ( J .GE. $ 20 .AND. J .LE. $5B )_^1_#1_$CALL CCSPUT ( J , I , RECBUF(3) )_^1 420 CONTINUE_^11_]_^1C_(MERGE COMPLETE. PERFORM WRITER/UPDREC REQUEST DEPENDING ON_^1C_(OPERATION. CHECK FOR ADD._^1_$IF ( UPDFLG .EQ. 0 ) GO TO 430_^11_]_^1C_(UPDATE OPERATION. UPDATE RECORD IN FILE._^1_$CALL UPDREC ( REQBUF , RECBUF , ISTAT )_^1C_(UPDATE SUCCESSFUL?_^1_$IF ( ISTAT . ‚‚LT. 0 ) GO TO 840_^1C_(YES, REPORT AND GET NEXT REQUEST._^1_$UPDSUC(6) = KEY(1)_^1_$UPDSUC(7) = KEY(2)_^1_$CALL WTREAD ( LU , -1 , UPDSUC , 38 , 0 , 0 , 0 , TC )_^1_$GO TO 100_^11_]_^1C_(ADD OPERATION. ADD RECORD TO FILE._^1 430 CALL WRITER ( REQBUF , RECBUF , KEY , ISTAT )_^1C_(FILE ERROR?_^1_$IF ( ISTAT .LT. 0 ) GO TO 820_^1C_(NO. REPORT SUCCESSFUL ADD AND GET NEXT REQUEST._^1_$ ‚‚ADDSUC(6) = KEY(1)_^1_$ADDSUC(7) = KEY(2)_^1_$CALL WTREAD ( LU , -1 , ADDSUC , 36 , 0 , 0 , 0 , TC )_^1_$GO TO 100_^1._]_^1C_1FILE ERROR PROCESSING._^11_]_^1C_(OPENFL REQUEST._^1 800 J = 3_^1_$GO TO 850_^11_]_^1C_(READR REQUEST._^1 810 J = 13_^1_$GO TO 850_^11_]_^1C_(WRITER REQUEST._^1 820 J = 12_^1_$GO TO 850_^11_]_^1C_(DELREC REQUEST._^1 830 J = 16_^1_$GO TO 850_^11_]_^1C_(UP ‚‚DREC REQUEST._^1 840 J = 15_^11_]_^1C_(OUTPUT ERROR MESSAGE._^1 850 CALL FILERR ( IDATA , J , ISTAT , LU )_^13_]_^1C_(WRITE PROGRAM OUT MESSAGE, CLOSE UTILITY FILE, AND EXIT._^1 900 PGINOU(19) = PGINOU(19) + $607_^1_$PGINOU(20) = PGINOU(20) + $3400_^1_$CALL WTREAD ( LU , -1 , PGINOU , 42 , 0 , 0 , 0 , TC )_^1_$CALL CLOSFL ( REQBUF , ISTAT )_^1_$CALL PGMOUT_^1_$STOP_]_^1_$END_]_^ ‚‚__ ‚‚LWROFE CSY/ F81 0010 ‚‚1_$PROGRAM LWROFE_^1_#1_2/F81 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERSION 3_^1C_#DATA SYSTEM - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_#THIS PROGRAM CREATES THE WOEF FILE FROM THE LADLQMST FILE._^1C_#TWO DIFFERENT REPORTS CAN BE CREATED FROM THIS REPORT, THE_^1C_#ELIGIBLE FOR WRITE OFF AND THE ACTUAL WRITE ‚‚OFF REPORTS._^11_]_^1C_#THE REPORT MAY BE SORTED BY ACCOUNT TYPE, QUEUE OR A STRAIGHT_^1C_#LISTING. THE PROGRAM PROMPTS THE OPERATOR FOR THE SORT CODE._^1C_#THE OPERATOR IS ALSO PROMPTED FOR SUBTOTALS._^11_]_^1_$INTEGER ADAYS(3),ANS(3),ASOFDT(4),BLANK,CREATE,COUNT_^1_$INTEGER DATE(3),DAYS,DDAYS,EOF,FDEL,FMRDEL_^1_$INTEGER IBUF(3),IDUSER(4),MDLDT(3),MSTDT(3),MLEN(11)_^1_$INTEGER MP ‚‚OS(11),NINE,NO,NREC,OCNT(6),ONE(5)_^1_$INTEGER RETURN,RCNT(6),SCNT(6),STAT(2),SUB_^1_$INTEGER WCNT(6),WFG1,WFG2,WPOS(11),YES(2),ZERO(2)_^11_]_^1_$INTEGER DELQBF(24),DELQRC(3000),DDATA(15)_^1_$INTEGER WOEFBF(24),WOEFRC(60),WDATA(15)_^11_]_^1_$INTEGER DSP1(9),DSP2(15),DSP3(21),DSP4(20),DSP5(10)_^1_$INTEGER DSP6(17),DSP7(22),DSP8(22),DSP9(22),DSP10(23)_^1_$INTEGER DSP11(19),DSP12(20), ‚‚DSP13(17),DSP14(33),DSP15(30)_^1_$INTEGER DSP16(29),DSP17(22)_^11_]_^1_$DATA BLANK/$2020/,DELQBF/24*0/,EOF/0/,NINE/$3939/,NO/'NO'/_^1_$DATA OCNT/6*$3030/,RCNT/6*$3030/,SCNT/6*$3030/,ADAYS/3*$3030/_^1_$DATA STAT/'WRS '/,WCNT/6*$3030/,ONE/4*$3030,$3130/_^1_$DATA YES/'YES '/,WOEFBF/24*0/,ZERO/$3030,$3030/_^11_]_^1_$DATA DDATA/'LADLQMST',8*$2020,0,3,0/_^1_$DATA WDATA /'LAWOEF ',8*$202 ‚‚0,0,1,0/_^11_]_^1_$DATA DSP1/$0A0D,'ANSWER (1 OR 2) '/_^1_$DATA DSP2/$0A0D,$0A0D,'ENTER AS-OF-DATE (MMDDYY) '/_^1_$DATA DSP3/$0A0D,$0A0D,'ENTER NUMBER OF DAYS DELINQUENT (NNN) '/_^1_$DATA DSP4/$0A0D,$0A0D,'ENTER WRITE-OFFS SINCE DATE (MMDDYY)'/_^1_$DATA DSP5/$0A0D,'ANSWER (1,2,OR 3) '/_^1_$DATA DSP6/$0A0D,$0A0D,'ARE SUBTOTALS DESIRED (YES/NO)'/_^1_$DATA DSP7/$180A,' RECORD COUNT-- ‚‚R RECORDS_#000000000000'/_^1_$DATA DSP8/$0A0D,' RECORD COUNT--S RECORDS_#000000000000'/_^1_$DATA DSP9/$0A0D,' RECORD COUNT--W RECORDS_#000000000000'/_^1_$DATA DSP10/$A0D,' RECORD COUNT--OTHER RECORDS 000000000000',_^1_#1$0A0D/_^1_$DATA DSP11/$180A,'CHOOSE ONE OF THE FOLLOWING REPORTS:'/_^1_$DATA DSP12/$0A0D,$0A0D,'_"1) ELIGIBLE FOR WRITE-OFF REPORT'/_^1_$DATA DSP13/$0A0D,'_"2) A ‚‚CTUAL WRITE-OFF REPORT',$0A0D/_^1_$DATA DSP14/$180A,'CHOOSE ONE OF THE FOLLOWING WAYS TO PRINT ',_^1_#1'THE WRITE-OFF REPORT: '/_^1_$DATA DSP15/$0A0D,$0A0D,'_"1) PRINT THE REPORT BY ACCOUNT TYP',_^1_#1'E, QUEUE ASSIGNED'/_^1_$DATA DSP16/$0A0D,'_"2) PRINT THE REPORT BY QUEUE ASSIGNED,',_^1_#1' ACCOUNT TYPE '/_^1_$DATA DSP17/$0A0D,'_"3) PRINT THE REPORT BY STRAIGHT LIST',_^1_#1$0A0D/ ‚‚_^11_]_^1C_#FIELD NAME_$LADLQMST_'LAWOEF_^1C_#MACCT_.1_-1_^1C_#MNAM_.18_,34_^1C_#MQUE_-271_,26_^1C_#MSCD_-292_+114_^1C_#MSTC_-306_,25_^1C_#MSTDT_,857_,97_^1C_#MDLDT_,875_,64_^1C_#MADLQ_,887_,70_^1C_#MCBAL_,896_+103_^1C_#MPYOF_,905_,79_^1C_#MTCD_-963_,30_^11_]_^1_$DATA MPOS/1,18,271,292,306,857,875,887,896,905,963/_^1_$DATA WPOS/1,34,26,114,25,97,64,70,103,79,30/_^1_$DATA MLEN/16,30 ‚‚,4,2,1,6,6,9,9,9,4/_^11_]_^1_$EXTERNAL AMONTO,ADAYTO,AYERTO,FMRDEL_^1._]_^1_$CALL PGMIN(IDUSER,LUNIT,MODE,NOPORT)_^1_$IF(NOPORT.NE.0) GO TO 9999_^11_]_^1C_NUMBER OF DAYS DELQ, MDLDT, IN LADLQMST_^1C_>(ASOFDT-MDLDT)_^11_]_^1C_FROM THE A/R SYSTEM (MSTDT) IS GREATER_^1C_>THAN OR EQUAL TO THE WRITE-OFF SINCE_^1C_>DATE ENTERED THROUGH THE CONSOLE(ASOFDT)_^11_]_^1C_ TO CONTIN_^1_#1UE (CREATE NEW RCD)INVALID ENTRY, ENTER NEW STATUS OR TO RETU_^ ‚‚1_#2RN TO SELECTION SCREEN '/_^1_$DATA HCLEN2/01,72,73,70/_^11_]_^1C**** LOCAL VARIABLES,CONSTANTS AND BUFFERS._^1_$INTEGER ASCNIN(5),ASCZER(5),AVALSP,EDTLEN(10),LENSAV_^1_$INTEGER NXTBYT,SDEF(1000),SCREEN,NEEDSP,BLANKS,REC(1)_^12_]_^1C**** LOCAL VARIABLES,CONSTANTS AND BUFFERS REQUIRING INITIALIZATION._^1_$DATA ASCNIN/5*$3939/,ASCZER/5*$3030/,BLANKS/$2020/_^1_$DATA EDTLEN/0,8,0,10 ‚‚,12,0,11,4,0,0/_^1._]_^1C***********************************************************************_^1C_]_^1C_]_^1C_2_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_1:_B:_^1C_1: BEGIN DISPLAY-MODULE PROCESSING :_^1C_1:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^1C_]_^12_]_^12_]_^1C**** INITIALIZE STARTING BYTE FOR OUTPUT ‚‚BUFFER._^1_$NXTBYT = 1_^11_]_^1C**** CHECK IF SCREEN IS A HARD-CODED MESSAGE FUNCTION. IF YES,GO TO 500_^1_$IF(SCREEN.LT.0) GO TO 500_^11_]_^1C**** ACCESS LASCNFIL( L/A SCREEN-FILE ) RECORD._^1_!5 J = SCREEN_^1_$CALL READR(REQBFS,SDEF,J,ISTAT)_^11_]_^1C**** CHECK FOR SCREEN NOT PRESENT OR OTHER ERROR._^1_$IF(ISTAT.LT.0.OR.AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 800_^11_]_^1C**** SCREEN ‚‚ DEFINITION RETRIEVED. INTIALIZE INDEX INTO DEFINITION RCD._^1_$J = 2_^11_]_^1C**** CHECK IF CLEAR-SCREEN FUNCTION SHOULD BE DONE._^1_$IF(SCREEN.LE.90) GO TO 20_^1C**** SCREEN TYPE INDICATES CLEAR SCREEN TO BE DONE._^1_$CALL WTREAD(LU,XYN,CLRSCR,1,0,0,0,TC)_^1_$GO TO 20_^11_]_^1C**** RETRIEVE INDEX FOR NEXT SCREEN DEFINITION FIELD._^1 10 J = SDEF(J+1)_^1C**** CHECK IF SCREEN DISP ‚‚LAY IS COMPLETE._^1_$IF(J.NE.0) GO TO 20_^11_]_^1C****_]_^1C**** END OF SCREEN DEFINITION._^1C****_]_^1_$GO TO 550_^1._]_^1C****_]_^1C**_!PLACE CURSOR POSITIONING WORDS IN OUTPUT BUFFER. SINCE THE OUTPUT_^1C**_!BUFFER IS SCANNED BY THE ITOS EXECUTIVE TO BIAS THE POSITIONING_^1C**_!WORD, THE SEQUENCE CANNOT BE SEPARATED BY DIFFERENT WRITE OPERA-_^1C**_!TIONS. CHECK IF ENOUGH BYTES A ‚‚RE AVAILABLE IN THE OUTPUT BUFFER_^1C**_!FOR THE FOUR BYTES OF CURSOR POSITIONING._^1C****_]_^11_]_^1 20 IF(OUTBYT-NXTBYT-3) 30,40,50_^11_]_^1C**** NOT ENOUGH ROOM. WRITE OUTPUT BUFFER BEFORE MOVING IN CURSOR WORDS_^1 30 ASSIGN 50 TO IRTN_^1_$GO TO 400_^11_]_^1C**** ENOUGH ROOM FOR CURSOR WORDS, BUT BUFFER IS THEN FULL. WRITE_^1C**_!BEFORE CONTINUING. NEVER PASS A FILLED OUTPUT ‚‚ BUFFER TO FIELD_^1C**_!TYPE PROCESSING ROUTINES._^1 40 CALL CCSMVA(XYWORD,1,2,OBUF,NXTBYT,2)_^1_$NXTBYT = NXTBYT + 2_^1_$CALL CCSMVA(SDEF(J),1,2,OBUF,NXTBYT,2)_^1_$NXTBYT = NXTBYT +2_^1_$ASSIGN 60 TO IRTN_^1C**** WRITE OUTPUT BUFFER._^1_$GO TO 400_^11_]_^1C**** ENOUGH ROOM FOR CURSOR WORDS. MOVE THEM INTO OUTPUT BUFFER._^1 50 CALL CCSMVA(XYWORD,1,2,OBUF,NXTBYT,2)_^1_$NXTBYT = ‚‚NXTBYT + 2_^1_$CALL CCSMVA(SDEF(J),1,2,OBUF,NXTBYT,2)_^1_$NXTBYT = NXTBYT + 2_^1._]_^1C****_]_^1C**_!BRANCHED GO TO TO JUMP TO APPROPRIATE ROUTINE TO FILL AND EDIT OUT_^1C**_!BUFFER WITH FIELDS ACCORDING TO THEIR TYPE._^1C****_]_^11_]_^1 60 IF(ISTAT.GT.0) GO TO 65_^1_$I = SDEF(J+4) + 1_^1C**** FIELD TYPE = 0_!1_!2_!3_!4_!5_!6_!7_!8_!9_^1_$GO TO_%(200,100,200,950,100,950,950,950, ‚‚200,950),I_^1 65 GO TO_%(200,010,010,010,010,950,950,950,200,950),I_^12_]_^1C**** SCREEN TYPES REQUIRE EDIT. CHECK IF FIELDS HAVE NON-BLANK ENTRIES._^1C** IF FIELD IS ALL BLANK - BYPASS EDIT AND OUTPUT._^1C** IF FIELD IS ALL ZEROES - EDIT ONLY FOR AMOUNT FIELDS._^1C** IF FIELD IS NUMERIC_"- EDIT._^1C** IF FIELD IS APLHA_$- EDIT AS AN ALPHA FIELD ONLY FOR PHONE #._^11_]_^1C** ‚‚** COMPARE AGAINST ALL ZERO FIELD._^1 100 STRPOS = SDEF(J+3)_^1_$LENGTH = SDEF(J+2)_^1_$CALL CCSCST(REC,STRPOS,LENGTH,ASCZER,1,LENGTH,I)_^1C**** CHECK RETURN INDICATOR._^1_$IF(I) 130,110,120_^11_]_^1C**** ALL ZEROES PRESENT. EDIT ONLY IF FIELD IS AN AMOUNT FIELD._^1 110 IF(SDEF(J+4).EQ.3) GO TO 300_^1C**** NOT AN AMOUNT FIELD. BYPASS EDIT AND OUTPUT._^1_$GO TO 130_^11_]_^1C**** F ‚‚IELD IS NOT ALL BLANK OR ALL ZEROES. COMPARE AGAINST ALL NINE_^1C**_!FIELDS TO DETERMINE IF FIELD IS NUMERIC OR ALPHA._^1 120 CALL CCSCST(REC,STRPOS,LENGTH,ASCNIN,1,LENGTH,I)_^1C**** GO TO EDIT ROUTINE IF FIELD IS NUMERIC._^1_$IF(I.LT.0) GO TO 300_^1C**** FIELD IS ALPHA. EDIT AS AN ALPHA FIELD IF PHONE NUMBER OR SOCIAL_^1C**_!SECURITY NUMBER FIELD._^1_$IF(SDEF(J+4).GE.4) GO TO 200 ‚‚_^11_]_^1C**** NO FIELD PRESENT TO EDIT OR UNUSED FIELD TYPE. REMOVE X-Y POSITION_^1C**_!ING WORDS FOR THIS FIELD FROM OUTPUT BUFFER IF PRESENT._^1 130 IF(NXTBYT.GT.4) NXTBYT=NXTBYT-4_^11_]_^1C**** GO PROCESS NEXT SCREEN FIELD._^12_]_^1C****_]_^1C** NO EDIT TO PERFORM. DIRECT MOVEMENT OF CHARACTERS WHICH IS INTER-_^1C** RUPTIBLE WHEN BUFFER IS FULL._^1C**_]_^1C** INTIALIZE STAR ‚‚TING CHARACTER POSITION IN SOURCE ARRAY._^1 200 STRPOS = SDEF(J+3)_^1C** CHECK IF OUTPUT BUFFER HAS ENOUGH ROOM FOR ALL OF THE FIELD._^1 210 AVALSP = OUTBYT - (NXTBYT-1)_^1_$NEEDSP = SDEF(J+2) - (STRPOS - SDEF(J+3))_^1_$IF(AVALSP.GE.NEEDSP) GO TO 220_^11_]_^1C** NOT ENOUGH ROOM. MOVE ONLY ENOUGH CHARACTERS TO FILL OUTPUT BUFFER_^1_$LENGTH = AVALSP_^1_$GO TO 230_^11_]_^1C** ENO ‚‚UGH ROOM TO MOVE ENTIRE FIELD._^1 220 LENGTH = NEEDSP_^11_]_^1C**** PERFORM THE MOVE._^1 230 IF(SDEF(J+4).EQ.0.OR.SDEF(J+4).EQ.8) GO TO 240_^1C**** ALPHANUMERIC FIELD FROM FILE. SOURCE ARRAY IS FROM REC._^1_$CALL CCSMVA(REC,STRPOS,LENGTH,OBUF,NXTBYT,LENGTH)_^1_$GO TO 250_^11_]_^1C**** CONSTANT SCREEN FIELD. SOURCE ARRAY IS FROM SCREEN DEFINITION FLD._^1 240 CALL CCSMVA(SDEF(J+5) ‚‚,STRPOS,LENGTH,OBUF,NXTBYT,LENGTH)_^11_]_^1C**** CALCULATE NEXT BYTE AVAILABLE IN OUTPUT BUFFER._^1 250 NXTBYT = NXTBYT + LENGTH_^1C**** OPERATION COMPLETE IF ALL OF FIELD MOVED._^1_$IF(NEEDSP.EQ.LENGTH) GO TO 10_^11_]_^1C**** OPERATION NOT COMPLETE. ONLY PART OF STRING MOVED. SAVE NEW_^1C**** STARTING CHARACTER OF SOURCE FIELD FOR NEXT MOVE._^1_$STRPOS = STRPOS + LENGTH_^1C**** W ‚‚RITE FILLED OUTPUT BUFFER AND RETURN TO MOVE IN REMAINDER OF FLD._^1_$ASSIGN 210 TO IRTN_^1_$GO TO 400_^1C****_]_^1C** EDIT FIELDS TO OUTPUT BUFFER. EDIT IS UNITERRUPTIBLE, SO OVERFLOW_^1C** OF OUTPUT BUFFER IS ALLOWED AND CORRECTED AFTER THE EDIT._^1C**_]_^1C** PERFORM THE EDIT._^1 300 CALL EDIT(REC,SDEF(J+3),OBUF,NXTBYT,SDEF(J+4))_^11_]_^1C**** CALCULATE NEXT AVAIABLE WORD IN ‚‚ OUTPUT BUFFER._^1 320 I = SDEF(J+4) + 1_^1_$NXTBYT = NXTBYT + EDTLEN(I)_^1C**** CHECK IF OVERFLOW OF OUTPUT BUFFER OCCURRED. RETURN TO PROCESS_^1C**_!NEXT SCREEN FIELD IF NO OVERFLOW OCCURRED._^1_$IF(OUTBYT.GE.(NXTBYT-1)) GO TO 10_^11_]_^1C**** OVERFLOW OCCURRED. WRITE THE FILLED OUTPUT BUFFER AND THEN MOVE_^1C**_!THE OVERFLOW CHARACTERS TO THE BEGINNING OF THE BUFFER._^11_]_^1C* ‚‚*** SAVE THE NUMBER OF CHARACTERS TO MOVE._^1_$LENSAV = (NXTBYT - 1) - OUTBYT_^1C**** RESET NXTBYT FOR LENGTH CALCULATION IN OUTPUT SECTION._^1_$NXTBYT = OUTBYT + 1_^1_$ASSIGN 330 TO IRTN_^1_$GO TO 400_^11_]_^1C**** PERFORM THE MOVE OF OVERFLOW CHARACTERS._^1 330 CALL CCSMVA(OFAREA,1,LENSAV,OBUF,1,LENSAV)_^1C**** CALCULATE NEXT AVAILABLE WORD IN OUTPUT BUFFER._^1_$NXTBYT = LENSAV ‚‚+ 1_^1C**** GO PROCESS NEXT SCREEN FIELD DEFINITION._^1_$GO TO 10_^11_]_^1C****_]_^1C**_!WRITE OUTPUT BUFFER ROUTINE._^1C**_]_^1C**_!SET LENGTH OF OUTPUT BUFFER AND WRITE._^1 400 LENGTH = NXTBYT - 1_^1_$CALL WTREAD(LU,XYN,OBUF,LENGTH,0,0,0,TC)_^1C**** RESET NEXT AVAILABLE WORD IN OUTPUT BUFFER AND RETURN._^1_$NXTBYT=1_^1_$GO TO IRTN_^1._]_^1C****_]_^1C**** HARD-CODED SCREEN MESSA ‚‚GE._^1C****_]_^11_]_^1C**** MOVE IN X-Y POSITIONING TO CLEAR AND WRITE ON LINE 23._^1 500 OBUF(1) = XYWORD(1)_^1_$OBUF(2) = 22_^1_$OBUF(3) = XYWORD(3)_^11_]_^1C**** DETERMINE WHETHER MESSAGE SCREEN IS IN FIRST OR SECOND ARRAY._^1_$IF (-1*SCREEN.GE.4) GO TO 510_^11_]_^1C**** MESSAGE IS IN FIRST ARRAY. CONVERT SCREEN TO GET MESSAGE SCREEN #._^1_$J = -2*SCREEN - 1_^1C**** MOVE MESSAG ‚‚E TO OUTPUT BUFFER._^1_$CALL CCSMVA(HCMSG,HCLEN(J),HCLEN(J+1),OBUF,6,HCLEN(J+1))_^1C**** CALCULATE NEXT BYTE AVAILABLE._^1_$NXTBYT=HCLEN(J+1) + 6_^1_$GO TO 550_^11_]_^1C**** MESSAGE IS IN SECOND ARRAY. CONVERT SCREEN TO GET MESSAGE SCREEN #_^1 510 SCREEN = SCREEN+3_^1_$J = -2*SCREEN - 1_^1C**** MOVE MESSAGE TO OUTPUT BUFFER._^1_$CALL CCSMVA(HCMSG2,HCLEN2(J),HCLEN2(J+1),OBUF,6,HCLE ‚‚N2(J+1))_^1C**** CALCULATE NEXT BYTE AVAILABLE._^1_$NXTBYT=HCLEN2(J+1) + 6_^1_$SCREEN = SCREEN-3_^1._]_^1C****_]_^1C**** FINAL SCREEN OUTPUT WITH INPUT TO RECEIVE._^1C****_]_^11_]_^1C**** CHECK IF OUTPUT BUFFER HAS ENOUGH ROOM FOR ALL FIVE BYTES NEEDED_^1C**_!TO CLEAR LINE 24._^1 550 IF(NXTBYT.LE.76) GO TO 560_^11_]_^1C**** NOT ENOUGH ROOM. WRITE OUTPUT BUFFER BEFORE MOVING IN THE ‚‚ BYTES_^1C**_!TO CLEAR LINE 24_^1_$ASSIGN 560 TO IRTN_^1_$GO TO 400_^11_]_^1C**** MOVE IN BYTES TO CLEAR LINE 24._^1 560 CALL CCSMVA(XYWORD,1,5,OBUF,NXTBYT,5)_^12_]_^1C**** SET LENGTH OF OUTPUT BUFFER FOR WRITE._^1_$LENGTH = NXTBYT + 4_^1C**** BLANK INPUT BUFFER._^1 570 CALL CCSBLK(IOBUF,INPBYT)_^1C**** PEFORM WRITE/READ. INPUT BUFFER IS IOBUF._^1_$CALL WTREAD(LU,XYN,OBUF,LENGTH, ‚‚XYN,IOBUF,INPBYT,TC)_^11_]_^1C**** IF A RUBOUT WAS USED TO TERMINATE THE LINE, CLEAR LINE 24 AGAIN_^1C**_!AND ACCEPT ANOTHER INPUT LINE._^1 575 IF(TC.NE.4) GO TO 580_^1C**** RUBOUT USED._^1_$CALL CCSMVA(XYWORD,1,5,OBUF,1,5)_^1_$LENGTH = 5_^1_$GO TO 570_^11_]_^1C**** EDIT INPUT BUFFER REMOVING LEADING BLANKS._^1 580 I = 1_^1_$CALL CCSGET(IOBUF,I,K)_^1C**** IF FIRST CHARACTER IS NO ‚‚N-BLANK, NO EDITING TO DO. RETURN._^1_$IF(K.NE.$20) GO TO 600_^1C**** FIRST CHARACTER WAS BLANK. SCAN TO DETERMINE THE NUMBER OF LEADING_^1C**_!BLANKS._^1_$J = IOBUF(41)_^1_$DO 590 I=2,J_^1_$CALL CCSGET(IOBUF,I,K)_^1C**** IF NEXT CHARACTER NOT BLANK, GO PERFORM MOVE TO REMOVE BLANKS._^1_$IF(K.NE.$20) GO TO 595_^1 590 CONTINUE_^1_$IOBUF(41) = 0_^1_$GO TO 900_^11_]_^1C**** MOVE IOBU ‚‚F LEFT TO REMOVE LEADING BLANKS._^1 595 LENGTH = IOBUF(41) - I + 1_^1_$CALL CCSMVA(IOBUF,I,LENGTH,IOBUF,1,INPBYT)_^11_]_^1C**** EDIT COMPLETE, RETURN._!SAVE LENGTH THAT WAS ACTUALLY INPUT._^1_$IOBUF(41) = LENGTH_^11_]_^1C**** SCAN INPUT BUFFER REMOVING ALL SPECIAL CHARACTERS (THOSE < $20)._^1 600 J = IOBUF(41)_^1_$DO 610 I=1,J_^1_$CALL CCSGET(IOBUF,I,K)_^1_$IF(K.LT.$20) CALL CCSP ‚‚UT(BLANKS,I,IOBUF)_^1 610 CONTINUE_^1_$GO TO 900_^1C****_]_^1C**** FILE ERROR OR SELECTED SCREEN NOT PRESENT._^1C****_]_^11_]_^1C**** IN CASE OF SELECTED SCREEN NOT PRESENT, SET STATUS WORD TO SCREEN_^1C**_!NUMBER REQUESTED BUT NOT FOUND._^1_$IF(AND(ISTAT,EOF).EQ.EOF.OR.AND(ISTAT,WRONKY).EQ.WRONKY)_^1_#1_$ISTAT=SCREEN_^1C**** REPORT ERROR. ERROR FATAL, CLOSE ALL FILES AND EXIT._^1 ‚‚ 800 JSTAT=13_^1_$CALL FILERR(IDATSC,JSTAT,ISTAT,LU)_^1_$GO TO 950_^12_]_^1C**** OUTPUT COMPLETE. NORMAL TERMINATION._^11_]_^1C**** RETRIEVE CHANGE SCREEN FIELD DESCRIPTIONS IF REQUIRED._^1C**_!IF CURRENT-SCREEN = CHANGE-SCREEN, CALL SUBROUTINE 'GETCHF'._^1 900 IF(SCREEN.EQ.92.AND.CLICHG(1).LT.0)_^1_#1_$CALL GETCHF(SDEF,CLICHG)_^11_]_^1C**** DISPLAY COMPLETE. RETURN._^11_]_^1 950 ‚‚ RETURN_^11_]_^1_$END_]_^__ ‚‚CLIDAT CSY/ F03 1270 ‚‚1_$BLOCK DATA_^1_#1_2/F03 F LA_!CCS 3.0_5SL-149_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_]_^1C_6_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_5:_8:_^1C_5: BLOCK DATA SUBPROGRAM :_^1C_5:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^1C_ ‚‚]_^1C_]_^1C***********************************************************************_^1._]_^1C_]_^1C_]_^1C_4*****************************_^1C_4*_!RETRIEVE COMMON MACRO_!*_^1C_4*****************************_^1C_]_^1C_]_^11_]_^1M_#CLIMAC_^11_]_^1._]_^1C***********************************************************************_^1C_]_^1C_]_^1C_]_^1C_,CLIDAT - CLIENT FILE MAINTENANCE BLOCK ‚‚ DATA SUBPROGRAM_^1C_,_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_]_^1C_]_^1C_]_^1C_2_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_1:_@:_^1C_1:_!INITIALIZE COMMON VARIABLES_!:_^1C_1:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^12_]_^1C**** FILE MANAGER IDA ‚‚TA WORDS._^1_$DATA IDATCL/'LACLIENTLA_-',1,1,1/_^1_$DATA IDATSC/'LASCNFILLA_-',1,1,0/_^11_]_^1C**** FILE MANAGER REQUEST BUFFERS. MUST BE INITIALLY ZEROED._^1_$DATA REQBFC/24*0/_^1_$DATA REQBFS/24*0/_^11_]_^1C**** CHANGE-SCREEN-ITEM FIELD DESCRIPTION ARRAY._^1_$DATA CLICHG/-20,60*-1/_^11_]_^1C**** NEW CLIENT FLAG AND PRIMARY-KEY VALUE FIELD._^1_$DATA RSTAT/0/,KEYVAL/2*$2020/_^11_]_ ‚‚^1C**** SAVE FIELDS FOR OLD AND NEW PRIMARY AND SECONDARY KEY VALUES._^1_$DATA OLDKEY/5*$2020/,NEWKEY/5*$2020/_^12_]_^1C**** CONSTANTS._^11_]_^1C**** ASCII_^1_$DATA CC/'CC'/,CF/'CF'/,CS/'CS'/,CR/' '/_^11_]_^1C**** CLIENT-NUMBER LENGTH AND SCREEN BUFFER LAST-BYTE POSITION._^1_$DATA NUMLEN/4/,OUTBYT/80/_^11_]_^1C**** DUMMY VARIABLE._^1_$DATA DUMMY/0/_^11_]_^1C**** FILE MANAGER STATU ‚‚S CONSIDERATIONS._^1_$DATA WRONKY/$200/,EOF/$100/,LOCKED/$80/,JSTAT/0/_^11_]_^1C**** SCREEN DISPLAY CONSTANTS._^1_$DATA XYWORD/$1B31,$17,$1600/,XYN/-1/,CLRSCR/$1800/_^11_]_^1C**** MESSAGE SCREEN NUMBERS FOR MESSAGES USED IN MORE THAN ONE MODULE._^1_$DATA INVENT/-1/_^12_]_^1C_1------------------------------------_^1C_0: END OF BLOCK DATA INITIALIZATION :_^1C_1--------------------- ‚‚---------------_^12_]_^1_$END_]_^__ ‚‚CLIENT CSY/ F04 0010 ‚‚1_$PROGRAM CLIENT_^1_#1_2/F04 F LA_!CCS 3.0_5SL-149_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#THIS PROGRAM CALLS THE CLIENT FILE MAINTENANCE MAIN MODULE_^1C_#'CLMAIN' AT THE BEGINNING OF CLIENT FILE MAINTENANCE ACTIVITY_^1C_#AND THE PROGRAM-OUT SUBROUTINE 'P ‚‚GMOUT' AT THE CONCLUSION._^1C_]_^1C_]_^1C_]_^1C_]_^1C_!******************************************************************_^1C_!*_] *_^1C_!*_"********************************************************_"*_^1C_!*_"*_U*_"*_^1C_!*_"*_+L E G A L_#&_#A G E N C Y_**_"*_^1C_!*_"*_U*_"*_^1C_!*_"*_/**** C L I E N T ****_.*_"*_^1C_!*_"*_U*_"*_^1C_!*_"*_*F I L E_#M A I N T E N A N C E_)*_"*_^1 ‚‚C_!*_"*_U*_"*_^1C_!*_"********************************************************_"*_^1C_!*_] *_^1C_!******************************************************************_^1C_]_^1C_]_^1C_]_^1C**** CALL CLIENT FILE MAINTENANCE MAIN MODULE._^1_$CALL CLMAIN_^11_]_^1C**** END OF CLIENT FILE MAINTENANCE ACTIVITY. CALL PROGRAM-OUT AND STOP_^1_$CALL PGMOUT_^12_]_^1_$END_]_^__ ‚‚CLMAIN CSY/ F06 2150 ‚‚1_$SUBROUTINE CLMAIN_^1_#1_2/F06 F LA_!CCS 3.0_5SL-149_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_]_^1C_6_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_5:_9:_^1C_5: MAIN MODULE SUBROUTINE :_^1C_5:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚:_^1C_]_^1C_]_^1C_]_^1C***********************************************************************_^1._]_^1C***********************************************************************_^1C_]_^1C_,C L I E N T_"F I L E_"M A I N T E N A N C E_^1C_]_^1C_S O U R C E_^1C_]_^1C_7D O C U M E N T A T I O N_^1C_]_^1C********************************************************* ‚‚**************_^1C_]_^1C_]_^1C_'Functions of CLIENT File Maintenance_^1C_'------------------------------------_^1C_]_^1C_,1._!Provide for the establishment and maintenance of a_^1C_1Legal & Agency client master file._^1C_]_^1C_6A. Add new records to the master file._^1C_6B. Maintain existing records in the file._^1C_]_^1C_,2._!Provide for interactive inquiry/update of the client_ ‚‚^1C_1master file._^1C_]_^1C_6A. Inquiry/update of all non-financial infor-_^1C_:mation ( firm name, address, phone#, etc. )._^1C_6B. Inquiry-only of all financial information_^1C_:( fees, court costs, percentages, etc. )._^1C_]_^1C_,3._!Provide for interactive inquiry/update of the client_^1C_1status ( options include de-activation of an active_^1C_1client and re-activation of a ‚‚client that had been_^1C_1de-activated )._^1C_]_^1C_]_^1C_]_^1C_]_^1C_'CLIENT File Maintenance Consists of the Following Modules:_^1C_'---------------------------------------------------------_^1C_]_^1C_,CLIMAC_"-_"The Labelled Common Macro_^1C_]_^1C_,CLIDAT_"-_"The Block Data Subprogram_^1C_]_^1C_,CLIENT_"-_"The Dummy Program ( required by common )_^1C_]_^1C_,CLMAIN_"-_"The Main M ‚‚odule Subroutine_^1C_]_^1C_,CLDISP_"-_"The Display Module Subroutine_^1C_]_^1C_,CLCHNG_"-_"The Change-Screen Module Subroutine_^1C_]_^1C_,CLNAME_"-_"The Name-Search Module Subroutine_^1._]_^1C_]_^1C_]_^1C_9Functions of Modules_^1C_9--------------------_^1C_]_^1C_]_^1C_'Module_7Functions_^1C_'------_--------------------------------------------_^1C_]_^1C_'CLIMAC_-Defines variables co ‚‚mmon to more than one_^1C_;module._^1C_]_^1C_'CLIDAT_-Assigns initial values to the common vari-_^1C_;ables._^1C_]_^1C_'CLIENT_-Calls main module to begin the processing_^1C_;and calls the system program-out subroutine_^1C_;PGMOUT to end processing._^1C_]_^1C_'CLMAIN_-1. Handles screens_^1C_@A. Selection screen_^1C_@B. Change screen_^1C_@C. Financial screen_^1C_@D. Status screens_^ ‚‚1C_;2. Performs the File Manager update of the_^1C_>master file LACLIENT._^1C_;3. Handles record add/maintain ( determines_^1C_>whether the master file record is a new_^1C_>or existing client and displays approp-_^1C_>riate messages._^1C_;4. Handles status inquiry/update._^1C_;5. Directs the other subroutines._^1C_]_^1C_'CLDISP_-Displays formatted screens ( with edited_^1C_;master ‚‚file data if required ) to the CRT_^1C_;using the screen definitions found in the_^1C_;screen file LASCNFIL._^1C_]_^1C_'CLCHNG_-Performs file maintenance/data entry of all_^1C_;non-financial data for client master file_^1C_;records._^1C_]_^1C_'CLNAME_-Performs a search for ( and then displays )_^1C_;all clients of a given name or partial name_^1C_;and provides for client retrieval ‚‚by relat-_^1C_;ive record number of the clients displayed._^1._]_^1C_]_^1C_]_^1C_]_^1C_]_^1C_2INTER - MODULE_!COMMUNICATION_^1C_2------------------------------_^1C_]_^1C_]_^1C_]_^1C_9_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_8:_/:_^1C_8:_#CLIMAC_#:_^1C_8:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_8:_/:_^1C_8:_#CLIDAT_#:_^1C_8:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_8:_/:_^1C_8:_/:_^1C_8:_#CLIE ‚‚NT_#:_^1C_8:_/:_^1C_8:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_@/\_^1C_?/::\_^1C_@::_^1C_@::_^1C_?\::/_^1C_@\/_^1C_,_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_+:_+:_#CLIMAC_#:_+:_^1C_+:_+:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_+:_^1C_+:_I:_^1C_+:_I:_^1C_+:_,C L M A I N_,:_^1C_+:_I:_^1C_+:_I:_^1C_+:_I:_^1C_+:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_-/\_0/\_0/\_^1C_,/::\_./::\_./::\_^1C_-::_0::_0::_^1C_-::_0::_0::_^1C_,\::/_.\::/_.\::/_^1C_-\/_0\/_0\/_^1C_"_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _$_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _$_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_!:_#CLIMAC_#:_":_#CLIMAC_#:_":_#CLIMAC_#:_^1C_!:----------------:_":----------------:_":----------------:_^1C_!: ‚‚_/:_":_/:_":_/:_^1C_!:_#CLCHNG_#:<-->:_#CLDISP_#:<-->:_#CLNAME_#:_^1C_!:_/:_":_/:_":_/:_^1C_!:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_":_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_":_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1._]_^1C***********************************************************************_^1C_]_^1C_]_^1C_#CLMAIN - CLIENT FILE MAINTENANCE MAIN MODULE_^1C_#_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_]_^1C_]_^1C_]_^1C_]_^1C_#THIS ROUTINE HANDLES THE FOLLOWING FUNCTIONS:_^1C_#_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_]_^1C_]_^1C_]_^1C_$1. SELECTION SCREEN HANDLER._^1C_(A. CLIENT MASTER RECORD RETRIEVAL BY CLIENT NUMBER_^1C_(B. CLIENT MASTER RECORD RETRIEVAL BY CLIE ‚‚NT NAME_^1C_(C. CLIENT STATUS INFORMATION BY CLIENT NUMBER_^1C_]_^1C_$2. SCREEN HANDLER FOR CLIENT STATUS SCREENS (ACTIVE/INACTIVE)_^1C_(A. CLIENT STATUS INQUIRY/UPDATE_^1C_]_^1C_$3. SCREEN HANDLER FOR CLIENT CHANGE AND CLIENT FINANCIAL SCREENS._^1C_(A. CLIENT NON-FINANCIAL INFORMATION INQUIRY/UPDATE (FIRM NAME,_^1C_+ADDRESS,PHONE NUMBER,ETC.)_^1C_(B. ADDITION OF NEW CLIENTS_^1C_(C ‚‚. CLIENT FINANCIAL INFORMATION INQUIRY-ONLY (PLACEMENTS,FEES,_^1C_+ACCOUNTS CLOSED,COURT COSTS,PERCENTAGES,ETC.)_^1C_]_^1C_]_^1C***********************************************************************_^1._]_^1C_]_^1C_]_^1C_3*****************************_^1C_3*_!RETRIEVE COMMON MACRO_!*_^1C_3*****************************_^1C_]_^1C_]_^11_]_^1M_#CLIMAC_^1._]_^1C************************ ‚‚***********************************************_^1C_]_^1C_]_^1C_4_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_3:_@:_^1C_3:_$MAIN-MODULE VARIABLES_$:_^1C_3:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^1C_]_^12_]_^1C**** CLIENT SCREEN #'S FOR SELECTION,CHANGE,FINANCIAL & STATUS SCREENS._^1_$INTEGER SELECT,CHANGE,FINANC,CLACT,CLN ‚‚ACT_^11_]_^1C**** MESSAGE SCREEN NUMBERS USED ONLY BY PROGRAM 'CLIENT'._^1_$INTEGER NEWCLI,BUSY,INACT,BADCLI,NEWBAD,ACTBAD_^11_]_^1C**** LOCAL VARIABLES,CONSTANTS AND BUFFERS._^1_$INTEGER EXIT,NAMESR,NUMBSR,STATUS,CLSTAT,ACTIVE(3),NACTIV(4),ID(4)_^1_$INTEGER HD(20,3),DT(3),STMSG(11),STBLNK(15),STDATE(4)_^12_]_^1C**** CLIENT SCREEN #'S FOR SELECTION,CHANGE,FINANCIAL & STATUS SCREENS ‚‚._^1_$DATA SELECT/91/,CHANGE/92/,FINANC/93/,CLACT/97/,CLNACT/98/_^11_]_^1C**** MESSAGE SCREEN NUMBERS USED ONLY BY PROGRAM 'CLIENT'._^1_$DATA NEWCLI/95/,BUSY/96/,INACT/99/,BADCLI/-3/,NEWBAD/-4/,_^1_#1_#ACTBAD/-5/_^11_]_^1C**** LOCAL VARIABLES,CONSTANTS AND BUFFERS_^1_$DATA EXIT/'E '/,NAMESR/'A,'/,NUMBSR/'N,'/,STATUS/'S,'/_^1_$DATA ACTIVE/'ACTIVE'/,NACTIV/'INACTIVE'/_^1_$DATA STMSG/ ‚‚'** CLIENT INACTIVATED '/_^1_$DATA STBLNK/15*$2020/,STDATE/4*$2020/_^1._]_^1C***********************************************************************_^1C_]_^1C_]_^1C_]_^1C_'DEFINITIONS OF VARIABLES DESCRIBING FUNCTIONS_^1C_'_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_]_^1C_]_^1C_,VARIABLE_+DEFINITION_^1C_,--------_+----------_^1C_]_ ‚‚^1C_/CS_.CLIENT SELECTION SCREEN REQUEST_^1C_]_^1C_/CC_.CLIENT CHANGE SCREEN REQUEST_^1C_]_^1C_/CF_.CLIENT FINANCIAL SCREEN REQUEST_^1C_]_^1C_/CR_.carriage return_^1C_]_^1C_]_^1C_]_^1C_,**********_)***********_(***********_^1C_]_^1C_]_^1C_]_^1C_#_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_":_<:_=:_^1C_ ‚‚":_#Values of 'RSTAT'_#:_#Values of 'CLSTAT'_#:_^1C_":_#_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _#:_#_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _#:_^1C_":_<:_=:_^1C_":_!0 = Existing Client_%:_!0 = Current function is_":_^1C_":_'( rcd on file )_$:_'not Status Inq/Update :_^1C_":_<:_=:_^1C_":_!1 = New Client_+:_!1 = Current function is_":_^1C_":_'( rcd not on file ) :_'Status/Inq/Upd ‚‚ate_#:_^1C_":_<:_=:_^1C_":_!2 = Secondary Key of rcd :_=:_^1C_":_'has been changed._":_=:_^1C_":_'Delete rcd with old :_=:_^1C_":_'key index structure :_=:_^1C_":_'and re-write rcd with:_=:_^1C_":_'new key structure._!:_=:_^1C_":_<:_=:_^1C_":_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^1C_]_^1C_]_ ‚‚^1C***********************************************************************_^1._]_^1C***********************************************************************_^1C_]_^1C_]_^1C_._ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_-:_G:_^1C_-:_$BEGIN MAIN-MODULE PROCESSING_$:_^1C_-:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚_ _ _ :_^1C_]_^1C_]_^12_]_^1C****_]_^1C**** OPEN SCREEN AND CLIENT FILES - BEGIN CLIENT FILE MAINTENANCE._^1C****_]_^11_]_^1C**** RETRIEVE LOGICAL UNIT FOR I/O._^1_$CALL PGMIN(ID,LU,I,J)_^11_]_^1C**** RETRIEVE SYSTEM DATE AND PLACE INTO MM/DD/YY FORMAT._^1_$CALL LAHEAD (HD,DT)_^1_$CALL EDIT (DT,1,STDATE,1,1)_^11_]_^1C**** OPEN SCREEN FILE._^1_$CALL OPENFL(REQBFS,IDATSC,ISTAT)_^1C ‚‚**** CHECK FOR ERROR._^1_$IF(ISTAT.GE.0) GO TO 50_^1C**** FILE ERROR IN SCREEN FILE._^1_$CALL FILERR(IDATSC,3,ISTAT,LU)_^1_$GO TO 900_^11_]_^1C**** OPEN CLIENT FILE._^1 50 CALL OPENFL(REQBFC,IDATCL,ISTAT)_^1C**** CHECK FOR ERROR._^1_$IF(ISTAT.GE.0) GO TO 100_^1C**** ERROR IN CLIENT FILE._^1_$CALL FILERR(IDATCL,3,ISTAT,LU)_^1_$GO TO 900_^13_]_^1C**** RESET NEW CLIENT FLAG._^1 100 ‚‚ RSTAT=0_^1._]_^1C****_]_^1C**** SCREEN HANDLER FOR SELECTION SCREEN._^1C****_]_^11_]_^1_$CALL CLDISP(SELECT,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^11_]_^1 150 CLSTAT=0_^11_]_^1C**** DETERMINE SELECTION._^11_]_^1_$IF(IOBUF(1).EQ.NAMESR) GO TO 200_^1+_OCLIENT NAME SEARCH_^1_$IF(IOBUF(1).EQ.NUMBSR) GO TO 300_^1+_OCLIENT NO. RETRIEVAL_^1_$IF(IOBUF(1).EQ.STATUS) GO TO 300_^1+_OCLIENT ‚‚STATUS INQ/UPD_^1_$IF(IOBUF(1).EQ.EXIT) GO TO 900_^1+_OEXIT_^11_]_^1C**** INVALID SELECTION._^1_$CALL CLDISP(INVENT,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1_$GO TO 150_^1._]_^1C****_]_^1C**** CLIENT NAME SEARCH._^1C****_]_^11_]_^1 200 CALL CLNAME_^1_$IF (JSTAT.EQ.13 .OR. JSTAT.EQ.14) GO TO 900_^11_]_^1C**** CHECK IF INPUT NAME FOUND. RETURN TO SELECTION SCREEN IF NOT FOUND_^1C**_! ‚‚IF FOUND, RETRIEVE CLIENT BY NUMBER._^1_$IF(IOBUF(1).LT.0) GO TO 100_^1_$GO TO 325_^13_]_^1C****_]_^1C**** CLIENT NUMBER RETRIEVAL. CLIENT NUMBER IS IN IOBUF._^1C****_]_^11_]_^1 300 IF (IOBUF(1).EQ.STATUS) CLSTAT=1_^11_]_^1C**** LEFT JUSTIFY CLIENT NUMBER IN IOBUF._^1_$CALL CCSMVA(IOBUF,3,NUMLEN,IOBUF,1,NUMLEN)_^11_]_^1C**** SAVE KEY VALUE._^1 325 CALL CCSMVA(IOBUF,1,NUMLEN,KEYV ‚‚AL,1,NUMLEN)_^11_]_^1C**** RETRIEVE ACCOUNT BY NUMBER._^1 350 CALL READR(REQBFC,CLIREC,KEYVAL,ISTAT)_^11_]_^1C**** IF RECORD IS LOCKED OR RECORD NOT FOUND, DISPLAY MESSAGE._^1_$IF(AND(ISTAT,LOCKED).EQ.LOCKED.OR.AND(ISTAT,WRONKY).EQ.WRONKY.OR._^1_#1_$AND(ISTAT,EOF).EQ.EOF) GO TO 500_^11_]_^1C**** CHECK FOR OTHER ERROR._^1_$IF(ISTAT.GE.0 .AND. CLSTAT.EQ.1) GO TO 400_^1_$IF(ISTAT.GE. ‚‚0) GO TO 700_^1C**** FILE ERROR._^1_$CALL FILERR(IDATCL,13,ISTAT,LU)_^1_$GO TO 900_^1._]_^1C****_]_^1C**** SCREEN HANDLER FOR CLIENT STATUS SCREENS._^1C****_]_^11_]_^1C**** RETRIEVE CURRENT STATUS OF CLIENT._^1 400 CALL CCSGET(CLIREC,1299,COMPIN)_^1_$IF (COMPIN.EQ.$31) GO TO 410_^11_]_^1C**** CURRENT CLIENT STATUS IS ACTIVE. DISPLAY ACTIVE STATUS SCREEN._^1_$CALL CLDISP(CLACT,CLIR ‚‚EC)_^1_$GO TO 425_^11_]_^1C**** CURRENT CLIENT STATUS IS INACTIVE. DISPLAY INACTIVE STATUS SCREEN._^1 410 CALL CLDISP(CLNACT,CLIREC)_^11_]_^1 425 IF (JSTAT.EQ.13) GO TO 900_^12_]_^1C**** VALIDATE ENTRY. RESPONSE MUST BE 'ACTIVE', 'INACTIVE' OR ._^11_]_^1_$IF (IOBUF(1).EQ.CR) GO TO 475_^1_$CALL CCSCST(IOBUF,1,6,ACTIVE,1,6,COMPIN)_^1_$IF (COMPIN.EQ.0) GO TO 450_^1_$CALL CCSCST( ‚‚IOBUF,1,8,NACTIV,1,8,COMPIN)_^1_$IF (COMPIN.EQ.0) GO TO 460_^11_]_^1C**** INVALID ENTRY. DISPLAY MESSAGE._^1_$CALL CLDISP(ACTBAD,DUMMY)_^1_$GO TO 425_^11_]_^1C**** RESPONSE IS ACTIVE._^1C**_!PLUG ACTIVE STATUS CODE INTO RECORD BUFFER. MOVE BLANKS TO CONTACT_^1C**_!NAME FIELD (FIELD CONTAINS INACTIVE STATUS MESSAGE AND DATE)._^1 450 CALL CCSPUT($20,1299,CLIREC)_^1_$CALL CCSMVA(STBL ‚‚NK,1,30,CLIREC,35,30)_^1_$GO TO 475_^11_]_^1C**** RESPONSE IS INACTIVE._^1C**_!PLUG INACTIVE STATUS CODE INTO RECORD BUFFER. MOVE INACTIVE STATUS_^1C**_!MESSAGE AND SYSTEM DATE INTO CONTACT NAME FIELD._^1 460 CALL CCSPUT($31,1299,CLIREC)_^1_$CALL CCSMVA(STMSG,1,22,CLIREC,35,22)_^1_$CALL CCSMVA(STDATE,1,8,CLIREC,57,8)_^12_]_^1C**** UPDATE CLIENT RECORD ACCESSED BY STATUS REQUEST._^ ‚‚1 475 CALL UPDREC(REQBFC,CLIREC,ISTAT)_^1_$IF (ISTAT.GE.0 .AND. IOBUF(1).EQ.CR) GO TO 100_^1_$IF (ISTAT.GE.0) GO TO 350_^1_$CALL FILERR(IDATCL,15,ISTAT,LU)_^1_$GO TO 900_^1._]_^1C****_]_^1C**** CLIENT NOT ON FILE OR BUSY ON SEARCH. DISPLAY APPROPRIATE MESSAGE._^1C****_]_^11_]_^1 500 IF (AND(ISTAT,LOCKED).EQ.LOCKED) GO TO 575_^1_$IF (CLSTAT.LE.0) GO TO 525_^11_]_^1C**** INVALID EN ‚‚TRY. CLIENT # NOT ON FILE FOR STATUS INQ/UPD REQUEST._^1_$CALL CLDISP(BADCLI,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1_$GO TO 150_^12_]_^1C**** NEW CLIENT._^1C**_$1. VALUE OF 'KEYVAL' MAY HAVE BEEN CLOBBERRED BY THE FILE_^1C**_(MANAGER 'READR', SO MOVE NEW KEY VALUE INTO 'KEYVAL' AGAIN._^1C**_$2. MOVE NEW KEY VALUE INTO THE MASTER FILE BUFFER._^1 525 CALL CCSMVA(IOBUF,1,NUMLEN,KEYV ‚‚AL,1,NUMLEN)_^1_$CALL CCSMVA(IOBUF,1,NUMLEN,CLIREC,1,1300)_^11_]_^1C**** DISPLAY NEW CLIENT MESSAGE SCREEN._^1_$RSTAT=1_^1_$CALL CLDISP(NEWCLI,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1 550 IF (IOBUF(1).EQ.CR) GO TO 700_^1_$IF (IOBUF(1).EQ.CS) GO TO 100_^11_]_^1C**** INVALID ENTRY. ASK FOR RE-ENTRY._^1_$CALL CLDISP(NEWBAD,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1_$GO TO 550_^11_]_^1 ‚‚575 CALL CLDISP(BUSY,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1_$GO TO 150_^1._]_^1C****_]_^1C**** SCREEN HANDLER FOR CHANGE AND FINANCIAL SCREENS._^1C****_]_^11_]_^1C**** CHECK ENTRY FOR NEXT REQUEST._^1 600 IF (IOBUF(1).EQ.CC) GO TO 700_^1_$IF (IOBUF(1).EQ.CF) GO TO 750_^1_$IF (IOBUF(1).EQ.CS) GO TO 100_^11_]_^1C**** INVALID ENTRY FROM SCREEN. ASK FOR REENTRY._^1_$CALL CLDISP(INV ‚‚ENT,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1_$GO TO 600_^12_]_^1C**** DISPLAY CLIENT CHANGE SCREEN. IF CLIENT IS INACTIVE, DISPLAY_^1C**_!INACTIVE CLIENT MESSAGE._^11_]_^1C**** RETRIEVE CURRENT CLIENT STATUS._^1 700 CALL CCSGET(CLIREC,1299,COMPIN)_^1_$IF (COMPIN.NE.$31) GO TO 725_^1C**** CLIENT STATUS IS INACTIVE. DISPLAY INACTIVE CLIENT MESSAGE._^1_$CALL CLDISP(INACT,CLIREC)_^1_$ ‚‚IF (JSTAT.EQ.13) GO TO 900_^11_]_^1C**** CHECK RESPONSE TO INACTIVE CLIENT MESSAGE. VALID RESPONSES ARE_^1C**_!'CC', 'CF', 'CS' AND ._^1 710 IF (IOBUF(1).EQ.CR .OR. IOBUF(1).EQ.CC) GO TO 725_^1_$IF (IOBUF(1).EQ.CF) GO TO 750_^1_$IF (IOBUF(1).EQ.CS) GO TO 800_^11_]_^1C**** INVALID RESPONSE. ASK FOR RE-ENTRY._^1_$CALL CLDISP(INVENT,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1_$GO TO ‚‚ 710_^11_]_^1C**** DISPLAY CLIENT CHANGE SCREEN._^1 725 CALL CLDISP(CHANGE,CLIREC)_^1_$IF (JSTAT.EQ.13) GO TO 900_^11_]_^1C**** PERFORM CHANGE SCREEN FUNCTIONS._^1_$CALL CLCHNG(CLIREC,CLICHG)_^1_$IF (JSTAT.EQ.13 .OR. JSTAT.EQ.14) GO TO 900_^11_]_^1C**** UPON RETURN, IOBUF(1) CONTAINS A VALID NEXT FUNCTION REQUEST._^1_$IF (IOBUF(1).EQ.CS) GO TO 800_^12_]_^1C**** DISPLAY FINANCIAL H ‚‚ISTORY SCREEN BY ACCOUNT TYPE._^1 750 CALL CLDISP(FINANC,CLIREC)_^1_$IF (JSTAT.EQ.13) GO TO 900_^1._]_^1C****_]_^1C**** IF FUNCTION IS 'CS', THEN UPDATE RECORD FOR CHANGE SCREEN ENTRIES._^1C****_]_^11_]_^1 800 IF (IOBUF(1).NE.CS) GO TO 600_^12_]_^1_$IF (RSTAT.LT.2) GO TO 825_^1C**** SECONDARY KEY (FIRM NAME) HAS BEEN CHANGED IN AN EXISTING RECORD._^1C**_!DELETE THE RECORD AND RES ‚‚ET THE NEW CLIENT FLAG TO RE-WRITE RECORD_^1_$RSTAT=1_^1_$CALL CCSMVA(CLIREC,1,10,NEWKEY,1,10)_^1_$CALL CCSMVA(OLDKEY,1,10,CLIREC,1,10)_^1_$CALL DELREC(REQBFC,CLIREC,ISTAT)_^1_$CALL CCSMVA(NEWKEY,1,10,CLIREC,1,10)_^1_$IF (ISTAT.GE.0) GO TO 825_^1_$CALL FILERR(IDATCL,16,ISTAT,LU)_^1_$GO TO 900_^11_]_^1 825 IF (RSTAT.LT.1) GO TO 850_^1C**** NEW CLIENT OR NEW SECONDARY KEY._^1C**_!WR ‚‚ITE THE RECORD AND RESET THE NEW CLIENT FLAG._^1_$RSTAT=0_^1_$CALL WRITER(REQBFC,CLIREC,KEYVAL,ISTAT)_^1_$IF (ISTAT.GE.0) GO TO 600_^1_$CALL FILERR(IDATCL,12,ISTAT,LU)_^1_$GO TO 900_^11_]_^1C**** UPDATE EXISTING RECORD._^1 850 CALL UPDREC(REQBFC,CLIREC,ISTAT)_^1_$IF (ISTAT.GE.0 .AND. CLSTAT.EQ.1) GO TO 350_^1_$IF (ISTAT.GE.0) GO TO 600_^1_$CALL FILERR(IDATCL,15,ISTAT,LU)_^13_]_^1C ‚‚**** END OF CLIENT FILE MAINTENANCE PROCESSING._^11_]_^1C**** END OF MODULE. CLOSE FILES AND RETURN._^1 900 CALL CLOSFL (REQBFC,ISTAT)_^1_$CALL CLOSFL (REQBFS,ISTAT)_^11_]_^1_$RETURN_^12_]_^1_$END_]_^__ ‚‚CLNAME CSY/ F07 4620 ‚‚1_$SUBROUTINE CLNAME_^1_#1_2/F07 F LA_!CCS 3.0_5SL-149_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_]_^1C_2_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_1:_@:_^1C_1: NAME-SEARCH MODULE SUBROUTINE :_^1C_1:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^1C_]_^1C_]_^1C***********************************************************************_^1._]_^1C***********************************************************************_^1C_]_^1C_]_^1C_,CLNAME - CLIENT FILE MAINTENANCE NAME-SEARCH MODULE_^1C_,_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚ _ _ _ _ _^1C_]_^1C_]_^1C_]_^1C_#ROUTINE TO SEARCH THE L/A CLIENT MASTER FOR A SELECTED NAME._^1C_]_^1C_#THE MASTER FILE CONTAINS TWO KEYS , THE SECONDARY KEY BEING THE_^1C_#FIRST SIX CHARACTERS OF THE CLIENT FIRM NAME. AN INITIAL FILE_^1C_#MANAGER 'READR' REQUEST USING THE SECONDARY KEY IS PERFORMED TO_^1C_#POSITION TO THE START OF THOSE RECORDS WITH THE CORRECT KEY._^1C_#THEN SU ‚‚CCESSIVE FILE MANAGER 'GETS' REQUESTS ARE PERFORMED TO_^1C_#EXTRACT ALL CLIENT RECORDS MATCHING THE INPUT NAME OR PARTIAL_^1C_#NAME._^1C_]_^1C_#AS THE CLIENTS ARE RETRIEVED, ONE LINE FOR EACH IS DISPLAYED TO_^1C_#THE CRT CONTAINING THE FIRM NAME, ADDRESS LINE ONE AND THE CLIENT_^1C_#NUMBER OF THE RECORD RETRIEVED. A MAXIMUM OF NINE RECORDS ( LINES_^1C_#OF DATA ) ARE DISPLAYED ON T ‚‚HE SCREEN AT ONE TIME._^1C_]_^1C_#WHEN THE LAST RECORD WITH A MATCHING NAME HAS BEEN RETRIEVED OR_^1C_#WHEN THE SCREEN IS FULL ( NINE LINES OF DATA DISPLAYED ), A PROMPT_^1C_#IS ISSUED PROVIDING THE OPERATOR WITH THREE OPTIONS:_^1C_,1. SELECT A CLIENT LISTED ON THE SCREEN ( BY RELATIVE_^1C_0RECORD NUMBER )_^1C_,2. CONTINUE THE NAME-SEARCH_^1C_,3. DISCONTINUE THE NAME-SEARCH AND ‚‚RETURN TO THE_^1C_0SELECTION SCREEN._^1C_]_^1C_#UPON COMPLETION OF SEARCH, AN 'END OF SEARCH' MESSAGE IS ISSUED._^1C_]_^1C_#THE RETURN INDICATOR FOR NAME FOUND OR NOT FOUND IS THE CLIENT_^1C_#NUMBER ARRAY RETURNED IN 'IOBUF'. IF NO RECORD MATCHING THE INPUT_^1C_#NAME OR PARTIAL NAME IS FOUND, THE FIRST POSITION OF THE CLIENT_^1C_#NUMBER ARRAY ( FIRST CHARACTER OF 'IOBUF' ) IS SET ‚‚TO -1._^1C_]_^1C_]_^1C_]_^1C***********************************************************************_^1._]_^1C_]_^1C_]_^1C_3*****************************_^1C_3*_!RETRIEVE COMMON MACRO_!*_^1C_3*****************************_^1C_]_^1C_]_^11_]_^1M_#CLIMAC_^1._]_^1C***********************************************************************_^1C_]_^1C_]_^1C_2_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_1:_?:_^1C_1: NAME-SEARCH-MODULE VARIABLES :_^1C_1:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^1C_]_^12_]_^1C**** CLIENT NUMBER ARRAY._^1_$INTEGER NUMSAV(18)_^11_]_^1C**** LOCAL VARIABLES,CONSTANTS AND BUFFERS_^1_$INTEGER CLIPOS,AD1PS,ADLEN,ADPOS,ENDLEN,ENDMSG(9),KEYLEN,LF_^1_$INTEGER NAMLEN,SERMES,SAVLEN,SAVW13,NAMPOS ‚‚,NAMSAV(15),KEY(3)_^12_]_^1C**** LOCAL VARIABLES,CONSTANTS AND BUFFERS REQUIRING INITIALIZATION._^1_$DATA CLIPOS/67/,AD1PS/65/,ADLEN/30/,ADPOS/35/,ENDLEN/18/_^1_$DATA NAMPOS/5/,NAMLEN/30/,SERMES/66/,LF/$A00/_^1_$DATA ENDMSG/$D0D,'_!END OF SEARCH'/_^13_]_^1C***********************************************************************_^1C_]_^1C_]_^1C_/_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ ‚‚_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _^1C_.:_F:_^1C_.: BEGIN NAME-SEARCH-MODULE PROCESSING :_^1C_.:_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ :_^1C_]_^1C_]_^12_]_^1C**** TWEAK FILE MANAGER REQUEST BUFFER FOR L/A CLIENT MASTER FILE TO_^1C**_!ALLOW RETRIEVAL BY KEY 2, THE FIRST SIX CHARACTERS OF CLIENT'S_^1C**_!NAME._^1_$REQBFC(14) = 2_^11_]_^1 ‚‚C**** SAVE CURRENT VALUE OF WORD 13 OF REQUEST BUFFER, THEN CLEAR_^1C**_!RECORD LOCKING FLAG._^1_$SAVW13 = REQBFC(13)_^1_$REQBFC(13) = AND($7FFF,REQBFC(13))_^11_]_^1C**** INTIALIZE RETURN VALUE FOR CONTINUE SEARCH REQUEST._^1_$ASSIGN 190 TO IRTN_^11_]_^1C**** GET LENGTH OF INPUT NAME TO SEARCH FOR._^1_$SAVLEN = IOBUF(41) - 2_^1C**** LENGTH CANNOT BE GREATER THAN 30._^1_$IF(SAVLEN.G ‚‚T.30) SAVLEN = 30_^1C**** IF LENGTH IS ZERO, RETURN NAME NOT FOUND._^1_$IF(SAVLEN.EQ.0) GO TO 850_^11_]_^1C**** INITIALIZE OUTPUT COUNTER._^1_$N = 0_^1C**** BLANK KEY POSITIONS OF NAME SAVE ARRAY._^1_$CALL CCSBLK(NAMSAV,6)_^1C**** SAVE NAME._^1_$CALL CCSMVA(IOBUF,3,SAVLEN,NAMSAV,1,SAVLEN)_^1C**** SAVE FILE KEY TO PERFORM READR REQUEST WITH._^1_$DO 50 I=1,3_^1 50 KEY(I) = NAMSAV(I ‚‚)_^11_]_^1C**** SET LENGTH OF KEY FOR LATER COMPARISONS._^1_$KEYLEN = 6_^1C**** IF LENGTH IS LESS THAN SIX, THE KEYLEN IS SAVLEN._^1_$IF(SAVLEN.LT.6) KEYLEN = SAVLEN_^11_]_^1C**** CLEAR SCREEN._^1_$CALL WTREAD(LU,XYN,CLRSCR,1,0,0,0,TC)_^12_]_^1C**** PERFORM INITIAL READR._^1_$CALL READR(REQBFC,CLIREC,KEY,ISTAT)_^1C**** CHECK FOR END OF FILE TERMINATING SEARCH._^1_$IF(AND(ISTAT,EOF) ‚‚.EQ.EOF) GO TO 115_^1C**** CHECK FOR OTHER ERROR_^1 70 IF(ISTAT.LT.0) GO TO 800_^1C**** CHECK FOR MATCH BY KEYLEN CHARACTERS. SEARCH IS COMPLETE IF THE_^1C**_!RETRIEVED NAME IS GREATER THAN THE NAME IN SEARCH FOR KEYLEN CHAR-_^1C**_!ACTERS._^1 100 CALL CCSCST(CLIREC,NAMPOS,KEYLEN,NAMSAV,1,KEYLEN,COMPIN)_^1_$IF(COMPIN.LE.0) GO TO 120_^1C**** END OF SEARCH. SET FLAG AND DISPLAY EN ‚‚D OF SEARCH MESSAGE._^1 115 N = -AND($F,N)_^1_$CALL WTREAD(LU,XYN,ENDMSG,ENDLEN,0,0,0,TC)_^1C**** SET RETURN VALUE FOR CONTINUE SEARCH REQUEST TO AN INVALID REQUEST_^1_$ASSIGN 170 TO IRTN_^1_$GO TO 160_^11_]_^1C**** COMPARISON BY KEYLEN OK. CHECK FOR MATCH BY ENTIRE LENGTH OF INPUT_^1C**_!NAME. BYPASS THIS CHECK IF KEYLEN IS THE LENGTH OF INPUT NAME._^1 120 IF(SAVLEN.LE.6) GO TO ‚‚140_^1_$CALL CCSCST(CLIREC,NAMPOS,SAVLEN,NAMSAV,1,SAVLEN,COMPIN)_^1_$IF(COMPIN.NE.0) GO TO 150_^11_]_^1C**** CLIENT MATCHING NAME FOUND. BLANK OUTPUT BUFFER AND MOVE IN NAME,_^1C**_!ADDRESS, AND CLIENT NUMBER FOR DISPLAY._^1 140 CALL CCSBLK(OBUF,OUTBYT)_^1_$CALL CCSMVA(CLIREC,NAMPOS,NAMLEN,OBUF,4,NAMLEN)_^1_$CALL CCSMVA(CLIREC,AD1PS,ADLEN,OBUF,ADPOS,ADLEN)_^1_$CALL CCSMVA(CLIREC,1 ‚‚,NUMLEN,OBUF,CLIPOS,NUMLEN)_^1C**** PLACE ITEM NUMBER IN FRONT OF LINE._^1_$N = N + 1_^1_$OBUF(1) = LF + $30 + N_^1C**** PUT LINE FEED/CARRIAGE RETURN AT END OF OBUF._^1_$OBUF(40) = LF + $D_^1C**** OUTPUT LINE DISPLAYING THIS ACCOUNT._^1_$CALL WTREAD(LU,XYN,OBUF,OUTBYT,0,0,0,TC)_^11_]_^1C**** SAVE ACCOUNT NUMBER._^1_$K = 4*(N-1) + 1_^1_$CALL CCSMVA(CLIREC,1,NUMLEN,NUMSAV,K,NUMLEN)_ ‚‚^11_]_^1C**** CHECK IF SCREEN FULL._^1_$IF(N.GE.9) GO TO 155_^11_]_^1C**** SCREEN NOT FULL. RETRIEVE NEXT NAME._^1 150 CALL GETS(REQBFC,CLIREC,KEY,ISTAT)_^1C**** CHECK FOR END-OF-FILE INDICATING END OF SEARCH._^1_$IF(AND(ISTAT,EOF).EQ.EOF) GO TO 115_^1C**** CHECK FOR ERROR OTHER THAN RECORD LOCKED._^1_$IF(ISTAT.LT.0.AND.AND(ISTAT,LOCKED).NE.LOCKED) GO TO 810_^1C**** NO ERROR. CHEC ‚‚K RETRIEVED NAME._^1_$GO TO 100_^12_]_^1C**** SCREEN FULL. OUTPUT PROMPT FOR ACTION DESIRED. SET 'N' TO ALLOW A_^1C**_!CLIENT SELECTION BY INDEX NUMBER._^1 155 N = -9_^1 160 CALL CLDISP(SERMES,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 950_^11_]_^1C**** CHECK FOR A CARRIAGE RETURN TO CONTINUE SEARCH._^1 165 IF(IOBUF(41).EQ.0) GO TO IRTN_^1C**** CHECK FIRST CHARACTER._^1_$CALL CCSGET(IOBU ‚‚F,1,J)_^1C**** CHECK FOR A 'D', DISCONTINE SEARCH._^1_$IF(J.EQ.$44) GO TO 850_^1C**** CHECK FOR A NUMBER ($30-$39) INDICATING CLIENT SELECTION._^1_$IF(J.GE.$31.AND.J.LE.$39) GO TO 180_^11_]_^1C**** INVALID RESPONSE. REPORT ERROR AND ASK FOR REENTRY._^1 170 CALL CLDISP(INVENT,DUMMY)_^1_$IF (JSTAT.EQ.13) GO TO 950_^1_$GO TO 165_^12_]_^1C**** NAME FOUND AND SELECTED. MOVE CLIENT NUMB ‚‚ER TO IOBUF AND RETURN._^1C**_!VERIFY SELECTED NUMBER HAS A CLIENT NUMBER ASSOCIATED WITH IT ON_^1C**_!THE SCREEN._^1 180 J = AND($F,J)_^1_$IF(J+N.GT.0) GO TO 170_^1C**** SELECTED NUMBER OK, FIND AND MOVE CLIENT NUMBER._^1_$J = 4*(J-1) + 1_^1_$CALL CCSMVA(NUMSAV,J,NUMLEN,IOBUF,1,NUMLEN)_^1_$GO TO 900_^11_]_^1C**** CONTINUE SEARCH._^1C**_!SEARCH STILL ACTIVE, RESET N, CLEAR SCREEN, ‚‚ AND GET NEXT CLIENT._^1 190 N = 0_^1_$CALL WTREAD(LU,XYN,CLRSCR,1,0,0,0,TC)_^1_$GO TO 150_^1C****_]_^1C**** FILE ERRORS._^1C****_]_^11_]_^1C**** READR REQUEST._^1 800 JSTAT=13_^1_$GO TO 820_^11_]_^1C**** GETS REQUEST._^1 810 JSTAT=14_^1 820 CALL FILERR(IDATCL,JSTAT,ISTAT,LU)_^1C**** FILE ERRORS ARE FATAL. RETURN._^1_$GO TO 950_^12_]_^1C**** CLIENT NAME NOT FOUND. RETURN WITH I ‚‚NDICATOR SET TO -1._^1 850 IOBUF(1) = -1_^12_]_^1C**** NORMAL EXIT. RESET FILE MANAGER REQUEST BUFFER TO ALLOW RETRIEVAL_^1C**_!BY KEY 1, CLIENT NUMBER._^1 900 REQBFC(14) = 1_^1C**** RESET WORD 13 OF REQUEST BUFFER FOR RECORD LOCKING._^1_$REQBFC(13) = SAVW13_^11_]_^1C**** NAME-SEARCH COMPLETE. RETURN._^11_]_^1 950 RETURN_^12_]_^1_$END_]_^__ ‚‚MON04 CSY/ 16460 ‚‚1 MON_]_^1 OPT LPC_]_^__ ‚‚LEGMAC CSY/ F06 0010 ‚‚1_$MACRO LEGMAC_^1_#1_2/F41 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#MACRO COMMON DECLARATIONS FOR ON-LINE LEGAL 2.0 PROGRAMS._^1C_]_^11_]_^1C_#FILE MANAGER IDATA WORDS FOR DELINQUENT MASTER, SCREEN, TRANSACTIO_^1C_#DAILY ASSIGNMENT, A ‚‚ND TRANSACTION BACKUP FILES._^1_$INTEGER IDATDM(15),IDATSC(15),IDATTR(15),IDATDA(15),IDATAU(15)_^1_$INTEGER IDATTB(15)_^1_$COMMON/A/IDATDM,IDATSC,IDATTR,IDATDA,IDATAU_^1_$COMMON/A/IDATTB_^11_]_^1C_#FILE MANAGER REQUEST BUFFERS FOR DELINQUENT MASTER, SCREEN, TRANS-_^1C_#ACTION, DAILY ASSIGNMENT, TRANSACTION BACKUP, AND FLOATER FILES._^1_$INTEGER REQBFD(24),REQBFS(24),REQBFT(24),REQB ‚‚FA(24),REQBFF(24)_^1_$INTEGER REQBFB(24)_^1_$COMMON/A/REQBFD,REQBFS,REQBFT,REQBFA,REQBFF_^1_$COMMON/A/REQBFB_^11_]_^1C_#CHANGE SCREEN ITEM FIELD DESCRIPTION ARRAYS._^1_$INTEGER CUSCHG(91),COSCHG(91),SUPCHG(61)_^1_$COMMON/A/CUSCHG,COSCHG,SUPCHG_^11_]_^1C_#FILE MANAGER RECORD BUFFERS._^1_$INTEGER MASREC(1000),COSREC(250),TRNSBF(71),AVMAT(160),ACODE,_^1_#1_$ACTHST(250),ACTYPE,NCOS,VAL ‚‚ACT(32),ARCODE,STATCD_^1_$EQUIVALENCE (COSREC(1),ACTHST(1))_^1_$BYTE (ACODE,TRNSBF(53)(15=8))_^1_$EQUIVALENCE(AVMAT(1),VALACT(1))_^1_$BYTE (ACTYPE,MASREC(1)(11=8)),(NCOS,MASREC(469)(3=0)),_^1_#1_$(ARCODE,MASREC(146)(15=8)),(STATCD,MASREC(153)(7=0))_^1_$COMMON/A/MASREC,COSREC,TRNSBF,AVMAT_^1C_]_^11_]_^1C_#INPUT/OUTPUT BUFFERS._^1_$INTEGER IOBUF(41),OBUF(46),OFAREA(1)_^1_$EQUIVALENCE ‚‚ (OBUF(41),OFAREA(1))_^1_$COMMON/A/IOBUF,OBUF_^11_]_^1C_#FIRST ACTIVITY STRING AND WORKING ACTIVITY STRING._^1_$INTEGER FSTACT(36),STRING(36),ACT,RES,LTR,COM(28)_^1_$EQUIVALENCE (STRING(4),ACT),(STRING(5),RES),(STRING(6),LTR),_^1_#1_$(STRING(9),COM(1))_^1_$COMMON/A/FSTACT,STRING_^11_]_^1C_#SMALL VARIABLES AND BUFFERS._^1_$INTEGER DATE(3),LS,LU,TC,ISTAT,COMPIN,LENGTH,FLDTYP,STRPOS,L ‚‚INSTR_^1_$INTEGER ACTRET,CID(2),NUMACT,QBREAK,VALQ(16),KEY(9),MAXNCD,MONTH_^1_$INTEGER NAMSAV(15),PPLAG,LETREQ,COMREQ,NCD,OSW,DAY,YEAR,UFLAG_^1_$INTEGER COLTYP,NXTYR,JDATE,TRBKFL,COSFLG,NAEQRL_^1_$INTEGER LTRNUM(50),ACTCNT_^1_$EQUIVALENCE (ISTAT,OSW),(DATE(1),MONTH),(DATE(2),DAY),_^1_#1_$(DATE(3),YEAR)_^1_$COMMON/A/DATE,LS,LU,TC,ISTAT,COMPIN,LENGTH,FLDTYP,STRPOS,LINSTR_^1_$COMMON/A ‚‚/ACTRET,CID,NUMACT,QBREAK,VALQ,KEY,MAXNCD,UFLAG_^1_$COMMON/A/NAMSAV,PPLAG,LETREQ,COMREQ,NCD,COLTYP,NXTYR_^1_$COMMON/A/JDATE,LTRNUM,ACTCNT,TRBKFL,COSFLG,NAEQRL_^12_]_^1C_#CONSTANTS._^11_]_^1C_#NUMERIC._^1_$INTEGER ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,NINE_^1_$COMMON/A/ZERO,ONE,TWO,THREE,FOUR,FIVE,SIX,NINE_^11_]_^1C_#ASCII CONSTANTS._^1_$INTEGER LMASBL(2),ASC00,ASC01,TYPE1,TYPE2,BZ,OK,SR ‚‚,PP,RL,CNTURY_^1_$INTEGER BLANKS_^1_$EQUIVALENCE (ASC01,TYPE1)_^1_$COMMON/A/LMASBL,ASC00,ASC01,TYPE2,BZ,OK,SR,PP,RL,CNTURY,BLANKS_^11_]_^1C_#FILE POSITIONS AND LENGTHS AND BUFFER LENGTHS._^1_$INTEGER OLDPOS,NEWPOS,NAMPOS,NUMLEN,OUTBYT,INPBYT,COMLEN,STRLEN_^1_$INTEGER CURBAL,MPPAMT,MPPDAT,TPPAMT,TPPDAT,TLTAMT,MLTRAM,MLTRDT_^1_$INTEGER MNCD,TNCD,PPMADE,TLDT,PPFLAG_^1_$EQUIVALENCE (OU ‚‚TBYT,INPBYT)_^1_$COMMON/A/OLDPOS,NEWPOS,NAMPOS,NUMLEN,OUTBYT,COMLEN,STRLEN_^1_$COMMON/A/CURBAL,MPPAMT,MPPDAT,TPPAMT,TPPDAT,TLTAMT,MLTRAM,MLTRDT_^1_$COMMON/A/MNCD,TNCD,PPMADE,TLDT,PPFLAG_^11_]_^1C_#DUMMY VARIABLE._^1_$INTEGER DUMMY_^1_$COMMON/A/DUMMY_^11_]_^1C_#FILE MANAGER STATUS CONSIDERATIONS._^1_$INTEGER LOCKED,WRONKY,EOF_^1_$COMMON/A/LOCKED,WRONKY,EOF_^11_]_^1C_#SCREEN DISPLAY ‚‚CONSTANTS._^1_$INTEGER XYWORD(3),XYN,CLRSCR_^1_$COMMON/A/XYWORD,XYN,CLRSCR_^11_]_^1C_#MESSAGE SCREEN NUMBERS FOR MESSAGES USED IN MORE THAN ONE MODULE._^1_$INTEGER INVENT,NXTFUN,CSNXTF,INVRES,COMRQD,COMLNG,INVNCD,NOACT_^1_$INTEGER INVCOM,ENCD,FE_^1_$COMMON/A/INVENT,NXTFUN,CSNXTF,INVRES,COMRQD,COMLNG,INVNCD,NOACT_^1_$COMMON/A/INVCOM,ENCD,FE_^12_]_^1C_#END OF COMMON DECLARATION._^1_$ ‚‚END_]_^__ ‚‚FLEGAL CSY/ F09 3660 ‚‚1_$SUBROUTINE FLEGAL_^1_#1_2/F09 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#LEGAL ON-LINE PROGRAM MAIN MODULE._^1C_]_^1C_#THIS PROGRAM HANDLES THE FOLLOWING FUNCTIONS:_^1C_$1. LOGIN VALIDATION AND INTIALIZATION._^1C_$2. SELECTION SCREEN ‚‚HANDLER._^1C_$3. AUTOMATIC DAILY ASSIGNMENT FILE PROCESSOR._^1C_$4. COSIGNER'S NAME SEARCH._^1C_$5. ACCOUNT NUMBER RETRIEVAL OF AN ACCOUNT._^1C_$6. SCREEN HANDLER FOR ALL ACCOUNT SCREENS._^1C_]_^11_]_^1C_#RETRIEVE COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER ASTRKS,AUTO,BUSY,COLFLG,COLPTR(2),COS1PS,DASCRN_^1_$INTEGER COSRN1,COSRN2,COSLEN,COSNSR,COSRCH,CUR ‚‚RQP,DAREC(20),DCSCRN_^1_$INTEGER DUPKEY,EOFDA,EXIT,FNSCRN,ID(1),INVLOG,INVSEL,LOGIN_^1_$INTEGER MASCRN,NAMESR,NOTFND,NUMBSR,OAACCT,OLPM(2),QINIT,RDELET_^1_$INTEGER RLCNT,RLCNTS(15),RLPTR(30),SAVLEN,SELECT,SUPSRN,WRONGQ_^1_$INTEGER RLFLAG,IDATAM(15),IDATCS(15),IDATQ(15),IDATUT(15),RLWAIT_^1_$INTEGER LTR1(2),LTR2(2),LSUB,LL,COSKEY(8),NOFILE,LAPYEN_^1_$EQUIVALENCE (RDELET,DUPKEY),(DAR ‚‚EC(1),ID(1))_^1_$DATA ASTRKS/'**'/,AUTO/'A '/,BUSY/36/,COLFLG/-1/,NNINPT/0/_^1_$DATA COLPTR/0,0/,COS1PS/20/,COSRN1/4/,COSRN2/94/,COSLEN/115/_^1_$DATA COSNSR/'C,'/,DCSCRN/33/,DUPKEY/$10/,EOFDA/1/,EXIT/'E '/_^1_$DATA FNSCRN/20/,INVSEL/65/,LOGIN/30/,WRONGQ/38/_^1_$DATA MASCRN/10/,NAMESR/'B,'/,NOTFND/37/,NUMBSR/'N,'/,OAACCT/246/_^1_$DATA OLPM/'OLPM'/,QINIT/0/,RLCNT/0/,RLCNTS/15*0/,RLPT ‚‚R/30*0/_^1_$DATA RLFLAG/0/,SELECT/31/,SUPSRN/35/,COSRCH/34/,DASCRN/2/_^1_$DATA LTR1/'LTR1'/,LTR2/'LTR2'/,NOFILE/$8002/,LAPYEN/'P '/_^1C**********************************************************138**L/A_^1_$DATA IDATAM/'LAACTVTB_/',0,1,0/_^1_$DATA IDATCS/'LACOSIGN_/',1,1,1/_^1_$DATA IDATQ /'LADAQUE_0',1,1,0/_^1_$DATA IDATUT/'LAUTIFIL_/',1,1,0/_^1C*********************************** ‚‚***********************138**L/A_^12_]_^1C_#ASCII MONTH, DAY, AND YEAR IN SYSTEM._^1_$EXTERNAL AMONTO,ADAYTO,AYERTO_^1._]_^1C_]_^1C_#LOGIN AND INTIALIZATION SECTION._^1C_]_^11_]_^1C_#RETRIEVE LOGICAL UNIT FOR I/O._^1_$CALL PGMIN(ID,LU,I,J)_^11_]_^1C_#OPEN SCREEN FILE._^1_$CALL OPENFL(REQBFS,IDATSC,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.GE.0) GO TO 5_^1C_#FILE ERROR IN SCREEN FILE ‚‚._^1_$CALL FILERR(IDATSC,THREE,ISTAT,LU)_^1_$CALL LCLANX_^11_]_^1C_#PROMPT FOR ENTRY OF COLLECTOR ID FOR USE WITHIN LEGAL ._^1_!5 CALL LDSPLY(LOGIN,DUMMY)_^11_]_^1C_#CHECK FOR ENTRY OF AN ID._^1_$IF(IOBUF(41).GT.0) GO TO 15_^1C_#ILLEGAL LOGIN._^1 10 CALL LCLANX_^11_]_^1C_#DETERMINE IF THIS IS A TRAINEE SIGNING ON._^1 15 CALL CCSGET(IOBUF,ONE,K)_^1_$IF(K.NE.$54) GO TO 17_^1C_#Y ‚‚ES, HAVE A TRAINEE. SET FLAG TO BYPASS FILE WRITE OPERATIONS AND_^1C_#MOVE COLLECTOR ID TO BEGINNING OF IOBUF._^1_$UFLAG = -1_^1_$CALL CCSMVA(IOBUF,TWO,FOUR,IOBUF,ONE,FOUR)_^11_]_^1C_#OPEN UTILITY FILE AND RETRIEVE COLLECTOR ID RECORD._^1 17 CALL OPENFL(REQBFF,IDATUT,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 50_^11_]_^1C_#NO ERROR, RETRIEVE RECORD USING COLLECTOR ID A ‚‚S KEY._^1_$CALL READR(REQBFF,MASREC,IOBUF,ISTAT)_^1C_#IF WRONG KEY OR END-OF-FILE, RECORD DOES NOT EXIST. ILLEGAL LOGIN._^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 10_^1C_#CHECK FOR OTHER ERRORS._^1_$IF(ISTAT.LT.0) GO TO 55_^11_]_^1C_#HAVE VALID COLLECTOR. SAVE COLLECTOR ID, AND STORE COLLECTOR ID,_^1C_#PORT NUMBER, AND LOGIN TIME IN ACTIVE USER FILE._^11_]_ ‚‚^1_$OBUF(1) = MASREC(1)_^1_$OBUF(2) = MASREC(2)_^1_$OBUF(3) = J_^1_$CALL CCSTIM(OBUF(4))_^1C_#OPEN THE ACTIVE USER FILE._^1_$CALL OPENFL(REQBFD,IDATAU,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 25_^1C_#NO ERROR, SAVE THE RECORD._^1_$CALL WRITER(REQBFD,OBUF,OBUF(1),ISTAT)_^1C_#IF DUPLICATE KEY WRITE ATTEMPT, ILLEGAL LOGIN. ANOTHER USER HAS TH_^1C_#COLLECTOR ID IN USE._^1_ ‚‚$IF(AND(ISTAT,DUPKEY).EQ.DUPKEY) GO TO 10_^1C_#CHECK FOR OTHER ERROR._^1_$IF(ISTAT.LT.0) GO TO 30_^1C_#COLLECTOR LOGGED AS ACTIVE. CLOSE ACTIVE USER FILE AND ZERO REQUES_^1C_#BUFFER USED._^1_$CALL CLOSFL(REQBFD,ISTAT)_^1_$DO 20 I=1,24_^1 20 REQBFD(I) = 0_^1_$GO TO 40_^12_]_^1C_#FILE ERROR WHILE LOGGING COLLECTOR INTO ACTIVE USER FILE._^11_]_^1C_#OPEN FILE ERROR._^1 25 J = 3_^1_ ‚‚$GO TO 35_^11_]_^1C_#WRITER ERROR._^1 30 J = 12_^11_]_^1C_#REPORT ERROR, CLOSE ALL FILES, AND EXIT._^1 35 CALL FILERR(IDATAU,J,ISTAT,LU)_^1_$CALL LCLANX_^12_]_^1C_#SAVE COLLECTOR ID AND COLLECTOR TYPE: < 0, CLERICAL; = 0, COLLECTO_^1C_#AND > 0, SUPERVISOR. ACTUAL LOG-IN ID SAVED IN TRANSACTION_^1C_#FILE BUFFER. CID CONTAINS FIRST FOUR CHARCTERS OF THE LAST NAME_^1C_#WHICH IS US ‚‚ED IN PLACE OF COLLECTOR ID IN ACTIVITY HISTORY_^1C_#DISPLAY._^1 40 CID(1) = MASREC(3)_^1_$CID(2) = MASREC(4)_^1_$TRNSBF(9) = MASREC(1)_^1_$TRNSBF(10) = MASREC(2)_^1_$COLTYP = AND(MASREC(18),$F) - 1_^11_]_^1C_#SAVE QUEUES, ASSIGNED AND ALLOWED._^1_$K = 40_^1_$DO 45 I=1,32_^1C_#RETRIEVE NEXT CHARACTER FROM QUEUE ASSIGNMENT LIST._^1 42 CALL CCSGET(MASREC,I+K,J)_^1C_#CHECK FOR A C ‚‚OMMA INDICATING BREAK BETWEEN ASSIGNED AND ALLOWED._^1_$IF(J.NE.$2C) GO TO 45_^1C_#FOUND COMA. SAVE THE WORD THE BREAK BETWEEN QUEUES OCCURRED._^1C_#CHECK FOR MORE THAN ONE COMMA INDICATING ERROR IN RECORD SETUP._^1_$IF(QBREAK.NE.-1) GO TO 60_^1_$QBREAK = (I+1)/2_^1C_#SKIP OVER COMMA TO START SAVING ALLOWED QUEUES._^1_$K = K + 1_^1_$GO TO 42_^11_]_^1C_#SAVE THIS CHARACTER IN VALID ‚‚QUEUE LIST._^1 45 CALL CCSPUT(J,I,VALQ)_^12_]_^1C_#RETRIEVE ON-LINE PARAMETERS RECORD. CONTAINS COUNT FOR RL CODE, DA_^1C_#LAG FOR BROKEN PROMOSES TO PAY CHECK, AND MAXIMUM DAYS IN THE FUTU_^1C_#THE COLLECTOR CAN SET NEXT CONTACT DATE._^1_$CALL READR(REQBFF,MASREC,OLPM,ISTAT)_^1C_#UTILITY FILE SETUP ERROR IF RECORD DOES NOT EXIST._^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,E ‚‚OF).EQ.EOF) GO TO 60_^1C_#CHECK FOR OTHER ERRORS._^1_$IF(ISTAT.LT.0) GO TO 55_^1C_#NO ERROR, SAVE ON-LINE PARAMETERS._^1_$RLWAIT = ICCSAD(MASREC(4)) + 1_^1_$PPLAG = ICCSAD(MASREC(6))_^1_$MAXNCD = ICCSAD(MASREC(8))_^1C_#SAVE THE Y OR N FROM THE NA RECORD_^1_$CALL CCSGET(MASREC,20,NAEQRL)_^1C_#SET UP WORK AREAS TO VALIDATE LETTER NUMBERS FROM THE LTR1 AND_^1C_#LTR2 RECORDS_^1_$CALL R ‚‚EADR(REQBFF,MASREC,LTR1,ISTAT)_^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 60_^1C_#CHECK FOR OTHER ERROR_^1_$IF(ISTAT.LT.0) GO TO 55_^1_$LSUB = 0_^1_$DO 46 LL = 3,27_^1_$IF(MASREC(LL).EQ.ASTRKS) GO TO 47_^1_$LSUB = LSUB + 1_^1_$LTRNUM(LSUB) = MASREC(LL)_^1_!46 CONTINUE_^1_!47 CALL READR(REQBFF,MASREC,LTR2,ISTAT)_^1C_#IF NO LTR2 RECORD-CLOSFL_^1_$IF(AND(ISTAT, ‚‚WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF) GO TO 49_^1C_#CHECK FOR OTHER ERROR_^1_$IF(ISTAT.LT.0) GO TO 55_^1C_#RECORD FOUND-SAVE THE REST OF THE NUMBERS_^1_$DO 48 LL = 3,27_^1_$IF(MASREC(LL).EQ.ASTRKS) GO TO 49_^1_$LSUB = LSUB + 1_^1_$LTRNUM(LSUB) = MASREC(LL)_^1_!48 CONTINUE_^1C_#CLOSE UTILITY FILE AND CONTINUE INTIALIZATION._^1_!49 CALL CLOSFL(REQBFF,ISTAT)_^1_$GO TO 70_^12_]_^ ‚‚1C_#FILE ERRORS DURING UTILITY FILE OPERATIONS._^11_]_^1C_#OPEN FILE ERROR._^1 50 J = 3_^1_$GO TO 65_^11_]_^1C_#READR ERROR._^1 55 J = 13_^1_$GO TO 65_^11_]_^1C_#MORE THAN ONE COMMA OR OLPM OR LTR1 RECORD DOES NOT EXIST_^1 60 J = -1_^11_]_^1C_#REPORT ERROR, CLOSE ALL FILES AND EXIT._^1 65 CALL FILERR(IDATUT,J,ISTAT,LU)_^1_$CALL LCLANX_^12_]_^1C_#PICK UP CURRENT DATE._^1 70 ‚‚ MONTH = AND($FFFF,AMONTO)_^1_$DAY_!= AND($FFFF,ADAYTO)_^1_$YEAR = AND($FFFF,AYERTO)_^1C_#PICK UP JULIAN DATE._^1_$JDATE = ICALJL(DATE,ONE)_^1C_#DETERMINE NEXT YEAR._^1_$NXTYR = YEAR + 1_^1C_#CHECK AND CORRECT ANY DECADE ROLL OVER._^1_$IF(AND($F,NXTYR).LT.$A) GO TO 74_^1_$NXTYR = NXTYR + $F6_^1C_#CHECK AND CORRECT ANY CENTURY ROLL OVER._^1_$IF(NXTYR.EQ.CNTURY) NXTYR=ASC00_^11_]_^ ‚‚1C_#RETRIEVE ACTIVITY VERIFICATION MATRIX._^1C_#ZERO REQUEST BUFFER._^1 74 DO 75 I=1,24_^1 75 REQBFF(I) = 0_^1C_#OPEN FILE._^1_$CALL OPENFL(REQBFF,IDATAM,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 80_^1C_#NO ERROR, RETRIEVE THE MATRIX._^1_$CALL GETS(REQBFF,AVMAT,KEY,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 85_^1C_#NO ERROR, CLOSE FILE AND CONTINUE INITIA ‚‚LIZATION._^1_$CALL CLOSFL(REQBFF,ISTAT)_^11_]_^1C_#DETERMINE THE NUMBER OF ACTION CODES IN USE._^1_$DO 77 NUMACT=1,32_^1_$IF(VALACT(NUMACT).EQ.ASTRKS) GO TO 79_^1 77 CONTINUE_^11_]_^1 79 NUMACT = NUMACT - 1_^11_]_^1_$GO TO 95_^12_]_^1C_#FILE ERRORS DURING ACTIVITY VERIFICATION MATRIX RETRIEVAL._^11_]_^1C_#OPEN FILE ERROR._^1 80 J = 3_^1_$GO TO 90_^11_]_^1C_#GETS ERROR._^1 85 ‚‚ J = 14_^11_]_^1C_#REPORT ERROR, CLOSE ALL FILES, AND EXIT._^1 90 CALL FILERR(IDATAM,J,ISTAT,LU)_^1_$CALL LCLANX_^12_]_^1C_#RETRIEVE STARTING POSITION FOR QUEUE IN DAILY ASSIGNMENT FILE._^1C_#USE FIRST QUEUE COLLECTOR ASSIGNED._^1 95 KEY(1) = VALQ(1)_^1_$KEY(2) = VALQ(2)_^1C_#SET POINTER TO INDICATE CURRENT QUEUE._^1_$CURRQP = 1_^1_$ASSIGN 125 TO IRTN_^11_]_^1C_#ZERO REQUEST B ‚‚UFFER._^1 99 DO 100 I=1,24_^1 100 REQBFF(I) = 0_^1C_#OPEN FILE._^1_$CALL OPENFL(REQBFF,IDATQ,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 110_^1C_#RETRIEVE STARTING RELATIVE RECORD NUMBER FOR THIS QUEUE._^1_$CALL READR(REQBFF,MASREC,KEY,ISTAT)_^1C_#IF RECORD DOES NOT EXIST, NO AUTOMATIC FILE EXISTS FOR THIS QUEUE._^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ. ‚‚EOF) GO TO 105_^1C_#CHECK FOR OTHER ERRORS._^1_$IF(ISTAT.LT.0) GO TO 115_^1C_#NO ERROR, SAVE STARTING RELATIVE RECORD NUMBER._^1_$COLPTR(1) = MASREC(3)_^1_$COLPTR(2) = MASREC(4)_^1C_#SET FLAG INDICATING AUTOMATIC FILE RETRIEVED._^1_$COLFLG = 0_^1C_#CLOSE FILE AND CONTINUE INITIALIZATION OR RETURN._^1 105 CALL CLOSFL(REQBFF,ISTAT)_^1_$GO TO IRTN_^12_]_^1C_#FILE ERRORS DURING QUEUE ‚‚START RETRIEVAL._^11_]_^1C_#OPEN FILE ERROR._^1 110 J = 3_^1_$GO TO 120_^11_]_^1C_#READR REQUEST ERROR._^1 115 J = 13_^11_]_^1C_#REPORT ERROR, CLOSE ALL FILES, AND EXIT._^1 120 CALL FILERR(IDATQ,J,ISTAT,LU)_^1_$CALL LCLANX_^12_]_^1C_#OPEN ALL REMAINING FILE FOR USE._^1C_#ANY ERRORS ARE WITH AN OPENFL REQUEST._^1 125 J = 3_^11_]_^1C_#OPEN DELINQUENT MASTER._^1_$CALL OPENFL(REQBF ‚‚D,IDATDM,ISTAT)_^1C_#CHECK FOR ERROR._^1C_#SET REQUEST BUFFER FLAG FOR OVERRIDE LOCKED RECORDS WHEN RETRIEVAL_^1C_#IS WITH NO RECORD LOCKING._^1_$REQBFD(23) = 1_^1_$IF(ISTAT.GE.0) GO TO 145_^1C_#FILE ERROR IN DELINQUENT MASTER._^1 130 CALL FILERR(IDATDM,J,ISTAT,LU)_^1_$CALL LCLANX_^11_]_^1C_#OPEN PRIMARY TRANSACTION FILE._^1 145 CALL OPENFL(REQBFT,IDATTR,ISTAT)_^1C_#CHECK FOR ERR ‚‚OR._^1_$IF(ISTAT.GE.0) GO TO 155_^1C_#FILE ERROR IN PRIMARY TRANSACTION FILE._^1 150 CALL FILERR(IDATTR,J,ISTAT,LU)_^1_$CALL LCLANX_^11_]_^1C_#OPEN SECONDARY TRANSACTION FILE IF USED._^1 155 CONTINUE_^1C_#IF SECOND TRANSACTION FILE EXISTS ON THE SYSTEM, IT IS ASSUMED_^1C_#THAT THE BACKUP OPTION IS DESIRED-SO IF THE OPENFL REQUEST_^1C_#FINDS THE FILE, A FLAG IS SET AND PASSED TO T ‚‚HE LSVTRN ROUTINE._^1C_#* IF TRBKFL = 0 -NO FILE FOUND - IF TRBKFL = 1 - FILE FOUND_^1_$TRBKFL = 0_^1_$CALL OPENFL(REQBFB,IDATTB,ISTAT)_^1C_#CHECK FOR FILE PRESENT_^1 157 IF(AND(ISTAT,NOFILE).EQ.NOFILE) GO TO 165_^1C_#CHECK FOR OTHER ERROR_^1_$IF(ISTAT.LT.0) GO TO 160_^1C_#FILE FOUND AND NO ERRORS-SET FLAG FOR UPDATING_^1_$TRBKFL = 1_^1_$GO TO 165_^1C_#FILE ERROR IN SECONDARY TRA ‚‚NSACTION FILE-REPORT IT AND EXIT_^1 160 CALL FILERR(IDATTB,J,ISTAT,LU)_^1_$CALL LCLANX_^11_]_^1C_#OPEN DAILY ASSIGNMENT FILE._^1 165 CALL OPENFL(REQBFA,IDATDA,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.GE.0) GO TO 175_^1C_#FILE ERROR IN DAILY ASSIGNMENT FILE._^1 170 CALL FILERR(IDATDA,J,ISTAT,LU)_^1_$CALL LCLANX_^1._]_^1C_#DISPLAY AND HANDLE SELECTION SCREEN_^11_]_^1 175 CALL LD ‚‚SPLY(SELECT,DUMMY)_^1C_#DETERMINE SELECTION._^1 180 IF(IOBUF(1).EQ.AUTO) GO TO 200_^1+_OAUTOMATIC_^1_$IF(IOBUF(1).EQ.NAMESR) GO TO 300_^1+_ONAME SEARCH_^1_$IF(IOBUF(1).EQ.COSNSR) GO TO 400_^1+_OCOSIGNER NAME SEARCH_^1_$IF(IOBUF(1).EQ.NUMBSR) GO TO 500_^1+_OACCOUNT NUMBER SEARCH_^1_$IF(IOBUF(1).EQ.LAPYEN) GO TO 1000_^1+_OLEGAL AGENCY PYMT ENTRY_^1_$IF(IOBUF(1).EQ.EXIT) GO TO 190_^1 ‚‚+_OEXIT_^11_]_^1C_#INVALID SELECTION._^1_$CALL LDSPLY(INVSEL,DUMMY)_^1_$GO TO 180_^12_]_^1C_#EXIT REQUEST. CLOSE ALL FIELS AND EXIT._^1 190 CALL LCLANX_^1._]_^1C_#AUTOMATIC MODE. THIS SECTION SELECTS THE NEXT ACCOUNT IN THE ASSIG_^1C_#QUEUE FOR REQVIEQ. ON ENTRY, COLFLG INDICATES WHERE IN THE AUTOMAT_^1C_#FILE THE COLLECTOR IS._^1C_]_^1C_#COLFLG < 0_#NO AUTOMATIC FILE IN USE._^1C_ ‚‚#COLFLG = 0_#AUTOMATIC MODE SET UP AND IN USE._^1C_#COLFLG > 0_#AUTOMATIC MODE HAS BEEN INTERRUPTED, READY TO RESUM_^1C_]_^11_]_^1C_#CHECK FOR NO AUTOMATIC FILE. IF NO, RETRIEVE NEXT QUEUE AND START_^1C_#AUTOMATIC FILE WITH THAT QUEUE._^1 200 IF(COLFLG.LT.0) GO TO 800_^11_]_^1C_#CHECK IF THIS IS RESUMATION OF INTERRUPTED AUTO._^1 202 IF ( COLFLG .GT. 0 ) GO TO 230_^11_]_^1C_#NO, ‚‚AUTOMATIC FILE READY FOR USE. CHECK IF THIS IS THE FIRST ACCOU_^1C_#FOR THIS QUEUE. IF YES, A READR MUST BE DONE TO POSITION POINTER I_^1C_#DAILY ASSIGNMENT FILE. OTHERWISE, THE NEXT ACCOUNT IN SEQUENCE CAN_^1C_#BE RETRIEVED._^1_$IF ( QINIT .NE. 0 ) GO TO 207_^1 205 CALL READR ( REQBFA, DAREC, COLPTR, ISTAT )_^1C_#SET FLAG INDICATING NOT THE FIRST ACCOUNT IN QUEUE._^1_$QINIT = 1_^ ‚‚1C_#SET REQUEST ERROR IN CASE OFF ERROR._^1_$J = 13_^1_$GO TO 210_^11_]_^1C_#RETRIEVE NEXT ACCOUNT FROM DAILY ASSIGNMENT._^1 207 CALL GETS(REQBFA,DAREC,COLPTR,ISTAT)_^1C_#SET REQUEST ERROR IN CASE OF ERROR._^1_$J = 14_^11_]_^1C_#CHECK FOR ERROR OTHER THAN END-OF-FILE._^1 210 IF(ISTAT.LT.0.AND.AND(ISTAT,EOF).NE.EOF) GO TO 170_^1C_#END-OF-FILE OR CHANGE IN QUEUE DENOTES END OF DAIL ‚‚Y ASSIGNMENTS_^1C_#FOR THIS QUEUE. MOVE ON TO START REVIEW IN NEXT ASSIGNED QUEUE._^1C_#EXCEPTION WILL BE ANY ACCOUNT FROM THE RL QUEUE._^1 215 IF((AND(ISTAT,EOF).EQ.EOF.OR.DAREC(9).NE.VALQ(CURRQP).OR._^1_#1_"DAREC(10).NE.VALQ(CURRQP+1)).AND.RLFLAG.EQ.0) GO TO 805_^1C_#ACCOUNT ASSIGNED IN QUEUE. PROCEED IF ACCOUNT HAS HAD NO ACTIVITY_^1C_#ON IT TODAY. RETRIEVE MASTER RECORD FOR AC ‚‚COUNT AND CHECK LAST_^1C_#CONTACT DATE. IF ACCOUNT IS BUSY, MOVE ON TO REVIEW NEXT ACCOUNT_^1C_#ASSIGNED._^1_$ASSIGN 220 TO IRTN_^1_$ASSIGN 225 TO IRTN2_^1C_#MOVE ACCOUNT NUMBER TO IOBUF._^1_$CALL CCSMVA(DAREC,ONE,NUMLEN,IOBUF,ONE,NUMLEN)_^1_$GO TO 515_^11_]_^1C_#ACCOUNT RETRIEVED. CHECK LAST CONTACT DATE. PERFORM GETACT ON MAST_^1C_#FILE COLLECTION ACTIVITY BLOCK TO GET FIRST ACTI ‚‚VITY. SET STATUS_^1C_#WORD TO RESET AND RETRIEVE FIRST ACTIVITY FOR BLOCK._^1 220 OSW = ASC01_^1C_#BLANK STRING AND RETRIEVE FIRST ACTIVITY STRING FROM MASTER FILE._^1_$CALL GETACF(FSTACT,MASREC(154),LMASBL,OSW)_^1C_#SKIP REVIEW OF THIS ACCOUNT IF CONTACT DATE SHOWS IT ALREADY WORKE_^1C_#TODAY UNLESS ACCOUNT IS FROM THE 'RL' QUEUE._^1_$IF(RLFLAG.NE.0) GO TO 222_^1_$IF(FSTACT(1).EQ ‚‚.DATE(1).AND.FSTACT(2).EQ.DATE(2).AND.FSTACT(3).EQ._^1_#1_$DATE(3)) GO TO 225_^1C_#SKIP REVIEW OF THIS ACCOUNT IF ACCOUNT REVIEW CODE HAS BEEN SET BY_^1C_#SUPERVISOR._^1_$IF(ARCODE.NE.$20) GO TO 225_^11_]_^1C_#ACCOUNT READY AND ELLIGIBLE FOR REVIEW. SAVE RELATIVE RECORD NUMBE_^1C_#OF THIS ACCOUNT IN DAILY ASSIGNMENT FILE._^1 222 COLPTR(1) = REQBFA(16)_^1_$COLPTR(2) = REQBFA(17)_^1 ‚‚C_#SET FLAG INDICATING FIRST ACTIVITY RETRIEVED FOR THIS ACCOUNT._^1_$ACTRET = 1_^1_$GO TO 525_^12_]_^1C_#ACCOUNT IN AUTOMATIC FILE BUSY. PROCEED TO NEXT SCHEDULED ACCOUNT_^1C_#AS IF THIS ACCOUNT HAD BEEN DISPLAYED AND A 'NA' NEXT FUNCTION_^1C_#REQUEST PERFORMED._^1 225 IF ( RLFLAG .EQ. 0 ) GO TO 207_^1C_#ACCOUNT WAS FROM RL QUEUE. SKIP IT AND RESET TO GET NEXT ACCOUNT_^1C_#IN SEQ ‚‚UENCE PRIOR TO THE BREAK FOR REVIEW OF THIS ACCOUNT._^1_$GO TO 915_^12_]_^1C_#RESUME INTERRUPTED AUTO. RESET FLAG._^1 230 COLFLG = 0_^1C_#MOVE TO LAST ACCOUNT BEFORE INTERRUPTION._^1_$CALL READR(REQBFA,DAREC,COLPTR,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.GE.0) GO TO 235_^1C_#FILE ERROR._^1_$J = 13_^1_$GO TO 170_^11_]_^1C_#CHECK IF INTERRUPTION WAS TO REVIEW AN RL ACCOUNT. IF NO, ‚‚ RESUME_^1C_#REVIEW WITH THIS ACCOUNT._^1 235 IF(RLFLAG)240,215,250_^11_]_^1C_#ACCOUNT IS AN RL QUEUE ACCOUNT. REVIEW IT AND SET FLAG TO RESUME_^1C_#REVIEW AFTER THIS INTERRUPTION WITH NEXT ACCOUNT IN ASSIGNMENT_^1C_#AFTER THE PREVIOUS ACCOUNT REVIEWED._^1 240 RLFLAG = 1_^1_$GO TO 215_^11_]_^1C_#THIS ACCOUNT WAS THE LAST ACCOUNT REVIEWED BEFORE THE RL ACCOUNT._^1C_#CLEAR RL FLAG ‚‚AND RESUME REVIEW WITH NEXT ACCOUNT IN DAILY ASSIGN-_^1C_#MENT FILE._^1 250 RLFLAG = 0_^1_$GO TO 207_^1._]_^1C_#BORROWER'S NAME SEARCH._^11_]_^1 300 CALL LNMSRC_^11_]_^1C_#CHECK IF INPUT NAME FOUND. RETURN TO SELECTION SCREEN IF NOT FOUND_^1C_#IF FOUND, RETRIEVE ACCOUNT BY NUMBER._^1_$IF(IOBUF(1).LT.0) GO TO 175_^1_$GO TO 510_^1._]_^1C_#COSIGNER'S NAME SEARCH._^11_]_^1C_#CHECK IF ‚‚ ANY CHARACTERS ENTERED FOR NAME._^1 400 IF(IOBUF(41).EQ.2) GO TO 460_^11_]_^1C_#SAVE NAME, CANNOT BE MORE THAN 30 CHARACTERS LONG._^1_$SAVLEN = IOBUF(41) - 2_^1_$IF(SAVLEN.GT.30) SAVLEN = 30_^1_$CALL CCSMVA(IOBUF,THREE,SAVLEN,NAMSAV,ONE,SAVLEN)_^11_]_^1C_#ZERO REQUEST BUFFER._^1_$DO 410 I=1,24_^1 410 REQBFF(I) = 0_^1C_#SET LOCKING INDICATOR FOR NO LOCKING._^1_$IDATCS(15) = 0_^1C ‚‚_#OPEN FILE._^1_$CALL OPENFL(REQBFF,IDATCS,ISTAT)_^1C_#RESET LOCKING INDICATOR TO RECORD LOCKING FOR NEXT FILE ACCESS._^1_$IDATCS(15) = 1_^1C_#SET FLAG TO OVERRIDE LOCKED RECORDS._^1_$REQBFF(23) = 1_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 485_^11_]_^1C_#SEQUENTIALLY RETRIEVE FROM FILE COMPARING NAMES._^1 420 CALL GETS(REQBFF,COSREC,KEY,ISTAT)_^1C_#CHECK FOR END-OF-FILE TERM ‚‚INATING SEARCH._^1_$IF(AND(ISTAT,EOF).EQ.EOF) GO TO 460_^1C_#CHECK FOR OTHER ERROR._^1 425 IF(ISTAT.LT.0) GO TO 490_^11_]_^1C_#COMPARE EACH COSIGNER NAME WITH INPUT NAME._^1_$DO 440 I=1,3_^1C_#SET POINTER TO NEXT COSIGNER NAME._^1_$K = COSLEN*(I-1) + 20_^1C_#RETRIEVE FIRST CHARACTER OF NEXT COSIGNER NAME. IF BLANK, CONTINUE_^1C_#SEARCH WITH NEXT RECORD. IF NON-BLANK, COMPARE AGAIN ‚‚ST DESIRED NAM_^1_$CALL CCSGET(COSREC,K,J)_^1_$IF(J.EQ.$20) GO TO 420_^11_]_^1C_#COMPARE NAMES._^1_$CALL CCSCST(NAMSAV,ONE,SAVLEN,COSREC,K,SAVLEN,COMPIN)_^1C_#IF NO MATCH, CONTINUE SEARCH._^1_$IF(COMPIN.NE.0) GO TO 440_^11_]_^1C_#MATCH FOUND, DISPLAY COSIGNER INFORMATION. IF THIS IS COSIGNER 1 O_^1C_#2, MOVE THEIR INFORMATION INTO COSIGNER 1'S POSITION FOR DISPLAY_^1C_#PURPOSES._^1 ‚‚_$IF(I.NE.1) CALL CCSMVA(COSREC,K,COSLEN,COSREC,COS1PS,COSLEN)_^1_$CALL LDSPLY(COSRCH,COSREC)_^1C_#CHECK ENTRY FOR SELECTION. REPLY OF 'CARRIAGE RETURN' CONTINUES_^1C_#SEARCH._^1 430 IF(IOBUF(41).EQ.0) GO TO 440_^1C_#RETRIEVE FIRST CHARACTER OF REPLY._^1_$CALL CCSGET(IOBUF,ONE,J)_^1C_#CHECK FOR A 'C' INDICATING CORRECT NAME FOUND._^1_$IF(J.EQ.$43) GO TO 450_^1C_#CHECK FOR A 'D' I ‚‚NDICATING DISCONTINUE SEARCH._^1_$IF(J.EQ.$44) GO TO 460_^11_]_^1C_#INVALID ENTRY._^1_$CALL LDSPLY(INVENT,DUMMY)_^1_$GO TO 430_^1 440 CONTINUE_^11_]_^1C_#ALL THREE COSIGNERS IN THIS RECORD CHECKED. RETRIEVE AND CHECK NEX_^1C_#RECORD._^1_$GO TO 420_^12_]_^1C_#FOUND DESIRED ACCOUNT. SAVE ACCOUNT NUMBER IN IOBUF FOR LOOKUP._^1 450 CALL CCSMVA(COSREC,ONE,NUMLEN,IOBUF,ONE,NUMLEN)_^1C_ ‚‚#CLOSE COSIGNER FILE AND GO RETRIEVE ACCOUNT._^1_$CALL CLOSFL(REQBFF,ISTAT)_^1_$GO TO 510_^12_]_^1C_#SELECTED NAME NOT PRESENT. CLOSE FILE, DISPLAY MESSAGE THAT NAME W_^1C_#NOT FOUND AND RETURN TO SELECTION SCREEN._^1 460 CALL CLOSFL(REQBFF,ISTAT)_^1_$CALL LDSPLY(NOTFND,DUMMY)_^1_$GO TO 180_^12_]_^1C_#FILE ERROR DURING COSIGNER NAME SEARCH._^11_]_^1C_#OPEN FILE ERROR._^1 485 J = ‚‚3_^1_$GO TO 495_^11_]_^1C_#GETS REQUEST ERROR._^1 490 J = 14_^11_]_^1C_#REPORT ERROR, CLOSE ALL FILES AND EXIT._^1 495 CALL FILERR(IDATCS,J,ISTAT,LU)_^1_$CALL LCLANX_^1._]_^1C_#ACCOUNT NUMBER RETRIEVAL/SEARCH. ACCOUNT NUMBER IS IN IOBUF._^11_]_^1C_#LEFT JUSTIFY ACCOUNT NUMBER IN IOBUF._^1 500 CALL CCSMVA(IOBUF,THREE,NUMLEN,IOBUF,ONE,NUMLEN)_^11_]_^1C_#SET UP RETURN VALUES FOR ER ‚‚RORS AND NO ERRORS._^1 510 ASSIGN 520 TO IRTN_^1_$ASSIGN 530 TO IRTN2_^1C_#SET NAME OR ACCOUNT NUMBER INPUT FLAG._^1_$NNINPT = 1_^11_]_^1C_#RETRIEVE ACCOUNT BY NUMBER._^1 515 CALL READR(REQBFD,MASREC,IOBUF,ISTAT)_^1C_#IF RECORD IS LOCKED OR RECORD NOT FOUND, RETURN THRU IRTN2_^1_$IF(AND(ISTAT,LOCKED).EQ.LOCKED.OR.AND(ISTAT,WRONKY).EQ.WRONKY.OR._^1_#1_$AND(ISTAT,EOF).EQ.EOF) GO TO ‚‚ IRTN2_^11_]_^1C_#CHECK FOR OTHER ERROR._^1_$IF(ISTAT.GE.0) GO TO IRTN_^1C_#FILE ERROR._^1_$J = 13_^1_$GO TO 130_^12_]_^1C_#CORRECT ACCOUNT FOUND IN SEARCH. INSURE ACCOUNT IS IN A QUEUE ALLO_^1C_#FOR THIS COLLECTOR AND THE SUPERVISOR'S ACCOUNT REVIEW CODE IS NOT_^1C_#SET. IN EITHER CASE, THE COLLECTOR IS NOT ALLOWED TO REVIEW THIS_^1C_#ACCOUNT._^1 520 IF(LCHEKQ(MASREC(136)).GE.0) ‚‚GO TO 525_^1C_#NOT ALLOWED TO REVIEW._^1_$CALL LDSPLY(WRONGQ,DUMMY)_^1_$GO TO 180_^11_]_^1C_#ACCOUNT READY FOR REVIEW. SET UP TRANSACTION FILE AND DISPLAY MAST_^1C_#SCREEN._^1 525 CALL CCSMVA(MASREC,ONE,NUMLEN,TRNSBF,ONE,NUMLEN)_^1C_#MOVE IN COLLECTOR ID._^1C_#SAVE STARTING TIME._^1_$CALL CCSTIM(TRNSBF(11))_^1_$GO TO 600_^11_]_^1C_#SELECTED ACCOUNT NOT PRESENT OR BUSY ON SEARCH. D ‚‚ISPLAY SELECTION_^1C_#SCREEN WITH APPROPRIATE MESSAGE._^1C***************************************************************PDM*0084_^1 530 IF(AND(ISTAT,WRONKY).EQ.WRONKY .OR. AND(ISTAT,EOF).EQ.EOF)_^1_#1GO TO 535_^1_$CALL LDSPLY(BUSY,DUMMY)_^1C***************************************************************PDM*0084_^1_$GO TO 540_^11_]_^1C********************************************** ‚‚*****************PDM*0084_^1 535 CALL LDSPLY(NOTFND,DUMMY)_^1C***************************************************************PDM*0084_^1C_#PROCESS ENTRY FROM SELECTION SCREEN._^1 540 GO TO 180_^1._]_^1C_#SCREEN HANDLER. DISPLAYS SCREENS AND PERFORMS COLLECTOR FUNCTIONS_^1C_#REQUESTED._^11_]_^1C_#DISPLAY MASTER SCREEN ACCORDING TO TYPE._^1C_#CHECK IF USER IS A CLERICAL. DISPLAY CH ‚‚ANGE SCREEN IF YES._^1 600 IF(COLTYP.LT.0) GO TO 625_^1_$CALL LDSPLY(MASCRN+ACTYPE,MASREC)_^11_]_^1C_#CHECK ENTRY FOR NEXT REQUEST._^1 605 IOBUF(1) = LCHENT(IOBUF(1))_^1C_#CHECK FOR VALID ENTRY._^1_$IF(IOBUF(1).GT.0) GO TO 615_^11_]_^1C_#INVALID ENTRY FROM SCREEN. ASK FOR REENTRY._^1 610 CALL LDSPLY(INVENT,DUMMY)_^1_$GO TO 605_^12_]_^1C_#BRANCHED GO TO TO PROCESS INPUT FUNCTION. ‚‚_^1 615 GO TO_^1_#1(600,620,625,630,660,650,690,730,740,750,750,750,800,820,840,850),_^1C_%CR DA DC DF NA RL CS EA DS P1 P2 P3 NQ OA SS XX_^1_#2_$IOBUF(1)_^12_]_^1C_#DISPLAY ACTIVITY SCREEN REQUESTED._^1 620 CALL LDSPLY(DASCRN,MASREC)_^1_$CALL LDAASC_^1C_#UPON RETURN, IOBUF(1) CONTAINS A VALID NEXT FUNCTION REQUEST._^1_$GO TO 615_^12_]_^1C_#DISPLAY CUSTOMER CHANGE ‚‚SCREEN REQUEST._^1 625 CALL LDSPLY(DCSCRN,MASREC)_^1C_#PERFORM CHANGE SCREEN FUNCTIONS._^1_$CALL LCHSCR(MASREC,CUSCHG)_^1C_#UPON RETURN, IOBUF(1) CONTAINS A VALID NEXT FUNCTION REQUEST._^1_$GO TO 615_^12_]_^1C_#DISPLAY FINANCIAL HISTORY SCREEN BY ACCOUNT TYPE._^1 630 CALL LDSPLY(FNSCRN+ACTYPE,MASREC)_^1C_#CHECK ENTRY FOR NEXT FUNCTION REQUEST._^1_$GO TO 605_^12_]_^1C_#REVIEW ACCO ‚‚UNT LATER REQUEST. NOT A VALID FUNCTION UNLESS AUTOMATI_^1C_#MODE IN USE. ALSO, ROOM MUST BE AVALIABLE IN THE RL QUEUE._^1 650 IF(NNINPT.NE.0.OR.RLCNT.GE.15) GO TO 610_^1C_#ROOM AVAILABLE IN QUEUE. INCREMENT COUNTER OF ACCOUNTS IN THIS QUE_^1_$RLCNT = RLCNT + 1_^1C_#SAVE DAILY ASSIGNMENT FILE RELATIVE RECORD NUMBER OF THIS ACCOUNT._^1_$J = 2*RLCNT - 1_^1_$RLPTR(J) = COLPTR(1)_^1_$ ‚‚RLPTR(J+1) = COLPTR(2)_^1C_#ESTABLISH WAIT COUNT FOR THIS ACCOUNT._^1_$K = 0_^1_$J = RLCNT - 1_^1_$IF(J.LT.2) GO TO 657_^1_$DO 655 I=2,J_^1 655 K = K + RLCNTS(I)_^1 657 K = RLWAIT - RLCNTS(1) - K_^1_$IF(K.LT.1) K=1_^1_$RLCNTS(RLCNT) = K_^1_$GO TO 670_^12_]_^1C_#REVIEW OF NEXT ASSIGNED ACCOUNT REQUEST. ONLY VALID IF AUTOMATIC F_^1C_#IN USE._^1 660 IF(COLFLG.LT.0) GO TO 800_^11_]_ ‚‚^1C_#CHECK IF NEXT ACCOUNT FOR REVIEW SHOULD BE AN RL ACCOUNT, OR THE_^1C_#NEXT ACCOUNT IN DAILY ASSIGNMENT AFTER THE INTERRUPTION FOR REVIE_^1C_#OF AN RL ACCOUNT._^1 665 IF(RLCNTS(1).EQ.1) GO TO 680_^1 670 ASSIGN 202 TO IRTN_^1_$GO TO 900_^12_]_^1C_#NEXT ACCOUNT FOR REVIEW IS AN RL ACCOUNT, OR THE NEXT ACCOUNT IS_^1C_#ACCOUNT AFTER INTERRUPTION. DON'T SET FLAG IN LATTER CASE._^ ‚‚1 680 IF(RLFLAG.NE.1) RLFLAG = -1_^1_$GO TO 900_^12_]_^1C_#COSIGNER SCREEN DISPLAY REQUEST._^11_]_^1 690 DO 695 I=1,24_^1 695 REQBFF(I) = 0_^11_]_^1C_#OPEN COSIGNER FILE._^1_$CALL OPENFL(REQBFF,IDATCS,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 485_^11_]_^1C_#NO ERROR. SET UP ACCOUNT NUMBER KEY FOR RETRIEVAL._^1_$CALL CCSMVA(MASREC,ONE,NUMLEN,KEY,ONE,NUMLEN)_^11_]_^1C_ ‚‚#PERFORM READR TO RETRIEVE RECORD._^1C_#MOVE KEY TO SAVE AREA_^1_$CALL CCSMVA(KEY,1,16,COSKEY,1,16)_^1_$CALL READR(REQBFF,COSREC,KEY,ISTAT)_^1_$COSFLG = 0_^1_$IF(AND(ISTAT,WRONKY).NE.WRONKY.AND.AND(ISTAT,EOF).NE.EOF)_^1_#1_$GO TO 700_^1C_#RECORD DOES NOT EXIST._^1C_#DISPLAY THE SCREEN WITH BLANKS AND IF THE OPERATOR ENTERS DATA-_^1C_#CREATE A RECORD_^1_$CALL CCSBLK(COSREC,500)_^1_$ ‚‚CALL LDSPLY(COSRN1,MASREC)_^1_$CALL LDSPLY(COSRN2,COSREC)_^1_$CALL LCHSCR(COSREC,COSCHG)_^1C_#A RECORD MUST BE CREATED IF AN ENTRY WAS MADE-UNLESS TRAINEE_^1_$IF(COSFLG.EQ.0.OR.UFLAG.EQ.-1) GO TO 710_^1_$CALL CCSMVA(COSKEY,1,16,COSREC,1,16)_^1_$CALL WRITER(REQBFF,COSREC,COSKEY,ISTAT)_^1_$IF(ISTAT.GE.0) GO TO 710_^1_$J = 12_^1_$GO TO 495_^1C_#RECORD WAS FOUND ON ORIGINAL READ_^1 69 ‚‚7 IF(UFLAG.EQ.0) CALL UPDREC(REQBFF,COSREC,ISTAT)_^11_]_^1C_#CHECK FOR OTHER ERROR._^1 700 IF(ISTAT.GE.0) GO TO 705_^1C_#FILE ERROR. SET REQUEST TYPE._^1_$J = 13_^1_$GO TO 495_^11_]_^1C_#NO ERRORS, RECORD RETRIEVED. DISPLAY COSIGNER SCREEN AND PERFORM_^1C_#COSIGNER SCREEN FUNCTIONS._^1 705 CALL LDSPLY(COSRN1,MASREC)_^1_$CALL LDSPLY(COSRN2,COSREC)_^1_$CALL LCHSCR(COSREC,COSCHG)_^1 ‚‚C_#ON RETURN, IOBUF(1) CONTAINS A VALID NEXT FUNCTION REQUEST. SAVE_^1C_#COSIGNER RECORD IF NOT A TRAINEE LOGGED ON._^1_$IF(UFLAG.EQ.0) CALL UPDREC(REQBFF,COSREC,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.GE.0) GO TO 710_^1C_#FILE ERROR DURING UPDATE RECORD REQUEST._^1_$J = 15_^1_$GO TO 495_^11_]_^1C_#SET RETURN VALUE TO PROCESS NEXT REQUEST._^1 710 ASSIGN 615 TO IRTN_^11_]_^1C_#RE ‚‚TURN._^1 715 CALL CLOSFL(REQBFF,ISTAT)_^1_$GO TO IRTN_^1._]_^1C_#TRAINING METHOD OF ENTRY FOR ACTIVITY SEQUENCE._^1 730 CALL LEATRN_^1_$GO TO 605_^12_]_^1C_#RETURN TO SELECTION SCREEN REQUESTED. SET NAME OR ACCOUNT NUMBER_^1C_#INPUT FLAG TO AVOID LOSING CURRENT ACCOUNT IF IT IS FROM RL QUEUE._^1 740 NNINPT = 1_^1C_#SET FLAG TO INDICATE INTERRUPTION OF AUTOMATIC MODE OCCURRED IF ‚‚IT_^1C_#IS ACTIVE._^1_$IF(COLFLG.EQ.0) COLFLG = 1_^1C_#SET RETURN LOCATION TO DISPLAY SELECTION SCREEN. SAVE THE MASTER_^1C_#RECORD._^1_$ASSIGN 175 TO IRTN_^1_$GO TO 900_^12_]_^1C_#PERMANENT COMMENT CHANGE REQUESTED._^1 750 CALL LPCPRC_^1C_#PROMPT FOR ENTRY OF NEXT FUNCTION._^1_$CALL LDSPLY(NXTFUN,DUMMY)_^1_$GO TO 605_^12_]_^1C_#MOVE TO NEXT ASSIGNED QUEUE REQUEST._^11_]_^1C_(SAVE ‚‚ CURRENT DELQ MSTR RECORD IF ONE IS PRESENT_^1 800 IF ( COLFLG .LT. 0 .AND. NNINPT .EQ. 0 ) GO TO 805_^1_$ASSIGN 805 TO IRTN_^1_$NNINPT = 1_^1_$GO TO 900_^11_]_^1C_#MOVE POINTER TO NEXT QUEUE IN VALID QUEUE ARRAY._^1 805 CURRQP = CURRQP + 2_^1C_#CHECK IF THIS IS THE END OF ASSIGNED QUEUES._^1_$IF(CURRQP.LT.QBREAK.OR.(QBREAK.EQ.-1.AND.CURRQP.LT.16)) GO TO 810_^1C_#NO MORE QUEUES T ‚‚O REVIEW FOR THIS COLLECTOR, END OF DAILY ASSIGN-_^1C_#MENTS._^1_$CALL LDSPLY(EOFDA,DUMMY)_^1_$CALL LCLANX_^11_]_^1C_#HAVE NEXT ASSIGNED QUEUE. RETRIEVE STARTING POSITION FOR THIS QUEU_^1C_#IN THE DAILY ASSIGNMENT FILE._^1 810 ASSIGN 815 TO IRTN_^1C_#SET FLAG INDICATING NO AUTOMATIC FILE IN USE. THIS FLAG WILL BE_^1C_#RESET WHEN STARTING POSITION IN DAILY ASSIGNMENT FILE IS RETRIE ‚‚VED_^1_$COLFLG = -1_^1C_#SET UP IN KEY THE NEXT QUEUE THE STARTING POSITION IS TO BE_^1C_#RETRIEVED FOR._^1_$KEY(1) = VALQ(CURRQP)_^1_$KEY(2) = VALQ(CURRQP+1)_^1C_#GO RETRIEVE STARTING POSITION._^1_$GO TO 99_^11_]_^1C_#CHECK IF NEXT QUEUE ASSIGNED HAS AN AUTOMATIC FILE. IF NO, TRY_^1C_#NEXT ASSIGNED QUEUE._^1 815 IF(COLFLG.LT.0) GO TO 800_^1C*************************************** ‚‚***********************138*AD12_^1C_(NEXT QUEUE VALID AND HAS ASSIGNED ACCOUNTS. IF RL WAS ACTIVE_^1C_((LOOKING AT RL ACCOUNT), CANCEL THE RESUME WITH LAST ACCOUNT_^1C_(REQUEST AND MOVE REMAINING ACCOUNTS IN RL QUEUE UP. ALSO SET_^1C_(FLAGS TO RESUME AUTOMATIC WITH FIRST ACCOUNT IN CURRENTLY_^1C_(RETRIEVED QUEUE._^1_$IF( RLFLAG .EQ. 0 ) GO TO 817_^1C_(YES, LAST ACCOUNT FROM RL QUEU ‚‚E._^1_$RLFLAG = 0_^1_$QINIT = 1_^1_$GO TO 925_^11_]_^1C_(NO, ACCOUNT NOT FROM RL QUEUE. SET FLAG INDICATING FIRST_^1C_(ACCOUNT IN NEW QUEUE UP FOR REVIEW._^1 817 QINIT = 0_^1C***************************************************************138*A012_^1_$GO TO 205_^12_]_^1C_#DISPLAY ACCOUNT LINKED THRU OTHER ACCOUNT NUMBER IN MASTER FILE._^11_]_^1C_#SAVE ACCOUNT NUMBER TO LOOK FOR._^1 ‚‚ 820 CALL CCSMVA(MASREC,OAACCT,NUMLEN,IOBUF,ONE,NUMLEN)_^1C_#SET FLAG TO INDICATE INTERRUPTED AUTOMATIC MODE._^1_$IF(COLFLG.EQ.0) COLFLG = 1_^1C_#SET NAME OR ACCOUNT NUMBER INPUT FLAG SO THAT A RETURN TO AUTOMATI_^1C_#MODE, IF ACITVE, WILL RETURN TO CURRENT ACCOUNT DISPLAYED._^1_$NNINPT = 1_^1C_#SET RETURN LOCATION TO ACCOUNT NUMBER LOOK UP._^1_$ASSIGN 510 TO IRTN_^1C_#SAVE MASTER ‚‚ RECORD._^1_$GO TO 900_^12_]_^1C_#DISPLAY AND HANDLE SUPERVISOR SCREEN._^11_]_^1C_#DISPLAY SCREEN._^1 840 CALL LDSPLY(SUPSRN,MASREC)_^1C_#PERFORM SUPERVISOR SCREEN FUNCTIONS._^1_$CALL LCHSCR(MASREC,SUPCHG)_^1C_#UPON RETURN, IOBUF(1) CONTAINS A VALIDATED NEXT FUNCTION REQUEST._^1_$GO TO 615_^12_]_^1C_#ACTIVITY ENTRY, NORMAL METHOD._^1 850 CALL LEACTS_^1C_#UPON RETURN, IOBUF(1) CON ‚‚TAINS A NEXT FUNCTION REQUEST._^1_$GO TO 605_^1._]_^1C_#SAVE DELINQUENT MASTER RECORD IF NOT A TRAINEE LOGGED ON._^1 900 IF(UFLAG.EQ.0) CALL UPDREC(REQBFD,MASREC,ISTAT)_^1C_#CLEAR FIRST ACTIVITY RETRIEVED FLAG._^1_$ACTRET = 0_^1C_#CHECK FOR ERROR._^1C_:BYPASS ERROR IF NOT LOCKED_^1_$IF(AND(ISTAT,$8080).EQ.$8080) GO TO 910_^1_$IF(ISTAT.GE.0) GO TO 910_^1C_#FILE ERROR DURING UPDATE ‚‚RECORD REQUEST._^1_$J = 15_^1_$GO TO 130_^12_]_^1C_#RL ACTIVE CHECK AND COUNTER._^11_]_^1C_#IF AUTOMATIC NOT ACTIVE, BYPASS RL CHECK._^1 910 IF(NNINPT.NE.0) GO TO 950_^11_]_^1C_#BRANCH ACCORDING TO RL PHASE._^1 915 IF(RLFLAG) 930,940,920_^11_]_^1C_#RLFLAG = 1. HAVE JUST FINISHED REVIEWING AN RL ACCOUNT. NOW RESUME_^1C_#REVIEW WITH NEXT ACCOUNT IN DAILY ASSIGNMENT FILE. RESET POIN ‚‚TER_^1C_#TO ACCOUNT PRECEDING IT._^1 920 COLPTR(1) = RLPTR(1)_^1_$COLPTR(2) = RLPTR(2)_^1C_#MOVE ACCOUNTS WAITING IN RL QUEUE UP._^1C_#MOVE POINTERS AND WAIT COUNTERS._^1C***************************************************************138*A012_^1 925 LENGTH = 2*RLCNT_^1C***************************************************************138*A012_^1_$CALL CCSMVA(RLCNTS,THREE,LENGTH,RLCN ‚‚TS,ONE,LENGTH)_^1_$LENGTH = 2*LENGTH_^1_$CALL CCSMVA(RLPTR,FIVE,LENGTH,RLPTR,ONE,LENGTH)_^1_$RLCNT = RLCNT - 1_^1_$GO TO 935_^11_]_^1C_#RLFLAG = -1. FIRST ACCOUNT IN RL QUEUE IS NOW UP FOR REVIEW. SET_^1C_#RECORD POINTER TO THIS ACCOUNT AND SAVE POINTER OF CURRENT ACCOUNT_^1 930 J = RLPTR(1)_^1_$RLPTR(1) = COLPTR(1)_^1_$COLPTR(1) = J_^1_$J = RLPTR(2)_^1_$RLPTR(2) = COLPTR(2)_^1_$C ‚‚OLPTR(2) = J_^1C_#SET RETURN TO READR TO READ SPECIFIC RECORD IN DAILY ASSIGNMENTS._^1 935 ASSIGN 230 TO IRTN_^11_]_^1C_#RLFLAG = 0. RL NOT ACTIVE, DECREMENT WAIT COUNT FOR ACCOUNTS IN RL_^1C_#QUEUE._^1 940 IF(RLCNTS(1).GT.1) RLCNTS(1) = RLCNTS(1) -1_^11_]_^1C_#ZERO NAME AND ACCOUNT NUMBER INPUT FLAG._^1 950 NNINPT = 0_^1C_(RESET ACTIVITY COUNT NUMBER_^1_$ACTCNT = 1_^11_]_^1C_#G ‚‚O PERFORM NEXT FUNCTION REQUEST._^1_$GO TO IRTN_^14_]_^1C_EBEGIN LEGAL AGENCY ON-LINE UPDATE_^1C_#CALL PAYMENT ENTRY SUBROUTINE_^1 1000 CALL PAYENT_^1_$GO TO 175_^1C_#END OF MODULE. THERE IS NO RETURN FROM THIS MODULE. THE ONLY EXIT_^1C_#IS THRU THE SUBROUTINE LCLANX._^1_$END_]_^__ ‚‚LACTED CSY/ F12 5740 ‚‚1_$SUBROUTINE LACTED(ACTSTR,BUFF)_^1_#1_2/F12 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#EDIT ACTIVITY STRING FOR OUTPUT._^1C_]_^1C_#ROUTINE TO CONVERT THE COMPACTED ACTIVITY STRING RETRIEVED FROM_^1C_#A GETACT REQUEST INTO FORM ACCEPTABL ‚‚E FOR OUTPUT. THE ROUTINE WILL_^1C_#CONVERT THE DATE AND MOVE THE OTHER FIELDS TO A ANOTHER BUFFER_^1C_#SEPARATING EACH FIELD WITH ONE SPACE._^1C_#CALLING SEQUENCE:_^1C_*CALL LACTED(ACTSTR,BUFF)_^1C_#WHERE:_^1C_#ACTSTR = THE COMPACTED ACTIVITY STRING TO EXPAND._^1C_#BUFF_!= OUTPUT BUFFER LOCATION TO RECEIVE THE ACTIVITY._^1C_]_^1C_#THE FORMAT OF THE RETURNED ACTIVITY HAS ONE OF THE ‚‚ FOLLOWING TWO_^1C_#FORMAS DEPENDING ON WHETHER THE OPTION NOT TO DISPLAY THE COLLECTO_^1C_#ID OUTLINED BELOW IS CHOSEN:_^1C_#WITH COLLECTOR ID -_^1CXX/XX/XX AC RS LT COLL COMMENT FOR 56 CHARACTERS-----------------------_^1C_#WITHOUT COLLECTOR ID -_^1CXX/XX/XX AC RS LT COMMENT FOR 56 CHARACTERS----------------------------_^1C_]_^12_]_^1C_#RETRIEVE COMMON MACRO._^1M_#LEGMAC_^11_]_^1 ‚‚C_#LOCAL VARIABLES._^1_$INTEGER ACTSTR,BUFF_^12_]_^1C_#INITIALIZE POINTERS FOR INPUT AND OUTPUT BUFFERS AND EDIT DATE INT_^1C_#OUTPUT BUFFER._^1_$J = 1_^1_$K = 1_^1_$CALL EDIT(ACTSTR,J,BUFF,K,J)_^1C_#INCREMENT POINTERS._^1_$J = J+6_^1_$K = K+9_^1C_#MOVE IN ACTION, RESULT, AND LETTER CODES._^1_$DO 10 I=1,3_^1_$CALL CCSMVA(ACTSTR,J,TWO,BUFF,K,TWO)_^1C_#INCREMENT POINTERS._^1_$J = J+2 ‚‚_^1 10 K = K+3_^1C***********************************************************************_^1C_#IF DISPLAY OF THE COLLECTOR ID ASSOCIATED WITH EACH ACTIVITY IS NO_^1C_#DESIRED, INSERT A GO TO LABEL 20 STATEMENT HERE._^11_]_^1C***********************************************************************_^1C_#MOVE IN COLLECTOR ID._^1_$CALL CCSMVA(ACTSTR,J,FOUR,BUFF,K,FOUR)_^1C_#INCREMENT ‚‚POINTERS._^1_$J = J+4_^1_$K = K+5_^1C_#MOVE IN COMMENT_^1 20 CALL CCSMVA(ACTSTR,J,COMLEN,BUFF,K,COMLEN)_^12_]_^1C_#OPERATION COMPLETE. RETURN._^1_$RETURN_^1_$END_]_^__ ‚‚LBLKDT CSY/ F23 7600 ‚‚1_$BLOCK DATA_^1_#1_2/F23 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#BLOCK DATA SUBPROGRAM FOR INITIALIZING COMMON VARIABLES FOR_^1C_#LEGAL 2.0_^1C_]_^1C_#BRING IN COMMON MACRO_^11_]_^1M_#LEGMAC_^11_]_^1C_#FILE MANAGER IDATA WORDS._^1C** ‚‚********************************************************138**L/A_^1_$DATA IDATDM/'LADLQMST_/',1,1,1/_^1_$DATA IDATSC/'LASCNFIL_/',1,1,0/_^1_$DATA IDATTR/'LATRANFL_/',0,1,0/_^1_$DATA IDATDA/'LADLYASN_/',0,1,0/_^1_$DATA IDATAU/'LAACTIVE_/',1,1,1/_^1_$DATA IDATTB/'LATRNBCK_/',0,1,0/_^1C**********************************************************138**L/A_^11_]_^1C_#FILE MANAGER REQUEST B ‚‚UFFERS. MUST BE INITIALLY ZEROED._^1_$DATA REQBFD/24*0/_^1_$DATA REQBFS/24*0/_^1_$DATA REQBFT/24*0/_^1_$DATA REQBFA/24*0/_^1_$DATA REQBFB/24*0/_^1_$DATA REQBFF/24*0/_^11_]_^1C_#CHANGE SCREEN ITEM FILED DESCRIPTION ARRAYS._^1_$DATA CUSCHG/-30,90*-1/_^1_$DATA COSCHG/-30,90*-1/_^1_$DATA SUPCHG/-20,60*-1/_^11_]_^1C_#TRANSACTION FILE BUFFER, INITIALLY BLANK FILL._^1_$DATA TRNSBF/71*$202 ‚‚0/_^11_]_^1C_#SMALL VARIABLES OR CONSTANTS REQUIRING INITIALIZATION._^1_$DATA ACTRET/0/,NUMACT/64/,ONE/1/,TWO/2/,THREE/3/,FOUR/4/,FIVE/5/_^1_$DATA SIX/6/,NINE/9/,DUMMY/0/,XYWORD/$1B31,$17,$1600/,XYN/-1/_^1_$DATA ZERO/0/,OLDPOS/63/,NEWPOS/33/,INVENT/-3/,PPFLAG/285/_^1_$DATA NAMPOS/18/,NUMLEN/16/,LMASBL/'0360'/,OUTBYT/80/,LOCKED/$80/_^1_$DATA WRONKY/$200/,EOF/$100/,COMLEN/56/,STRLEN/ ‚‚72/,CURBAL/896/_^1_$DATA MPPAMT/1022/,MPPDAT/1016/,PPMADE/1041/,ASC01/'01'/,NXTFUN/-2/_^1_$DATA ASC00/'00'/,TYPE2/'02'/,CSNXTF/-1/,CLRSCR/$1800/,BZ/'BZ'/_^1_$DATA INVRES/46/,CNTURY/$3A30/,TPPDAT/121/,TPPAMT/127/,OK/'OK'/_^1_$DATA MLTRAM/848/,MLTRDT/842/,COMRQD/60/,COMLNG/61/,SR/'SR'/_^1_$DATA PP/'PP'/,TNCD/99/,MNCD/275/,INVNCD/63/,RL/'RL'/_^1_$DATA QBREAK/-1/,CID/-1,-1/,TLDT/106/,T ‚‚LTAMT/112/,NOACT/40/,FE/42/_^1_$DATA BLANKS/$2020/,ENCD/62/,UFLAG/0/,INVCOM/44/_^1_$DATA ACTCNT/1/,LTRNUM/50*$2020/_^12_]_^1_$END_]_^__ ‚‚LCHEKQ CSY/ F25 5120 ‚‚1_$INTEGER FUNCTION LCHEKQ(QUEUE)_^1_#1_2/F25 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#CHECK IF ACCOUNT IN ALLOWED QUEUE._^1C_]_^1C_#FUNCTION TO DETERMINE IF AN INPUT QUEUE IS IN A COLLECTOR'S_^1C_#LIST OF QUEUES HE IS ALLOWED TO REVIEW ‚‚ ACCOUNTS FROM. RETURNED_^1C_#VALUES FOR THE FUNCTION ARE:_^1C_*= 0_"COLLECTOR ALLOWED TO REVIEW ACCOUNT IN THIS QUEUE._^1C_*< 0_"COLLECTOR NOT ALLOWED TO REVIEW ACCOUNTS IN THIS QUEU_^1C_]_^1C_#BRING IN COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER QUEUE(1),ALL(2)_^1_$DATA ALL/'ALL '/_^12_]_^1C************************************************************** ‚‚*********_^1C_#IF A BYPASS OF QUEUE CHECKING IS DESIRED, REMOVE THE COMMENT_^1C_#INDICATORS FROM THE FOLLOWING EXECUTABLE STATEMENTS._^1C_#LCHEKQ = 0_^1C_#GO TO 100_^1C***********************************************************************_^12_]_^1C_#CHECK IF ACCOUNT REVIEW CODE IS SET AND USER IS NOT A SUPERVISOR._^1_$IF(ARCODE.NE.$20.AND.COLTYP.LE.0) GO TO 30_^1C_#CHECK ALLOWED Q ‚‚UEUES FOR ENTRY OF 'ALL'. A VALUE OF -1 FOR QBREAK_^1C_#MEANS ONLY ASSIGNED QUEUES WERE GIVEN AND NO CHECK FOR 'ALL' NEED_^1C_#BE PERFORMED._^1_$IF(QBREAK.EQ.-1) GO TO 10_^11_]_^1C_#CHECK FOR ALLOWED QUEUE VALUE OF 'ALL'_^1_$IF(VALQ(QBREAK).NE.ALL(1)) GO TO 10_^1_$IF(VALQ(QBREAK+1).NE.ALL(2)) GO TO 10_^1C_#ANY QUEUE VALID. SET VALID QUEUE SWITCH._^1_$LCHEKQ = 0_^1_$GO TO 100_^11_]_ ‚‚^1C_#CHECK FOR QUEUE BEING IN VALID QUEUE ARRAY._^1 10 DO 20 I=1,8_^1C_#CALCULATE POINTER TO NEXT QUEUE IN VALID QUEUE ARRAY._^1_$K = 2*I - 1_^1C_#CHECK FOR A MATCH._^1_$IF(VALQ(K).NE.QUEUE(1)) GO TO 20_^1_$IF(VALQ(K+1).NE.QUEUE(2)) GO TO 20_^1C_#MATCH FOUND, SET VALID QUEUE SWITCH._^1_$LCHEKQ = 0_^1_$GO TO 100_^11_]_^1C_#NO MATCH, CONTINUE CHECKING WITH NEXT QUEUE._^1 20 CONTI ‚‚NUE_^11_]_^1C_#QUEUE NOT AN ALLOWED QUEUE. SET INVALID SWITCH._^1 30 LCHEKQ = -1_^11_]_^1C_#RETURN._^1 100 RETURN_^1_$END_]_^__ ‚‚LCHENT CSY/ F26 4530 ‚‚1_$INTEGER FUNCTION LCHENT(ENTRY)_^1_#1_2/F26 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#CHECK ENTRY FOR FUNCTION CODE AND ACTION CODE._^1C_]_^1C_#INTEGER FUNCTION TO CHECK IF AN ENTRY IS A VALID FUNCTION CODE OR_^1C_#VALID ACTION CODE. I ‚‚F IT IS A VALID FUNCTION CODE, RETURN THE INDE_^1C_#OF THE CODE. IF 'ENTRY' IS AN ACTION CODE, RETURNED FUNCTIONAL VAL_^1C_#IS 19. IF 'ENTRY' IS NOT A VALID CODE, RETURNED VALUE IS ZERO._^1C_#CALLING SEQUENCE:_^1C_*VARIABLE = LCHENT(ENTRY)_^1C_#WHERE 'ENTRY' IS THE CODE TO BE SEARCHED FOR._^1C_]_^11_]_^1C_#BRING IN COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1_$INTEGER ENTRY,VALFUN(15), ‚‚NUMFUM_^11_]_^1_$DATA VALFUN/' DADCDFNARLCSEADSP1P2P3NQOASS'/,NUMFUN/15/_^12_]_^1C_#CHECK IF ENTRY IS A FUNCTION CODE._^1_$DO 10 I=1,NUMFUN_^1_$IF(ENTRY.EQ.VALFUN(I)) GO TO 30_^1 10 CONTINUE_^1C_#NOT A FUNCTION CODE. CHECK IF ENTRY IS AN ACTION CODE. BYPASS THIS_^1C_#CHECK IF USER IS CLERICAL USER._^1_$IF(COLTYP.LT.0) GO TO 25_^1_$DO 20 I=1,NUMACT_^1_$IF(ENTRY.EQ.VALACT(I)) GO T ‚‚O 40_^1 20 CONTINUE_^1C_#NOT A VALID FUNCTION OR ACTION CODE. RETURN VALUE = 0._^1 25 LCHENT = 0_^1_$GO TO 70_^11_]_^1C_#ENTRY WAS A VALID FUNCTION CODE. RETURN INDEX._^1 30 LCHENT = I_^1_$GO TO 50_^11_]_^1C_#ENTRY WAS A VALID ACTION CODE. RETURN ITS INDEX._^1 40 LCHENT = NUMFUN + I_^11_]_^1C_#CHECK IF FUNCTION CODE OR ACTION CODE VALID WITH THIS COLLECTOR TY_^1C_#FOR CLERI ‚‚CAL USERS, THE ONLY VALID FUNCTIONS ARE DC(3), NA(5), CS(_^1C_#DS(9), NQ(13), AND OA(14)_^1 50 IF(COLTYP.GE.0) GO TO 60_^1_$IF(LCHENT.NE.3.AND.LCHENT.NE.5.AND.LCHENT.NE.7.AND.LCHENT.NE.9._^1_#1_$AND.LCHENT.NE.13.AND.LCHENT.NE.14) LCHENT=0_^1_$GO TO 70_^11_]_^1C_#FOR COLLECTOR USER, SS(15) IS AN INVALID REQUEST. FOR SUPERVISORS_^1C_#NO FUNCTION IS INVALID._^1 60 IF(COLTYP.EQ.0. ‚‚AND.LCHENT.EQ.15) LCHENT=0_^11_]_^1_!70 RETURN_^1_$END_]_^__ ‚‚LCHSCR CSY/ F27 9660 ‚‚1_$SUBROUTINE LCHSCR(REC,XXXCHG)_^1_#1_2/F27 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#PROCESS CHANGE SCREENS AND HANDLE SPECIAL SUPERVISOR FUNCTIONS._^1C_]_^1C_#ROUTINE TO PROCESS THE BORROWER'S CHANGE SCREEN, THE COSIGNER'S_^1C_#SCREEN ‚‚, AND THE SUPERVISOR'S CHANGE SCREEN. THE ROUTINE CHECKS THE_^1C_#ENTRY IN IOBUF FOR A NUMBER INDICATING A CHANGE TO AN ITEM ON THE_^1C_#SCREEN IS REQUESTED. THE REQUESTED CHANGE IS MADE TO THE MASTER_^1C_#OR COSIGNER RECORD CONTENTS, DISPLAYED ON THE SCREEN, ANY PREVIOUS_^1C_#VALUE OR DATE OF LAST CHANGE FIELDS UPDATE, AND FINALLY THE TRANS-_^1C_#ACTION IS LOGGED IN THE TRANSACTIO ‚‚N FILE. IF THE ENTRY IN IOBUF IS_^1C_#A VALID FUNCTION OR ACTION CODE, CONTROL IS RETURNED TO THE CALLER_^1C_#ANY OTHER ENTRY IN IOBUF RESULTS IN AN ERROR UNLESS IT IS THE CHAR_^1C_#ACTERS 'DL' OR 'UH' WHICH INDICATE A SPECIAL SUPERVISOR FUNCTION._^1C_#CALLING SEQUENCE:_^1C_*CALL LCHSCR(REC,XXXCHG)_^1C_#WHERE:_^1C_#REC_"= THE RECORD THE SCREEN IS DISPLAYING, EITHER MASTER OR_^1C_*C ‚‚OSIGNER._^1C_#XXXCHG = CHANGE SCREEN FILED DESCRIPTIONS FOR THE CURRENT SCREEN_^1C_*SCREEN DISPLAYED, EITHER CUSCHG, COSCHG, OR SUPCHG. FOR A_^1C_*DESCRIPTION OF THIS ARRAY, SEE THE 'GETCHF' SUBROUTINE._^1C_]_^1C_#BRING IN COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER ASCN,CHBIAS(3),CHGDAT,DL,IDATAA(15),IDATDL(15),IDATUH(15)_^1_$INTEGER INVDAT,QDAT,QPOS,UH ‚‚,UPDFLG,REC(1),XXXCHG(1)_^1_$DATA ASCN/$4E/,CHBIAS/0,30,60/,DL/'DL'/,INVDAT/64/,QDAT/300/_^1_$DATA QPOS/271/,UH/'UH'/,UPDFLG/295/,CHGDAT/863/_^1_$INTEGER OLKEYN_^1_$DATA OLKEYN/1047/_^1C**********************************************************138**L/A_^1_$DATA IDATAA/'LAADDACT_/',0,1,0/_^1_$DATA IDATDL/'LASREQDL_/',0,1,0/_^1_$DATA IDATUH/'LAUPHSCM_/',0,1,0/_^1C******************** ‚‚**************************************138**L/A_^11_]_^1_]_^1C***********************************************************************_^1C_#EACH ITEM ON THE BORROWER'S CHANGE SCREEN AND SUPERVISOR'S SCREEN_^1C_#CAN HAVE A PREVIOUS VALUE FIELD AND/OR DATE OF LAST CHANGE FIELD_^1C_#ASSOCIATED WITH IT. THE ARRAY 'PRFLD' CONTAINS THE NECESSARY INFOR_^1C_#MATION TO PERFORM THESE UPDATE TA ‚‚SKS. THE INFORMATION IN 'PRFLD'_^1C_#IS BY GROUPS OF THREE WORDS FOR EACH ITEM WITH THE FOLLOWING_^1C_#DEFINITION:_^1C_$WORD_"MEANING_^1C_%I_$STARTING POSITION IN FILE FOR THE ITEM ON THE CHANGE SCRE_^1C_$I+1_#STARTING POSITION IN FILE OF THE PREVIOUS VALUE FIELD FOR_^1C_-THIS ITEM. A VALUE FOR THIS FIELD OF ZERO INDICATES NO_^1C_-PREVIOUS VALUE FIELD EXISTS FOR THIS ITEM._^1C_$I+2 ‚‚_#STARTING POSITION IN FILE OF DATE OF LAST CHANGE FIELD TO_^1C_-BE UPDATED WHEN THIS ITEM IS CHANGED. DO NOT CONFUSE THIS_^1C_-DATE WITH POSITION 863 IN THE MASTER FILE, THE DATE THE_^1C_-ACCOUNT LAST CHANGED VIA CHANGE SCREEN, OR POSITION 300_^1C_-IN THE MASTER FILE, DATE QUEUE CHANGED. THESE FIELDS ARE_^1C_-AUTOMATICALLY UPDATED WHEN A CHANGE OCCURS. A VALUE OF ZE_^1C‚_,FOR THIS ‚‚ FIELD INDICATES NO DATE OF LAST CHANGE FIELD IS_^1C_-ASSOCIATED WITH THIS ITEM._^1C_#'NITEM' IS THE START WORD OF THE LAST PREVIOUS FIELD DESCRIPTION_^1C_#IN 'PRFLD' ARRAY, I.E., NITEM = 3*(# ITEMS)-2 ._^1C_#ITEMS WITH PREVIOUS VALUE OR DATE OF LAST CHANGE FIELDS IN THIS_^1C_#VERSION ARE: (IN THE ORDER THEY APPEAR IN 'PRFLD')_^1C_*1. BORROWER'S ADDRESS LINE 1._^1C_*2. BORROWER'S ‚‚ADDRESS LINE 2._^1C_*3. BORROWER'S CITY/STATE._^1C_*4. BORROWER'S ZIP._^1C_*5. QUEUE ACCOUNT ASSIGNED._^11_]_^1_$INTEGER PRFLD(15),NITEM_^1_$DATA PRFLD/48,757,0,78,787,0,108,817,0,128,837,0,271,296,0/_^1_$DATA NITEM/13/_^1C***********************************************************************_^1._]_^1C_]_^1C_#GET FIRST CHARACTER OUT OF IOBUF._^1 10 CALL CCSGET(IOBUF,ONE,J)_^1C_# ‚‚CHECK IF NUMERIC._^1_$IF(J.GE.$30.AND.J.LE.$39) GO TO 100_^1C_#NOT NUMERIC. IF SCREEN IS SUPERVISOR'S SCREEN, CHECK ENTRY FOR_^1C_#SPECIAL FUNCTIONS 'DL' AND 'UH'._^1_$IF(LS.NE.35) GO TO 50_^1C_#ON SUPERVISOR'S SCREEN._^1_$IF(IOBUF(1).NE.DL.AND.IOBUF(1).NE.UH) GO TO 50_^11_]_^1C_#HAVE SPECIAL FUNCTIONS REQUEST. THIRD CHARACTER WILL INDICATE WHIC_^1C_#ACCOUNT._^1_$CALL CCSGET(IOBUF, ‚‚THREE,J)_^1C_#IF BLANK, USE ACCOUNT NUMBER OF ACCOUNT CURRENTLY DISPLAYED._^1_$IF(J.EQ.$20) GO TO 20_^1C_#IF COMMA, USE ACCOUNT NUMBER INPUT AFTER REQUEST._^1C_#IF NOT A BLANK OR COMMA, INVALID ENTRY._^1_$IF(J.NE.$2C) GO TO 60_^11_]_^1C_#ACCOUNT NUMBER WAS ENTERED. MOVE IT TO FILE BUFFER._^1_$CALL CCSMVA(IOBUF,FOUR,NUMLEN,OBUF,ONE,NUMLEN)_^1_$GO TO 25_^11_]_^1C_#NO ACCOUNT NUMBER E ‚‚NTERED. USE NUMBER FROM ACCOUNT ON DISPLAY._^1 20 CALL CCSMVA(MASREC,ONE,NUMLEN,OBUF,ONE,NUMLEN)_^11_]_^1C_#MOVE IN REQUESTOR'S ID._^1 25 OBUF(9) = TRNSBF(9)_^1_$OBUF(10) = TRNSBF(10)_^11_]_^1C_#ZERO REQUEST BUFFER AND OPEN APPROPRIATE FILE TO SAVE REQUEST IN._^1_$DO 30 I=1,24_^1 30 REQBFF(I) = 0_^1_$IF(IOBUF(1).EQ.DL) CALL OPENFL(REQBFF,IDATDL,ISTAT)_^1_$IF(IOBUF(1).EQ.UH) C ‚‚ALL OPENFL(REQBFF,IDATUH,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 35_^1C_#NO ERROR, STORE RECORD INTO THE FILE IF USER NOT A TRAINEE._^1_$IF(UFLAG.EQ.0) CALL PUTS(REQBFF,OBUF,ONE,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 40_^1C_#NO ERROR, CLOSE FILE AND PROMPT FOR NEXT ENTRY._^1_$CALL CLOSFL(REQBFF,ISTAT)_^1_$GO TO 270_^11_]_^1C_#FILE ERROR DURING OPEN REQU ‚‚EST._^1 35 J = 3_^1_$GO TO 45_^11_]_^1C_#FILE ERROR DURING PUTS REQUEST._^1 40 J = 11_^1C_#OUTPUT APPROPRIATE ERROR MESSAGE._^1 45 IF(IOBUF(1).EQ.DL) CALL FILERR(IDATDL,J,ISTAT,LU)_^1_$IF(IOBUF(1).EQ.UH) CALL FILERR(IDATUH,J,ISTAT,LU)_^11_]_^1C_#FILE ERRORS ARE FATAL. CLOSE ALL FILES AND EXIT._^1_$CALL LCLANX_^12_]_^1C_#CHECK IF ENTRY IS A FUNCTION OR ACTION CODE. RETURN IF Y ‚‚ES._^1 50 IOBUF(1) = LCHENT(IOBUF(1))_^1_$IF(IOBUF(1).GT.0) GO TO 280_^11_]_^1C_#NOT A FUNCTION OR ACTION CODE. INVALID ENTRY._^1 60 CALL LDSPLY(INVENT,DUMMY)_^1_$GO TO 10_^12_]_^1C_#FIRST CHARACTER WAS NUMERIC, CHECK SECOND CHARACTER._^1 100 CALL CCSGET(IOBUF,TWO,K)_^1C_#CHECK FOR A COMMA INDICATING ONE DIGIT NUMBER._^1_$IF(K.EQ.$2C) GO TO 120_^1C_#NOT A COMMA. CHECK FOR NUME ‚‚RIC INDICATING TWO DIGIT NUMBER._^1_$IF(K.GE.$30.AND.K.LE.$39) GO TO 110_^1C_#NOT A COMMA OR NUMERIC ENTRY. INVALID ENTRY._^1_$GO TO 60_^12_]_^1C_#TWO DIGIT NUMERIC ENTRY. CONVERT TO A NUMBER._^1 110 J = ICCSAD(IOBUF(1))_^1C_#SET STARTING POSITION IN IOBUF FOR DATA._^1_$STRPOS = 4_^1C_#CHECK THIRD CHARACTER FOR A COMMA. INVALID ENTRY IF NOT._^1_$CALL CCSGET(IOBUF,THREE,K)_^1_$IF(K ‚‚.NE.$2C) GO TO 60_^1_$GO TO 130_^11_]_^1C_#ONE DIGIT NUMERIC ENTRY. CONVERT TO A NUMBER._^1 120 J = J - $30_^1C_#SET STARTING POSITION IN IOBUF FOR DATA._^1_$STRPOS = 3_^12_]_^1C_#VERIFY ITEM NUMBER SELECTED IS WITHIN MAXIMUM ALLOWABLE NUMBER._^1C_#INVALID ENTRY IF ITEM NUMBER IS OUT OF RANGE._^1 130 IF(J.LT.1.OR.J.GT.XXXCHG(1)) GO TO 60_^11_]_^1C_#ITEM NUMBER IS WITHIN BOUNDS. C ‚‚HECK IF A FIELD IS ASSOCIATED WITH_^1C_#THIS NUMBER._^1_$K = 3*J - 1_^1C_#INVALID ENTRY IF NO FIELD ASSOCIATED WITH THIS ITEM NUMBER._^1_$IF(XXXCHG(K).LT.0) GO TO 60_^11_]_^1C_#EXTRACT LENGTH AND FIELD TYPE FROM DESCRIPTION._^1_$LENGTH = XXXCHG(K+1)/$10_^1_$FLDTYP = AND(XXXCHG(K+1),$F)_^11_]_^1C_#CHANGES IN DATES REQUIRE VALIDATION._^1_$IF(FLDTYP.NE.1) GO TO 160_^11_]_^1C_#CHECK FO ‚‚R FOUR OR SIX CHARACTER DATE ENTERED._^1 150 I = STRPOS + 4_^1_$CALL CCSGET(IOBUF,I,L)_^1_$IF(L.NE.$20) GO TO 155_^1C_#SIX CHARACTER DATE, USE YEAR ENTERED._^11_]_^1C_#FOUR CHARACTER DATE. DETERMINE YEAR._^1_$L = YEAR_^1_$CALL CCSCST(IOBUF,STRPOS,FOUR,DATE,ONE,FOUR,COMPIN)_^1_$IF(COMPIN.LT.0) L=NXTYR_^1C_#SAVE YEAR._^1_$CALL CCSMVA(L,ONE,TWO,IOBUF,I,TWO)_^1C_#VALIDATE CHANGE IN DA ‚‚TE._^1 155 IF(IDATVR(IOBUF,STRPOS).GE.0) GO TO 170_^1C_#INVALID DATE. REPORT ERROR._^1_$CALL LDSPLY(INVDAT,DUMMY)_^1_$GO TO 10_^11_]_^1C_#IF CHANGE IS TO AN AMOUNT FIELD, CONVERT INPUT DATA INTO A STANDAR_^1C_#NINE DIGIT AMOUNT FIELD._^1 160 IF(FLDTYP.NE.3) GO TO 170_^11_]_^1C_#HAVE AMOUNT FIELD, CONVERT IT._^1_$CALL LPKAMT(IOBUF,STRPOS,KEY,ONE)_^1C_#MOVE AMOUNT BACK TO POSITION ‚‚IN IOBUF._^1_$CALL CCSMVA(KEY,ONE,NINE,IOBUF,STRPOS,NINE)_^11_]_^12_]_^1C_#MOVE OLD DATA INTO TRANSACTION FILE BUFFER._^1 170 CALL CCSMVA(REC,XXXCHG(K+2),LENGTH,TRNSBF,OLDPOS,LENGTH)_^1C_#MOVE NEW DATA INTO TRANSACTION FILE BUFFER._^1_$CALL CCSMVA(IOBUF,STRPOS,LENGTH,TRNSBF,NEWPOS,LENGTH)_^1C_#MOVE THE NEW DATA INTO THE FILE._^1_$CALL CCSMVA(IOBUF,STRPOS,LENGTH,REC,XXXCHG(K+2),LEN ‚‚GTH)_^1._]_^1C_]_^1C_#CHECK IF FIELD HAS A PREVIOUS VALUE FIELD TO UPDATE._^1C_]_^1_$IF(LS-35) 200,205,240_^1C_]_^1C_#BORROWER'S SCREEN. MOVE IN CHANGE DATE._^1 200 CALL CCSMVA(DATE,ONE,SIX,REC,CHGDAT,SIX)_^1C_#SET BORROWER'S CHANGE SCREEN UPDATE FLAG INDICATING CHANGE MADE._^1_$CALL CCSPUT(ASC01,UPDFLG,MASREC)_^1C_#SET UPDATE TYPE FOR TRANSACTION._^1_$TRNSBF(16) = CHBIAS(1) + J_^ ‚‚1_$GO TO 210_^11_]_^1C_#SUPERVISOR'S CHANGE SCREEN. CHECK IF ITEM CHANGED WAS QUEUE AND_^1C_#MOVE IN CHANGE DATE IF YES._^1 205 IF(XXXCHG(K+2).NE.QPOS) GO TO 207_^1C_#YES, QUEUE CHANGE OCCURRED._^1_$CALL CCSMVA(DATE,ONE,SIX,REC,QDAT,SIX)_^1C_#SET UPDATE TYPE FOR TRANSACTION._^1 207 TRNSBF(16) = CHBIAS(3) + J_^11_]_^1C_#CHECK IF ITEM CHANGED WAS ACCOUNT NAME._^1 210 IF(XXXCHG(K+2 ‚‚).NE.NAMPOS) GO TO 230_^11_]_^1C_#NAME CHANGE OCCURRED. FLAG ACCOUNT BY WRITING ACCOUNT NUMBER TO TH_^1C_#ADD ACCOUNT FILE INDICATING NAME CHANGE. MOVE ACCOUNT NUMBER TO OU_^1C_#PUT BUFFER._^1_$CALL CCSCST(DUMMY,ZERO,ZERO,MASREC,OLKEYN,SIX,COMPIN)_^1_$CALL CCSMVA(REC,ONE,NUMLEN,OBUF,ONE,NUMLEN)_^1C_#PUT FLAG IN POSITION 17 INDICATING NAME CHANGE OCCURRED._^1_$CALL CCSPUT(ASCN,NUMLE ‚‚N+1,OBUF)_^1C_#ZERO REQUEST BUFFER AND OPEN ADD ACCOUNT FILE._^1_$DO 211 I=1,24_^1 211 REQBFF(I) = 0_^1_$CALL OPENFL(REQBFF,IDATAA,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 215_^1C_#NO ERROR, STORE THE RECORD INTO THE FILE IF USER NOT A TRAINEE._^1_$IF (UFLAG.EQ.0.AND.COMPIN.EQ.0) CALL PUTS (REQBFF,OBUF,ONE,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 220_^1C_ ‚‚#NO ERROR, CLOSE FILE._^1_$CALL CLOSFL(REQBFF,ISTAT)_^1C_#SAVE OLD KEY VALUE OF NAME FOR DELETE RECORD REQUEST IN NAME_^1C_#CHANGE ROUTINE IF FRESH NAME CHANGE._^1_$IF(COMPIN.EQ.0) CALL CCSMVA(TRNSBF,OLDPOS,SIX,MASREC,OLKEYN,SIX)_^1_$GO TO 230_^11_]_^1C_#FILE ERROR DURING OPEN REQUEST._^1 215 J = 3_^1_$GO TO 225_^1C_#FILE ERROR DURING PUTS REQUEST._^1 220 J = 11_^1 225 CALL FILE ‚‚RR(IDATAA,J,ISTAT,LU)_^1C_#FATAL FILE ERROR, TERMINATE._^1_$CALL LCLANX_^11_]_^1C_#CHECK IF THERE ARE PREVIOUS VALUE OR DATE OF LAST CHANGE FIELDS_^1C_#TO UPDATE FOR THIS ITEM._^1 230 DO 235 I=1,NITEM,3_^1_$IF(XXXCHG(K+2).NE.PRFLD(I)) GO TO 235_^1C_#FOUND ITEM CONTAINED IN 'PRFLD'. UPDATE PREVIOUS VALUE AND DATE OF_^1C_#LAST CHANGE FIELDS IF REQUIRED._^1_$IF(PRFLD(I+1).GT.0)_^1_#1 ‚‚_$CALL CCSMVA(TRNSBF,OLDPOS,LENGTH,REC,PRFLD(I+1),LENGTH)_^1_$IF(PRFLD(I+2).GT.0)_^1_#1_$CALL CCSMVA(DATE,ONE,SIX,REC,PRFLD(I+2),SIX)_^1_$GO TO 245_^1 235 CONTINUE_^1_$GO TO 245_^11_]_^1C_#COSIGNER'S SCREEN. NO PREVIOUS FIELDS. SET TRANSACTION UPDATE TYPE_^1 240 TRNSBF(16) = CHBIAS(2) + J_^1C_#SET FLAG TO INDICATE ACTIVITY ENTERED-RECORD MAY NEED TO BE CREATE_^1_$COSFLG = 1_^12_] ‚‚_^1C_#SET UP OUTPUT BUFFER._^1 245 OBUF(1) = XYWORD(1)_^1_$OBUF(2) = XXXCHG(K)_^1C_#CHECK IF FIELD NEEDS EDITING._^1_$IF(FLDTYP.EQ.1.OR.FLDTYP.EQ.4.OR.FLDTYP.EQ.6.OR.FLDTYP.EQ.3)_^1_#1_$GO TO 250_^1C_#NOT EDIT REQUIRED. MOVE IN NEW DATA FOR WRITE._^1_$CALL CCSMVA(IOBUF,STRPOS,LENGTH,OBUF,FIVE,LENGTH)_^1C_#SET LENGTH FOR WRITE. ADD 4 BYTES FOR CURSOR POSITIONING._^1_$LENGTH = LENGT ‚‚H + 4_^1_$GO TO 260_^11_]_^1C_#EDIT REQUIRED. EDIT ACCORDING TO FIELD TYPE._^1 250 CALL EDIT(IOBUF,STRPOS,OBUF,FIVE,FLDTYP)_^1C_#SET LENGTH FOR WRITE. ADD 4 BYTE OF CURSOR POSITIONING AND 2 BYTES_^1C_#FOR EDIT CHARACTERS EXCEPT AMOUNT FIELDS WHICH HAVE ONLY 1 BYTE OF_^1C_#EDIT CHARACTERS._^1_$LENGTH = LENGTH + 6_^1_$IF(FLDTYP.EQ.3) LENGTH=LENGTH-1_^12_]_^1C_#SET RECORD TYPE AND UP ‚‚DATE TYPE FOR TRANSACTION._^1 260 TRNSBF(15) = TYPE2_^1_$TRNSBF(16) = (TRNSBF(16)/10 + $30)*$100 +_^1_#1_$(TRNSBF(16) - (TRNSBF(16)/10)*10 + $30)_^1_$CALL LSVTRN_^1C_#OUTPUT NEW FIELD TO SCREEN._^1_$CALL WTREAD(LU,XYN,OBUF,LENGTH,ZERO,ZERO,ZERO,TC)_^14_]_^1C_#OPERATION COMPLETE. GET NEXT REQUEST._^1 270 CALL LDSPLY(CSNXTF,DUMMY)_^1_$GO TO 10_^1._]_^1C_#CHECK FOR ENTRY OF A FUNCTI ‚‚ON THAT MAY NOT CHANGE THE CURRENT SCRE_^11_]_^1C_#CHECK FOR ENTRY OF AN ACTION CODE INITIATING THE ACTIVITY SEQUENCE_^1 280 IF(IOBUF(1).LT.16) GO TO 285_^1C_#YES, ACTIVITY SEQUENCE ENTRY SELECTED._^1_$CALL LEACTS_^1C_#UPON RETURN, IOBUF(1) CONTAINS THE NEXT FUNCTION REQUEST._^1_$GO TO 10_^11_]_^1C_#CHECK FOR ENTRY OF 'EA' SELECTING TRAINING METHOD OF ENTRY FOR_^1C_#ACTIVITY._^1 2 ‚‚85 IF(IOBUF(1).NE.8) GO TO 290_^1C_#'EA' IS THE NEXT FUNCTION REQUEST._^1_$CALL LEATRN_^1C_#UPON RETURN, IOBUF(1) CONTAINS THE NEXT FUNCTION REQUEST._^1_$GO TO 10_^11_]_^1C_#CHECK FOR A PERMANENT COMMENT CHANGE REQUEST._^1 290 IF(IOBUF(1).LT.10.OR.IOBUF(1).GT.12) RETURN_^1C_#HAVE PERMANENT COMMENT CHANGE REQUEST._^1_$CALL LPCPRC_^1C_#PROMPT FOR ENTRY OF NEXT FUNCTION._^1_$GO TO 2 ‚‚70_^12_]_^1_$END_]_^__ ‚‚LCLANX CSY/ F29 3720 ‚‚1_$SUBROUTINE LCLANX_^1_#1_2/F29 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#CLOSE ALL OPEN FILES AND EXIT._^1C_]_^1C_#TERMINATION MODULE TO CLOSE ALL OPEN FILES AND PERFORM THE LOG-OFF_^1C_#LOG-OFF IS DONE VIA A CHAIN REQUEST WITH AN EXIT ‚‚ COMMAND._^1C_]_^11_]_^1C_#RETRIEVE COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER EXITRQ(4)_^1_$DATA EXITRQ/'EX_$'/_^11_]_^12_]_^1C_#CLOSE DELINQUENT MASTER FILE._^1_$CALL CLOSFL(REQBFD,ISTAT)_^11_]_^1C_#CLOSE SCREEN FILE._^1_$CALL CLOSFL(REQBFS,ISTAT)_^11_]_^1C_#CLOSE MAIN TRANSCATION FILE._^1_$CALL CLOSFL(REQBFT,ISTAT)_^11_]_^1C_#CLOSE DAILY ASSIGNMENT F ‚‚ILE._^1_$CALL CLOSFL(REQBFA,ISTAT)_^11_]_^1C_#CLOSE FLOATER FILE OPEN._^1_$CALL CLOSFL(REQBFF,ISTAT)_^11_]_^1C_(CLOSE SECONDARY BACKUP TRANSACTION FILE IF USED_^1_$IF(TRBKFL.EQ.1) CALL CLOSFL(REQBFB,ISTAT)_^11_]_^1C_#DELETE COLLECTOR FROM ACTIVE USER FILE, IF LOGGED ON._^1_$IF(CID(1).LT.0) GO TO 50_^11_]_^1C_#ZERO REQUEST BUFFER AND OPEN FILE._^1_$DO 10 I=1,24_^1 10 REQBFF(I) = 0 ‚‚_^1_$CALL OPENFL(REQBFF,IDATAU,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 25_^1C_#RETRIEVE RECORD FROM FILE USEING COLLECTOR/LOG-ON ID AS KEY_^1_$CALL READR (REQBFF,MASREC,TRNSBF(9),ISTAT)_^1C_#CHECK FOR ERROR. OR WRONG KEY RETRIEVAL._^1_$IF(ISTAT.LT.0.OR.AND(ISTAT,WRONKY).EQ.WRONKY) GO TO 30_^1C_#CORRECT RECORD FOUND, DELETE IT._^1_$CALL DELREC(REQBFF,MASREC,ISTAT)_^1C_ ‚‚#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 35_^1C_#NO ERROR, CLOSE FILE AND EXIT._^1_$GO TO 45_^11_]_^1C_#FILE ERROR DURING LOG OFF FROM ACTIVE USER FILE._^11_]_^1C_#OPEN FILE ERROR._^1 25 J = 3_^1_$GO TO 40_^11_]_^1C_#READR ERROR._^1 30 J = 13_^1_$GO TO 40_^11_]_^1C_#DELREC ERROR._^1 35 J = 16_^11_]_^1C_#REPORT ERROR, CLOSE FILE AND EXIT._^1 40 CALL FILERR(IDATAU,J,ISTAT,L ‚‚U)_^11_]_^1C_#CLOSE FILE._^1 45 CALL CLOSFL(REQBFF,ISTAT)_^12_]_^1C_#EXECUTE CHAIN REQUEST TO PERFORM LOG-OFF._^1 50 CALL CHAIN(EXITRQ)_^12_]_^1_$END_]_^__ ‚‚LDAASC CSY/ F33 6790 ‚‚1_$SUBROUTINE LDAASC_^1_#1_2/F33 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#DISPLAY ACTIVITY SCREENS._^1C_]_^1C_#ROUTINE TO DISPLAY COLLECTION ACTIVITIES FROM THE MASTER RECORD_^1C_#AND ACTIVITY HISTORY FILE. DISPLAY BEGINS WITH THE FIRST ‚‚ ACTIVITY_^1C_#FROM THE MASTER RECORD AND CONTINUES WITH ACTIVITIES FROM IT UNTIL_^1C_#THE STRING RETRIEVED MATCHES THE FIRST STRING FROM THE FIRST_^1C_#ACTIVITY HISTORY BLOCK FOR THIS ACCOUNT, IF IT EXISTS. THEN RETRIE_^1C_#VAL OF ACTIVITIES IS FROM THE ACTIVITY HISTORY BLOCKS FOR AS AS MA_^1C_#ACTIVITIES EXIST IN THE ACTIVITY HISTORY FILE FOR THIS ACCOUNT._^1C_#THE ACTIVITIES ARE ‚‚ DISPLAYED ONE LINE AT A TIME STARTING ON THE LI_^1C_#SPECIFIED IN THE SCREEN DEFINITION. ACTIVITIES ARE OUTPUT THRU LIN_^1C_#21, THEN A PROMPT IS ISSUED FOR NEXT FUNCTION. AN ENTRY OF 'AA' WI_^1C_#CONTINUE THE DISPLAY IF MORE ACTIVITIES EXIST FOR THIS ACCOUNT._^1C_]_^12_]_^1C_#RETRIEVE THE COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER AA,CLRLIN(52),ENDLEN ‚‚,ENDMSG(12),IDATAC(15),LACFBL(2)_^1_$INTEGER LASTBL,LC,SAVLEN,SAVSTR(36)_^1_$DATA AA/'AA'/,ENDLEN/23/,LACFBL/'0482'/,SAVLEN/-1/_^1_$DATA ENDMSG/'END OF ACTIVITY HISTORY '/_^1C***************************************************************138**L/A_^1_$DATA IDATAC/'LAACTFIL_/',1,1,0/_^1C***************************************************************138**L/A_^1_$DATA CLRLIN/$1B31,0,$1 ‚‚6,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,_^1_#1_$$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,_^1_#2_$$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,_^1_#3_$$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,$16,$D0A,0,0/_^11_]_^1C_#INTIALIZE LAST BLOCK FLAG AND OUTPUT LINE COUNTER._^1_$LASTBL = 0_^1_$LC = 0_^1C_#INITIALIZE RETURN VALUE FOR DISPLAY OF ADDITIONA ‚‚L ACTIVITIES REQUE_^1_$ASSIGN 455 TO IRTN2_^12_]_^1C_]_^1C_#OPEN ACTIVITY HISTORY FILE._^1C_]_^1C_#ZERO REQUEST BUFFER._^1_$DO 10 I=1,24_^1 10 REQBFF(I) = 0_^11_]_^1_$CALL OPENFL(REQBFF,IDATAC,ISTAT)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 800_^11_]_^1C_#NO ERROR. RETRIEVE FIRST ACTIVITY HISTORY BLOCK FOR THIS ACCOUNT._^1C_#SET UP KEY FOR RETRIEVAL._^1_$CALL CCSMVA(MASREC, ‚‚ONE,NUMLEN,KEY,ONE,NUMLEN)_^1_$KEY(9) = ASC00_^11_]_^1 20 CALL READR(REQBFF,ACTHST,KEY,ISTAT)_^11_]_^1C_#IF END-OF-FILE, NO BLOCK EXISTS FOR THIS ACCOUNT._^1_$IF(AND(ISTAT,EOF).EQ.EOF) GO TO 50_^1C_#IF RECORD IS LOCKED, REPEAT REQUEST UNTIL RETRIEVAL IS SUCCESSFUL._^1_$IF(AND(ISTAT,LOCKED).EQ.LOCKED) GO TO 20_^1C_#CHECK FOR OTHER ERRORS._^1_$IF(ISTAT.LT.0) GO TO 810_^1C_#CHECK AC ‚‚COUNT IN BLOCK RETRIEVED AGAINST ACCOUNT NUMBER DESIRED._^1_$CALL CCSCST(MASREC,ONE,NUMLEN,ACTHST,ONE,NUMLEN,COMPIN)_^1C_#NO MATCH INDICATES RETRIEVED BLOCK NOT FOR THIS ACCOUNT AND NO BLO_^1C_#EXISTS FOR THE ACCOUNT._^1_$IF(COMPIN.NE.0) GO TO 50_^11_]_^1C_#FOUND FIRST ACTIVITY HISTORY BLOCK FOR ACCOUNT. RETRIEVE AND SAVE_^1C_#FIRST ACTIVITY FROM IT._^1_$OSW = ASC01_^1_$CALL GETACF ‚‚(SAVSTR,ACTHST(10),LACFBL,OSW)_^1C_#HAVE FIRST ACTIVITY SAVED. START RETRIEVAL AND DISPLAY OF ACTIVITI_^1C_#FROM MASTER RECORD._^1_$GO TO 100_^12_]_^1C_#NO BLOCK EXISTS FOR THIS ACCOUNT. SET FLAG TO INDICATE ACCOUNT ONL_^1C_#HAS A MASTER FILE ACTIVITY BLOCK._^1 50 LASTBL = -1_^1._]_^1C_#START RETRIEVING ACTIVITIES FROM MASTER RECORD. RESET OSW TO ALLOW_^1C_#RETRIEVAL TO START WIT ‚‚H THE FIRST ACTIVITY IN MASTER RECORD._^1 100 OSW = ASC01_^11_]_^1C_#RETRIEVE NEXT ACTIVITY._^1 110 CALL GETACF(STRING,MASREC(154),LMASBL,OSW)_^1C_#CHECK IF ALL ACTIVITIES HAVE BEEN RETRIEVED._^1_$IF(OSW.EQ.ASC01) GO TO 130_^11_]_^1C_#NO, HAVE AN ACTIVITY TO DISPLAY. COMPARE AGAINST STRING RETRIEVED_^1C_#FROM FIRST ACTIVITY HISTORY BLOCK. BYPASS THIS COMPARE IF NO BLOCK_^1C_#EXIS ‚‚TED FOR THIS ACCOUNT._^1_$IF(LASTBL.NE.0) GO TO 120_^1C_#IF THE DATE MATCHES-BEGIN RETRIEVING FROM THE ACTIVITY FILE WHERE_^1C_#THE ACTIVITY COMMENTS HAVE BEEN SORTED IN PROPER ORDER TO FORM_^1C_#PARAGRAPHS_^1_$CALL CCSCST(STRING,ONE,SIX,SAVSTR,ONE,SIX,COMPIN)_^11_]_^1C_#IF STRINGS MATCH, START RETRIEVING AND DISPLAYING ACTIVITIES FROM_^1C_#NEW BLOCK._^1_$IF(COMPIN.EQ.0) GO TO 200_ ‚‚^11_]_^1C_#NO MATCH, OUTPUT THIS ACTIVITY TO SCREEN._^1 120 ASSIGN 110 TO IRTN_^1_$GO TO 400_^11_]_^1C_#END OF ACTIVITY RETRIEVAL FROM MASTER RECORD. CHECK IF THIS IS THE_^1C_#END OF ALL ACTIVITIES._^1 130 IF(LASTBL.NE.0) GO TO 225_^11_]_^1C_#NOT THE END OF ACTIVITIES. MOVE ON TO START RETRIEVAL OF ACTIVITIE_^1C_#FROM ACTIVITY HISTORY FILE._^1._]_^1C_#START OF RETRIEVAL OF ACTIVI ‚‚TIES FROM NEW ACTIVITY HISTORY BLOCK._^1C_#RESET OSW TO ALLOW RETRIVAL TO START WITH FIRST ACTIVITY._^1 200 OSW = ASC01_^11_]_^1C_#RETRIEVE NEXT ACTIVITY._^1 210 CALL GETACF(STRING,ACTHST(10),LACFBL,OSW)_^1C_#CHECK IF ALL ACTIVITIES HAVE BEEN RETREIVED FROM THIS BLOCK._^1_$IF(OSW.EQ.ASC01) GO TO 220_^11_]_^1C_#NO, OUTPUT THIS ACTIVITY._^1_$ASSIGN 210 TO IRTN_^1_$GO TO 400_^12_]_^ ‚‚1C_#ACTIVITY HISTORY BLOCK IN USE EXHAUSTED, RETRIEVE NEXT BLOCK._^1 220 CALL GETS(REQBFF,ACTHST,KEY,ISTAT)_^1C_#CHECK FOR END-OF-FILE INDICATING NO OTHER BLOCKS EXIST FOR THIS_^1C_#ACCOUNT._^1_$IF(AND(ISTAT,EOF).EQ.EOF) GO TO 225_^1C_#CHECK FOR OTHER ERRORS._^1_$IF(ISTAT.LT.0) GO TO 820_^1C_#CHECK ACCOUNT NUMBER IN BLOCK RETRIEVED AGAINST ACCOUNT NUMBER_^1C_#DESIRED. MATCH INDICA ‚‚TES ANOTHER BLOCK EXISTS FOR THIS ACCOUNT._^1_$CALL CCSCST(MASREC,ONE,NUMLEN,ACTHST,ONE,NUMLEN,COMPIN)_^1_$IF(COMPIN.EQ.0) GO TO 200_^11_]_^1C_#NO MATCH AND NO MORE ACTIVITIES. SET FLAG TO INDICATE LAST BLOCK._^1 225 LASTBL = 1_^1C_#MOVE END OF ACTIVITY DISPLAY MESSAGE INTO OUTPUT BUFFER._^1 230 CALL CCSMVA(ENDMSG,ONE,ENDLEN,OBUF,ONE,OUTBYT)_^1C_#THERE IS NO DISPLAY OF ADDITIONAL ‚‚ ACTIVITIES, SO ENTRY OF 'AA' FOR_^1C_#NEXT FUNCTION IS INVALID._^1_$ASSIGN 420 TO IRTN2_^1_$GO TO 405_^1._]_^1C_#EDIT ACTIVITY STRING INTO OUTPUT BUFFER._^1 400 CALL CCSBLK(OBUF,OUTBYT)_^1_$CALL LACTED(STRING,OBUF)_^1C_#WRITE OUTPUT BUFFER TO THE SCREEN._^1 405 CALL WTREAD(LU,XYN,OBUF,OUTBYT,ZERO,ZERO,ZERO,TC)_^1C_#INCREMENT LINE COUNT._^1_$LC = LC + 1_^1C_#CHECK IF SCREEN FULL. ‚‚ RETURN TO GET NEXT ACTIVITY IF SCREEN NOT_^1_$IF(LC.LT.(22-LINSTR).AND.LASTBL.LE.0) GO TO IRTN_^11_]_^1C_#SCREEN IS FULL OR END OF ACTIVITIES ENCOUNTERED. PROMPT FOR NEXT_^1C_#FUNCTION._^1 410 CALL LDSPLY(NXTFUN,DUMMY)_^11_]_^1C_#CHECK FOR ENTRY OF 'AA' TO DISPLAY ADDITIONAL ACTIVITIES._^1 415 IF(IOBUF(1).EQ.AA) GO TO IRTN2_^11_]_^1C_#ENTRY NOT 'AA', CHECK FOR OTHER VALID ENTRIE ‚‚S._^1_$IOBUF(1) = LCHENT(IOBUF(1))_^1C_#RETURN IF VALID ENTRY._^1_$IF(IOBUF(1).GT.0) GO TO 425_^11_]_^1C_#NOT A VALID ENTRY. OUTPUT ERROR MESSAGE AND CHECK NEXT ENTRY._^1 420 CALL LDSPLY(INVENT,DUMMY)_^1_$GO TO 415_^13_]_^1C_#CHECK FOR ENTRY OF A FUNCTION THAT MAY NOT CHANGE THE CURRENT SCRE_^11_]_^1C_#CHECK FOR ENTRY OF AN ACTION CODE INITIATING THE ACTIVITY SEQUENCE_^1 425 IF(I ‚‚OBUF(1).LT.16) GO TO 430_^1C_#YES, ENTER ACTIVITY SEQUENCE SELECTED._^1_$CALL LEACTS_^1C_#UPON RETURN, IOBUF(1) CONTAINS THE NEXT FUNCTION REQUEST._^1_$GO TO 415_^11_]_^1C_#CHECK FOR ENTRY OF 'EA', TRAINING METHOD OF ENTRY FOR ACTIVITIES._^1 430 IF(IOBUF(1).NE.8) GO TO 435_^1C_#'EA' IS NEXT FUNCTION._^1_$CALL LEATRN_^1C_#UPON RETURN, IOBUF(1) CONTAINS THE NEXT FUNCTION REQUEST._^1 ‚‚_$GO TO 415_^11_]_^1C_#CHECK FOR PERMANENT COMMENT CHANGE REQUEST._^1 435 IF (IOBUF(1).LT.10.OR.IOBUF(1).GT.12) GO TO 900_^1C_#HAVE PERMANENT COMMENT CHANGE REQUEST._^1_$CALL LPCPRC_^1C_#PROMPT FOR NEXT FUNCTION._^1_$GO TO 410_^1._]_^1C_#ADDITIONAL DISPLAY OF ACTIVITIES REQUESTED. SCREEN IS FULL SO CLEA_^1C_#ALL LINES USED IN THE DISPLAY OF THE ACTIVITIES AND RESET CURSOR T_^1C_#B ‚‚EGINNING OF ACTIVITY DISPLAY._^1 455 IF(SAVLEN.GT.0) GO TO 460_^1C_#NUMBER OF LINES TO BLANK HAS NOT BEEN DETERMINED. SET UP CLRLIN_^1C_#BUFFER TO CLEAR ALL NECESSARY LINES._^1_$CLRLIN(2) = LINSTR - 1_^1_$SAVLEN = 2*(24 - LINSTR)_^1C_#SET CURSOR TO BEGINNING OF DISPLAY OF ACTIVITIES._^1_$CLRLIN(SAVLEN-1) = CLRLIN(1)_^1_$CLRLIN(SAVLEN) = CLRLIN(2)_^1C_#SET LENGTH OF OUTPUT IN BYTES ‚‚._^1_$SAVLEN = 2*SAVLEN_^11_]_^1 460 CALL WTREAD(LU,XYN,CLRLIN,SAVLEN,ZERO,ZERO,ZERO,TC)_^1C_#RESET LINE COUNT._^1_$LC = 0_^1C_#GO RETRIEVE NEXT ACTIVITIES AND DISPLAY THEM._^1_$GO TO IRTN_^1._]_^1C_#FILE ERRORS._^11_]_^1C_#OPEN REQUEST._^1 800 J = 3_^1_$GO TO 830_^11_]_^1C_#READR REQUEST._^1 810 J = 13_^1_$GO TO 830_^11_]_^1C_#GETS REQUEST._^1 820 J = 14_^11_]_^1C_#OUTPUT ERRO ‚‚R MESSAGE TO TERMINAL AND MASTER CONSOLE._^1 830 CALL FILERR(IDATAC,J,ISTAT,LU)_^11_]_^1C_#FILE ERRORS ARE FATAL. CLOSE ALL FILES AND EXIT._^1_$CALL LCLANX_^14_]_^1C_#NORMAL EXIT, CLOSE ACTIVITY HISTORY FILE BEFORE RETURNING._^1 900 CALL CLOSFL(REQBFF,ISTAT)_^1_$RETURN_^1_$END_]_^__ ‚‚LDSPLY CSY/ F38 1030 ‚‚1_$SUBROUTINE LDSPLY(SCREEN,REC)_^1_#1_2/F38 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#DISPLAY SCREEN MODULE FOR LEGAL 2.0 ._^1C_]_^1C_#THIS ROUTINE RETRIEVES A DESIRED SCREEN DEFINITION AND INTERPRETS_^1C_#THE DEFINITION TO DISPLAY A S ‚‚CREEN. EACH DEFINITION CONTAINS A DES_^1C_#CRIPTION OF ALL FIELDS FOR DISPLAY ON THE SCREEN. LDSPLY WILL PROC_^1C_#ONE FIELD AT A TIME FILLING UP AN OUTPUT BUFFER. WHEN IT IS FULL,_^1C_#BUFFER IS WRITTEN TO THE TERMINAL. UPON COMPLETION OF INTERPRETING_^1C_#ALL SCREEN FIELDS, THE LAST OUTPUT STATEMENT ALSO REQUESTS INPUT F_^1C_#ANY SCREEN WITH A SCREEN NUMBER GREATER THAN 10. THE F ‚‚ORMAT OF THE_^1C_#SCREEN DEFINITION RECORD IS:_^1C_]_^1C_#SCREEN DEFINITION RECORD, SDEF:_^1C_*WORD_(VALUE_^1C_+I_*X-Y POSITION ON SCREEN FOR START OF ITEM._^1C_+I+1_(START WORD OF NEXT ITEM IN SCREEN DEFINTION._^1C_+I+2_(LENGTH OF UNEDITED ITEM IN BYTES._^1C_+I+3_(STARTING CHARACTER POSITION IN AN ARRAY, IF_^1C_8APPLICABLE._^1C_+I+4_(FIELD TYPE. (SEE BELOW)._^1C_+I+5_(START OF CON ‚‚STANT SCREEN FIELD IF APPLICABLE._^1C_]_^1C_#FIELD TYPES USED ARE:_^1C_*TYPE_(MEANING_^1C_+0_*CONSTANT SCREEN FIELD._^1C_+1_*DATE. EDIT TO FORM MM/DD/YY._^1C_+2_*ALPHANUMERIC FIELD FROM A FILE._^1C_+3_*NINE DIGIT DOLLAR AMOUNT. EDIT TO 9999999.99 ._^1C_+4_*TEN DIGIT PHONE NUMBER. EDIT TO 999/999-9999 ._^1C_+5_*SIGNALS START OF ACTIVITY DISPLAY._^1C_+6_*SOCIAL SECURITY NUMBER. EDIT ‚‚TO 999-99-9999 ._^1C_+7_*CURRENT TIME DISPLAYED AS 24 HOUR MILITARY TIME_^1C_+8_*CONSTANT SCREN FIELD LABELING A CHANGE SCREEN I_^1C_+9_*REQUESTS DISPLAY OF MOST RECENT ACTIVITY._^1C_]_^1C_#ANY SCREEN WITH A NUMBER LESS THAN FORTY IS PRECEDED BY A CLEAR_^1C_#SCREEN REQUEST. ANY SCREEN WITH A NUMBER GREATER THAN NINE HAS INP_^1C_#EXPECTED IN IOBUF. ANY MASSAGE SCREEN (SCREENS 40-89) ‚‚ ARE PRECEDED_^1C_$BY A CLEAR OF LINE 23._^1C_#INTIAL OUTPUT BUFFER SIZE IS 80 BYTES. THE DIMENSIONED BUFFER SIZE_^1C_#MUST BE A LEAST ELEVEN BYTES LARGER TO ALLOW FOR OVERFLOW FROM THE_^1C_#EDIT ROUTINE._^12_]_^1C_#BRING IN COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER ASCNIN(5),ASCZER(5),AVALSP,CLRCUT,EDTLEN(10),LENSAV,NEEDSP_^1_$INTEGER NOINP,NXTBYT,SDE ‚‚F(1000),TIME(2),SCREEN,REC(1)_^1_$DATA ASCNIN/5*$3939/,ASCZER/5*$3030/,CLRCUT/40/,NOINP/10/_^1_$DATA EDTLEN/0,8,0,10,12,0,11,4,0,0/_^12_]_^1C_#HARD CODED MESSAGE SCREENS._^1_$INTEGER HCMESG(82),HCSTLN(6)_^1_$DATA HCMESG/'ENTER ITEM,CHANGE OR NEXT FUNCTION OR ACTION,RESULT,L_^1_#1ETTER REQUEST,COMMENTENTER NEXT FUNCTION OR ACTION,RESULT,LETTER R_^1_#2EQUEST,COMMENTINVALID REQUEST, P ‚‚LEASE REENTER'/_^1C_#STARTING POSITION AND LENGTHS OF EACH OF THE THREE MESSAGES._^1_$DATA HCSTLN/1,74,75,59,134,31/_^12_]_^1C_#INITIALIZE STARTING BYTE FOR OUTPUT BUFFER._^1_$NXTBYT = 1_^1C_#CHECK IF SCREEN IS A HARD CODED MESSAGE SCREEN FUNCTION._^1_$IF(SCREEN.LT.0) GO TO 500_^1C_#CHECK IF SCREEN IS A MESSAGE SCREEN REQUIRING A CLEAR LINE 23_^1C_#BEFORE WRITING ON IT._^1_$IF(SCRE ‚‚EN.LT.40.OR.SCREEN.GT.89) GO TO 5_^1C_#YES, MOVE IN CONTROLS TO CLEAR LINE 23._^1_$OBUF(1) = XYWORD(1)_^1_$OBUF(2) = 22_^1_$OBUF(3) = XYWORD(3)_^1C_#SET NEXT BYTE AVAILABLE._^1_$NXTBYT = 6_^1C_#NOT A MESSAGE SCREEN. RETRIEVE SCREEN DEFINITION FROM FILE._^1_!5 J = SCREEN_^1_$CALL READR(REQBFS,SDEF,J,ISTAT)_^1C_#CHECK FOR SCREEN NOT PRESENT OR OTHER ERROR._^1_$IF(ISTAT.LT.0.OR.AND(I ‚‚STAT,WRONKY).EQ.WRONKY) GO TO 800_^1C_#SCREEN DEFINITION RETRIEVED. INTIALIZE INDEX INTO DEFINITION RECOR_^1_$J = 2_^1C_#CHECK IF CLEAR SCREEN FUNCTION SHOULD BE DONE FIRST._^1_$IF(SCREEN.GE.CLRCUT) GO TO 20_^1C_#SCREEN TYPE INDICATES CLEAR SCREEN TO BE DONE._^1_$CALL WTREAD(LU,XYN,CLRSCR,ONE,ZERO,ZERO,ZERO,TC)_^1_$GO TO 20_^11_]_^1C_#RETRIEVE INDEX FOR NEXT SCREEN DEFINITION FIELD ‚‚._^1 10 J = SDEF(J+1)_^1C_#CHECK IF SCREEN DISPLAY IS COMPLETE._^1_$IF(J.NE.0) GO TO 20_^1C_#END OF SCREEN DEFINITION. CHECK IF INPUT IS TO BE RECEIVED._^1_$IF(SCREEN.GE.NOINP) GO TO 550_^1C_#NO INPUT TO BE RECEIVED. WRITE OUTPUT BUFFER AND RETURN._^1_$ASSIGN 900 TO IRTN_^1_$GO TO 400_^1C_#PLACE CURSOR POSITIONING WORDS IN OUTPUT BUFFER. SINCE THE OUTPUT_^1C_#BUFFER IS SCANNED BY ‚‚ THE ITOS EXECUTIVE TO BIAS THE POSITIONING WO_^1C_#THE SEQUENCE CANNOT BE SEPARATED BY DIFFERENT WRITE OPERATIONS._^1C_#CHECK IF ENOUGH BYTES ARE AVAILABLE IN THE OUTPUT BUFFER FOR THE_^1C_#FOUR BYTES OF CURSOR POSITIONING._^1 20 IF(OUTBYT-NXTBYT-3) 30,40,50_^11_]_^1C_#NOT ENOUGH ROOM. WRITE OUTPUT BUFFER BEFORE MOVING IN CURSOR WORDS_^1 30 ASSIGN 50 TO IRTN_^1_$GO TO 400_^11_ ‚‚]_^1C_#ENOUGH ROOM FOR CURSOR WORDS, BUT BUFFER IS THEN FULL. WRITE BEFOR_^1C_#CONTINUING. NEVER PASS A FILLED OUTPUT BUFFER TO FIELD TYPE PROCES_^1C_#SING ROUTINES._^1 40 CALL CCSMVA(XYWORD,ONE,TWO,OBUF,NXTBYT,TWO)_^1_$NXTBYT = NXTBYT + 2_^1_$CALL CCSMVA(SDEF(J),ONE,TWO,OBUF,NXTBYT,TWO)_^1_$NXTBYT = NXTBYT +2_^1_$ASSIGN 60 TO IRTN_^1C_#WRITE OUTPUT BUFFER._^1_$GO TO 400_^11_]_^1 ‚‚C_#ENOUGH ROOM FOR CURSOR WORDS. MOVE THEM INTO OUTPUT BUFFER._^1 50 CALL CCSMVA(XYWORD,ONE,TWO,OBUF,NXTBYT,TWO)_^1_$NXTBYT = NXTBYT + 2_^1_$CALL CCSMVA(SDEF(J),ONE,TWO,OBUF,NXTBYT,TWO)_^1_$NXTBYT = NXTBYT + 2_^11_]_^1C_#BRANCHED GO TO TO JUMP TO APPROPRIATE ROUTINE TO FILL AND EDIT OUT_^1C_#BUFFER WITH FIELDS ACCORDING TO THEIR TYPE._^1 60 I = SDEF(J+4) + 1_^1C_#FIELD TYPE = ‚‚0_!1_!2_!3_!4_!5_!6_!7_!8_!9_^1_$GO TO_%(200,100,200,100,100,150,100,300,200,160),I_^1._]_^1C_]_^1C_#SCREEN TYPES REQUIRE EDIT. CHECK IF FIELDS HAVE NON-BLANK ENTRIES._^1C_#IF FIELD IS ALL BLANK - BYPASS EDIT AND OUTPUT._^1C_#IF FIELD IS ALL ZEROES - EDIT ONLY FOR AMOUNT FIELDS._^1C_#IF FIELD IS NUMERIC - EDIT._^1C_#IF FIELD IS APLHA - EDIT AS AN ALPHA FIELD ONLY FOR PHONE NUMBER A ‚‚_^1C_*SOCIAL SECURITY NUMBER FIELDS._^1C_]_^1C_#COMPARE AGAINST ALL ZERO FIELD._^1 100 STRPOS = SDEF(J+3)_^1_$LENGTH = SDEF(J+2)_^1_$CALL CCSCST(REC,STRPOS,LENGTH,ASCZER,ONE,LENGTH,I)_^1C_#CHECK RETURN INDICATOR._^1_$IF(I) 130,110,120_^11_]_^1C_#ALL ZEROES PRESENT. EDIT ONLY IF FIELD IS AN AMOUNT FIELD._^1 110 IF(SDEF(J+4).EQ.3) GO TO 300_^1C_#NOT AN AMOUNT FIELD. BYPASS EDIT AND ‚‚ OUTPUT._^1_$GO TO 130_^11_]_^1C_#FIELD IS NOT ALL BLANK OR ALL ZEROES. COMPARE AGAINST ALL NINE FIE_^1C_#TO DETERMINE IF FIELD IS NUMERIC OR APLHA._^1 120 CALL CCSCST(REC,STRPOS,LENGTH,ASCNIN,ONE,LENGTH,I)_^1C_#GO TO EDIT ROUTINE IF FIELD IS NUMERIC._^1_$IF(I.LT.0) GO TO 300_^1C_#FIELD IS ALPHA. EDIT AS AN ALPHA FIELD IF PHONE NUMBER OR SOCIAL_^1C_#SECURITY NUMBER FIELD._^1_$IF(S ‚‚DEF(J+4).GE.4) GO TO 200_^11_]_^1C_#NO FIELD PRESENT TO EDIT OR UNUSED FIELD TYPE. REMOVE X-Y POSITION_^1C_#ING WORDS FOR THIS FIELD FROM OUTPUT BUFFER IF PRESENT._^1 130 IF(NXTBYT.GT.4) NXTBYT=NXTBYT-4_^1C_#GO PROCESS NEXT SCREEN FIELD._^1_$GO TO 10_^1._]_^1C_#ACTIVITY DISPLAY REQUESTED. SAVE STARTING LINE NUMBER._^1 150 LINSTR = AND($FF,SDEF(J)) + 1_^1C_#WRITE OUTPUT BUFFER._^1 ‚‚_$ASSIGN 950 TO IRTN_^1_$GO TO 400_^11_]_^1C_#DISPLAY MOST RECENT ACTIVITY. CHECK IF THIS ACTIVITY HAS ALREADY_^1C_#BEEN RETRIEVED._^1 160 IF(ACTRET.NE.0) GO TO 170_^11_]_^1C_#NO. RETRIEVE IT FROM MASTER FILE AND SET FLAG._^1_$ISTAT = ASC01_^1_$CALL GETACF(FSTACT,MASREC(154),LMASBL,ISTAT)_^1_$ACTRET = 1_^11_]_^1C_]_^1C_#WRITE CURRENT CONTENTS OF OUTPUT BUFFER IF IT CONTAINS ANYTHI ‚‚NG._^1 170 IF(NXTBYT.EQ.1) GO TO 175_^1_$ASSIGN 175 TO IRTN_^1_$GO TO 400_^11_]_^1C_#EDIT ACTIVITY INTO OUTPUT BUFFER AND WRITE IT._^1 175 CALL CCSBLK(OBUF,OUTBYT)_^1_$CALL LACTED(FSTACT,OBUF)_^1C_#SET NXTBYT FOR OUTPUT LENGTH._^1_$NXTBYT = 80_^1_$ASSIGN 10 TO IRTN_^1_$GO TO 400_^1._]_^1C_]_^1C_#NO EDIT TO PERFORM. DIRECT MOVEMENT OF CHARACTERS WHICH IS INTER-_^1C_#RUPTIBLE WHEN ‚‚BUFFER IS FULL._^1C_]_^1C_#INTIALIZE STARTING CHARACTER POSITION IN SOURCE ARRAY._^1 200 STRPOS = SDEF(J+3)_^1C_#CHECK IF OUTPUT BUFFER HAS ENOUGH ROOM FOR ALL OF THE FIELD._^1 210 AVALSP = OUTBYT - (NXTBYT-1)_^1_$NEEDSP = SDEF(J+2) - (STRPOS - SDEF(J+3))_^1_$IF(AVALSP.GE.NEEDSP) GO TO 220_^11_]_^1C_#NOT ENOUGH ROOM. MOVE ONLY ENOUGH CHARACTERS TO FILL OUTPUT BUFFER_^1_$LENGTH = ‚‚AVALSP_^1_$GO TO 230_^11_]_^1C_#ENOUGH ROOM TO MOVE ENTIRE FIELD._^1 220 LENGTH = NEEDSP_^11_]_^1C_#PERFORM THE MOVE._^1 230 IF(SDEF(J+4).EQ.0.OR.SDEF(J+4).EQ.8) GO TO 240_^1C_#ALPHANUMERIC FIELD FROM FILE. SOURCE ARRAY IS FROM REC._^1_$CALL CCSMVA(REC,STRPOS,LENGTH,OBUF,NXTBYT,LENGTH)_^1_$GO TO 250_^11_]_^1C_#CONSTANT SCREEN FIELD. SOURCE ARRAY IS FROM SCREEN DEFINITION FIEL_^1 ‚‚240 CALL CCSMVA(SDEF(J+5),STRPOS,LENGTH,OBUF,NXTBYT,LENGTH)_^11_]_^1C_#CALCULATE NEXT BYTE AVAILABLE IN OUTPUT BUFFER._^1 250 NXTBYT = NXTBYT + LENGTH_^1C_#OPERATION COMPLETE IF ALL OF FIELD MOVED._^1_$IF(NEEDSP.EQ.LENGTH) GO TO 10_^11_]_^1C_#OPERATION NOT COMPLETE. ONLY PART OF STRING MOVED. SAVE NEW STARTI_^1C_#CHARACTER OF SOURCE FIELD FOR NEXT MOVE._^1_$STRPOS = STRPOS + LENG ‚‚TH_^1C_#WRITE FILLED OUTPUT BUFFER AND RETURN TO MOVE IN REMAINDER OF FIEL_^1_$ASSIGN 210 TO IRTN_^1_$GO TO 400_^1._]_^1C_]_^1C_#EDIT FIELDS TO OUTPUT BUFFER. EDIT IS UNITERRUPTIBLE, SO OVERFLOW_^1C_#OF OUTPUT BUFFER IS ALLOWED AND CORRECTED AFTER THE EDIT._^1C_]_^1C_#PERFORM THE EDIT._^1 300 IF(SDEF(J+4).EQ.7) GO TO 310_^1_$CALL EDIT(REC,SDEF(J+3),OBUF,NXTBYT,SDEF(J+4))_^1_$GO TO ‚‚ 320_^11_]_^1C_#TIME REQUEST._^1 310 CALL CCSTIM(TIME)_^1_$CALL CCSMVA(TIME,ONE,FOUR,OBUF,NXTBYT,FOUR)_^11_]_^1C_#CALCULATE NEXT AVAIABLE WORD IN OUTPUT BUFFER._^1 320 I = SDEF(J+4) + 1_^1_$NXTBYT = NXTBYT + EDTLEN(I)_^1C_#CHECK IF OVERFLOW OF OUTPUT BUFFER OCCURRED. RETURN TO PROCESS NEX_^1C_#SCREEN FIELD IF NO OVERFLOW OCCURRED._^1_$IF(OUTBYT.GE.(NXTBYT-1)) GO TO 10_^11_]_^1C_# ‚‚OVERFLOW OCCURRED. WRITE THE FILLED OUTPUT BUFFER AND THEN MOVE TH_^1C_#THE OVERFLOW CHARACTERS TO THE BEGINNING OF THE BUFFER._^1C_#SAVE THE NUMBER OF CHARACTERS TO MOVE._^1_$LENSAV = (NXTBYT - 1) - OUTBYT_^1C_#RESET NXTBYT FOR LENGTH CALCULATION IN OUTPUT SECTION._^1_$NXTBYT = OUTBYT + 1_^1_$ASSIGN 330 TO IRTN_^1_$GO TO 400_^11_]_^1C_#PERFORM THE MOVE OF OVERFLOW CHARACTERS._^1 3 ‚‚30 CALL CCSMVA(OFAREA,ONE,LENSAV,OBUF,ONE,LENSAV)_^1C_#CALCULATE NEXT AVAILABLE WORD IN OUTPUT BUFFER._^1_$NXTBYT = LENSAV + 1_^1C_#GO PROCESS NEXT SCREEN FIELD DEFINITION._^1_$GO TO 10_^1._]_^1C_]_^1C_#WRITE OUTPUT BUFFER ROUTINE._^1C_]_^1C_#SET LENGTH OF OUTPUT BUFFER TO WRITE._^1 400 LENGTH = NXTBYT - 1_^1_$CALL WTREAD(LU,XYN,OBUF,LENGTH,ZERO,ZERO,ZERO,TC)_^1C_#OPERATION FINI ‚‚SHED. RESET NEXT AVAILABLE WORD IN OUTPUT BUFFER AND_^1C_#RETURN._^1_$NXTBYT = 1_^1_$GO TO IRTN_^1._]_^1C_]_^1C_#HARD CODED MESSAGE SCREENS._^1C_]_^1C_#CONVERT SCREEN TO GET MESSAGE SCREEN NUMBER._^1 500 J = -2*SCREEN - 1_^1C_#MOVE IN XY POSITIONING TO CLEAR AND WRITE ON LINE 23._^1_$OBUF(1) = XYWORD(1)_^1_$OBUF(2) = 22_^1_$OBUF(3) = XYWORD(3)_^1C_#MOVE MESSSAGE TO OUTPUT BUFFER._ ‚‚^1_$CALL CCSMVA(HCMESG,HCSTLN(J),HCSTLN(J+1),OBUF,SIX,HCSTLN(J+1))_^1C_#CALCULATE NEXT BYTE AVAILABLE._^1_$NXTBYT = HCSTLN(J+1) + 6_^1._]_^1C_]_^1C_#FINAL SCREEN OUTPUT WITH INPUT TO RECEIVE._^1C_]_^1C_#CHECK IF OUTPUT BUFFER HAS ENOUGH ROOM FOR ALL FIVE BYTES NEEDED T_^1C_#CLEAR LINE 24._^1 550 IF(NXTBYT.LE.76) GO TO 560_^11_]_^1C_#NOT ENOUGH ROOM. WRITE OUTPUT BUFFER BEFORE MOVI ‚‚NG IN THE BYTES TO_^1C_#TO CLEAR LINE 24_^1_$ASSIGN 560 TO IRTN_^1_$GO TO 400_^11_]_^1C_#MOVE IN BYTES TO CLEAR LINE 24._^1 560 CALL CCSMVA(XYWORD,ONE,FIVE,OBUF,NXTBYT,FIVE)_^12_]_^1C_#SET LENGTH OF OUTPUT BUFFER FOR WRITE._^1_$LENGTH = NXTBYT + 4_^1C_#BLANK INPUT BUFFER._^1 570 CALL CCSBLK(IOBUF,INPBYT)_^1C_#PEFORM WRITE/READ. INPUT BUFFER IS IOBUF._^1_$CALL WTREAD(LU,XYN,OBUF,L ‚‚ENGTH,XYN,IOBUF,INPBYT,TC)_^11_]_^1C_#IF A RUBOUT WAS USED TO TERMINATE THE LINE, CLEAR LINE 24 AGAIN AN_^1C_#ACCEPT ANOTHER INPUT LINE._^1 575 IF(TC.NE.4) GO TO 580_^1C_#RUBOUT USED._^1_$CALL CCSMVA(XYWORD,ONE,FIVE,OBUF,ONE,FIVE)_^1_$LENGTH = 5_^1_$GO TO 570_^11_]_^1C_#EDIT INPUT BUFFER REMOVING LEADING BLANKS._^1 580 I = 1_^1_$CALL CCSGET(IOBUF,I,K)_^1C_#IF FIRST CHARACTER IS N ‚‚ON-BLANK, NO EDITING TO DO. RETURN._^1_$IF(K.NE.$20) GO TO 600_^1C_#FIRST CHARACTER WAS BLANK. SCAN TO DETERMINE THE NUMBER OF LEADING_^1C_#BLANKS._^1_$J = IOBUF(41)_^1_$DO 590 I=2,J_^1_$CALL CCSGET(IOBUF,I,K)_^1C_#IF NEXT CHARACTER NOT BLANK, GO PERFORM MOVE TO REMOVE BLANKS._^1_$IF(K.NE.$20) GO TO 595_^1 590 CONTINUE_^1C_#ALL BLANK INPUT BUFFER. RETURN._^1_$IOBUF(41) = 0_^1_$GO ‚‚TO 900_^11_]_^1C_#MOVE IOBUF LEFT TO REMOVE LEADING BLANKS._^1 595 LENGTH = IOBUF(41) - I + 1_^1_$CALL CCSMVA(IOBUF,I,LENGTH,IOBUF,ONE,INPBYT)_^1C_#EDIT COMPLETE, RETURN._^1C_#SAVE LENGTH OF ACTUAL INPUT._^1_$IOBUF(41) = LENGTH_^11_]_^1C_#SCAN INPUT BUFFER REMOVING ALL SPECIAL CHARACTERS (THOSE < $20)._^1 600 J = IOBUF(41)_^1_$DO 610 I=1,J_^1_$CALL CCSGET(IOBUF,I,K)_^1_$IF(K.LT.$ ‚‚20) CALL CCSPUT(BLANKS,I,IOBUF)_^1 610 CONTINUE_^1_$GO TO 900_^1._]_^1C_]_^1C_#FILE ERROR OR SELECTED SCREEN NOT PRESENT._^1C_]_^1 800 J = 13_^1C_#IN CASE OF SELECTED SCREEN NOT PRESENT, SET STATUS WORD TO SCREEN_^1C_#NUMBER REQUESTED BUT NOT FOUND._^1_$IF(AND(ISTAT,EOF).EQ.EOF.OR.AND(ISTAT,WRONKY).EQ.WRONKY)_^1_#1_$ISTAT=SCREEN_^1C_#REPORT ERROR. ERROR FATAL, CLOSE ALL FILES AND ‚‚ EXIT._^1_$CALL FILERR(IDATSC,J,ISTAT,LU)_^1_$CALL LCLANX_^12_]_^1C_#OUTPUT COMPLETE. NORMAL TERMINATION._^1C_#RETRIEVE CHANGE SCREEN FIELD DESCRIPTIONS IF REQUIRED._^1 900 IF(SCREEN.EQ.33.AND.CUSCHG(1).LT.0) CALL GETCHF(SDEF,CUSCHG)_^1C_#SUPERVISOR'S CHANGE SCREEN._^1_$IF(SCREEN.EQ.35.AND.SUPCHG(1).LT.0) CALL GETCHF(SDEF,SUPCHG)_^1C_#COSIGNER'S CHANGE SCREEN._^1_$IF(SCREEN.EQ.94. ‚‚AND.COSCHG(1).LT.0) CALL GETCHF(SDEF,COSCHG)_^11_]_^1C_#UPDATE LAST SCREEN DISPLAYED FLAG IF NOT A MESSAGE SCREEN._^1_$IF((SCREEN.GE.1.AND.SCREEN.LT.40).OR.SCREEN.GE.90) LS=SCREEN_^11_]_^1C_#DISPLAY COMPLETE. RETURN._^1 950 RETURN_^1_$END_]_^__ ‚‚LEACTS CSY/ F39 3160 ‚‚1_$SUBROUTINE LEACTS_^1_#1_2/F39 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#ENTER ACTIVITY SEQUENCE._^1C_]_^1C_#ROUTINE TO HANDLE THE ENTER ACTIVITY ON ACCOUNT REQUEST. IT WILL I_^1C_#TERPRET THE INPUT ACTION CODE, RESULT CODE, LETTER REQ ‚‚UEST CODE, A_^1C_#COMMENT FROM THE INPUT LINE. A VALIDATION CHECK IS THEN MADE ON TH_^1C_#INPUT ACTION/RESULT CODES. IF THE RESULT IS PROMISED TO PAY ('PP')_^1C_#ENTRY OF THE PROMISED TO PAY DATE AND AMOUNT IS REQUIRED. THEN, IF_^1C_#ANY LETTER IS REQUIRED OR REQUESTED, LETTER CODE, ADDRESSEE CODE,_^1C_#LETTER DATE, AND LETTER AMOUNT ARE ENTERED. IF A COMMENT IS REQUIR_^1C_#AND ONE ‚‚ HAS NOT BEEN ENTERED, ENTRY OF A COMMENT IS THEN MADE._^1C_#FINALLY, THE NEXT CONTACT DATE IS ENTERED, UNLESS A SPECIAL VALUE_^1C_#IS TO BE USED._^1C_#BRING IN COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER ELTRFD,EPPFLD,FELTR,FEPPFD,INVADC,INVLDT,INVLAM,INVLC_^1_$INTEGER INVPPA,INVPPD,VPPFDS,VLTRFD_^1_$INTEGER NA_^11_]_^1_$DATA ELTRFD/53/,EPPFLD/48/,FELTR ‚‚/54/,FEPPFD/49/,INVADC/55/_^1_$DATA INVLDT/57/,INVLAM/58/,INVLC/56/,INVPPA/51/,INVPPD/50/_^1_$DATA VPPFDS/52/,VLTRFD/59/_^1_$DATA NA/'NA'/_^12_]_^1C_#CHECK STATUS CODE TO SEE IF ACTIVITY ALLOWED ON THIS ACCOUNT._^1_$J = STATCD_^1_$IF(J.NE.$52.AND.J.NE.$53.AND.J.NE.$57) GO TO 40_^11_]_^1C_#NO ACITIVITY ALLOWED, STATUS CODE IS R, S, OR W._^1_$J = NOACT_^1_$GO TO 410_^12_]_^1C_]_^1C_# ‚‚CONVERT IOBUF(1) BACK TO AN ACTION CODE._^1 40 J = IOBUF(1) - 15_^1_$IOBUF(1)=VALACT(J)_^1C_#BLANK STRING_^1_$CALL CCSBLK(STRING,STRLEN)_^11_]_^1C_#PUT CONTACT DATE IN STRING_^1_$DO 50 I=1,3_^1_!50 STRING(I)=DATE(I)_^1C_#SAVE COLLECTOR ID IN STRING_^1_$STRING(7)=CID(1)_^1_$STRING(8)=CID(2)_^11_]_^1C_#PUT ACTION CODE IN STRING_^1_$ACT=IOBUF(1)_^11_]_^1C_#CHECK THIRD CHARACTER. IN ‚‚PUT COMPLETE IF BLANK, MORE IF COMMA._^1 100 CALL CCSGET(IOBUF,THREE,J)_^1_$IF(J.EQ.$20) GO TO 150_^1_$IF(J.EQ.$2C) GO TO 110_^1C_#NOT A BLANK OR COMMA, FORMAT ERROR_^1_$J = FE_^1_$GO TO 410_^11_]_^1C‚_#CHECK NEXT CHARACTER. DEFAULT RESULT CODE TO BE USED IF A COMMA_^1C_#OTHERWISE PUT THE TWO CHARACTER CODE INTO STRING._^1 110 K = 4_^1_$CALL CCSGET(IOBUF,K,J)_^1_$IF(J.EQ.$2C) GO ‚‚ TO 120_^1_$CALL CCSMVA(IOBUF,FOUR,TWO,RES,ONE,TWO)_^1_$K = 6_^11_]_^1C_#CHECK NEXT CHARACTER. INPUT COMPLETE IF BLANK, MORE INPUT IF COMMA_^1_$CALL CCSGET(IOBUF,K,J)_^1_$IF(J.EQ.$20) GO TO 150_^1_$IF(J.EQ.$2C) GO TO 120_^11_]_^1C_#NOT A BLANK OR COMMA, FORMAT ERROR._^1 115 J = FE_^1_$GO TO 410_^11_]_^1C_#CHECK NEXT CHARACTER. DEFAULT LETTER REQUEST CODE TO BE USED IF A_^1C_#COMMA ‚‚, OTHERWISE CHECK CODE FOR 'L' OR 'N' AND SAVE._^1 120 K=K+1_^1_$CALL CCSGET(IOBUF,K,J)_^1_$IF(J.EQ.$2C) GO TO 130_^1_$IF(J.EQ.$4E) GO TO 125_^1_$IF(J.NE.$4C) GO TO 115_^1C_#FOUND 'L' FLAG THAT A LETTER HAS BEEN REQUESTED._^1_$LTR=J_^1 125 K=K+1_^1C‚_#CHECK NEXT CHARACTER. INPUT COMPLETE IF A BLANK, SAVE COMMENT IF_^1C_#A COMMA_^1_$CALL CCSGET(IOBUF,K,J)_^1_$IF(J.EQ.$20) GO TO ‚‚150_^1_$IF(J.EQ.$2C) GO TO 130_^11_]_^1C_#NOT A BLANK OR COMMA, FORMAT ERROR._^1_$J = FE_^1_$GO TO 410_^11_]_^1C_#SAVE COMMENT IF PRESENT. CALCULATE LENGTH._^1 130 LENGTH = IOBUF(41) - K_^11_]_^1C_#FORMAT ERROR IF NO COMMENT._^1_$IF(LENGTH.LE.0) GO TO 115_^11_]_^1C_#CHECK IF COMMENT IS TOO LONG_^1_$IF(LENGTH.LE.COMLEN) GO TO 140_^11_]_^1C_#YES TOO LONG_^1_$J = INVCOM_^1_$GO TO 41 ‚‚0_^11_]_^1C_#SAVE COMMENT_^1 140 K=K+1_^1_$CALL CCSMVA(IOBUF,K,LENGTH,COM,ONE,LENGTH)_^1._]_^1C‚_#VERIFY ACTIVIY AND RETRIEVE LETTER AND COMMENT REQUIREMENT, AND_^1C_#NEXT CONTACT DATE._^1 150 CALL AVMVAC(AVMAT,ACT,RES,LETREQ,COMREQ,NCD)_^1C_#CHECK FOR INVALID RESULT OR ACTION/RESULT COMBINATION_^1_$IF(NCD.GE.0) GO TO 160_^1_$J = INVRES_^1_$GO TO 410_^11_]_^1C_#CHECK IF RESULT = ‚‚BZ FOR WHICH RL MUST BE PERFORMED_^1 160 IF(RES.EQ.BZ) GO TO 420_^1C_#IF UTIFIL OLPM RECORD NA = 'Y' AND RESULT CODE = NA, IT SHOULD BE_^1C_#TREATED AS AN RL(REVIEW LATER)_^1_$IF(NAEQRL.EQ.$59.AND.RES.EQ.NA) GO TO 420_^11_]_^1C_#VALID ACTIVITY - CHECK IF RESULT IS PP, PROMISED TO PAY._^1_$IF(RES.NE.PP) GO TO 200_^1C‚_"YES, SAVE COMMITMENT DATE._^1_$CALL CCSMVA(DATE,ONE,SIX,MASREC, ‚‚PPMADE,SIX)_^1C_#SET PROMISED TO PAY FLAG IN MASTER RECORD. SET TO A 'Y'._^1_$J = $59_^1_$CALL CCSPUT(J,PPFLAG,MASREC)_^11_]_^1C‚_#PROMPT FOR PP DATE AND AMOUNT_^1_$CALL LDSPLY(EPPFLD,DUMMY)_^11_]_^1C_#CHECK FIFTH CHARACTER TO DETERMINE IF FOUR OR SIX CHARACTER DATE_^1C_#ENTERED._^1 165 CALL CCSGET(IOBUF,FIVE,J)_^1_$IF(J.EQ.$2C) GO TO 170_^11_]_^1C_#SIX CHARACTER DATE. MOVE IT ALL ‚‚ IN._^1_$CALL CCSMVA(IOBUF,ONE,SIX,MASREC,MPPDAT,SIX)_^11_]_^1C_#NEXT CHARACTER SHOULD BE A COMMA, FORMAT ERROR IF NOT_^1_$K=7_]_^1_$CALL CCSGET(IOBUF,K,J)_^1_$IF(J.EQ.$2C) GO TO 180_^1_$CALL LDSPLY(FEPPFD,DUMMY)_^1_$GO TO 165_^11_]_^1C_#FOUR CHARACTER DATE. MOVE IN MONTH AND DAY_^1 170 CALL CCSMVA(IOBUF,ONE,FOUR,MASREC,MPPDAT,FOUR)_^11_]_^1C_#DETERMINE YEAR_^1_$J=YEAR_^1_$IF(IOBU ‚‚F(1).LT.MONTH.OR.(IOBUF(1).EQ.MONTH.AND.IOBUF(2).LT.DAY))_^1_#1_$J = NXTYR_^1C_#SAVE YEAR_^1 175 CALL CCSMVA(J,ONE,TWO,MASREC,MPPDAT+4,TWO)_^1_$K=5_]_^11_]_^1C_#DATA MUST BE IN THE RANGE OF TODAY'S DATE TO A MAXIMUM OF C+P_^1C_#(FROM OLPM UTILITY FILE RECORD) DAYS IN THE FUTURE._^1 180 IF(K.EQ.7) J=IOBUF(3)_^1C_#DETERMINE NUMBER OF YEARS FROM CURRENT YEAR._^1_$J = ICCSAD(J) - ICC ‚‚SAD(YEAR)_^1C_#DETERMINE JULIAN CONVERSION OF DATE. RETURNED <0 IF NOT VALID._^1_$I = ICALJL(MASREC,MPPDAT)_^1C_#CALCULATE NUMBER OF DAYS INPUT DATE IS RELATIVE TO TODAY'S DATE._^1_$J = I + J*365 - JDATE_^1C_#CHECK IF DATE VALID AND WITHIN RANGE._^1_$IF(I.GT.0.AND.J.GE.0.AND.J.LE.MAXNCD+PPLAG) GO TO 185_^1_$CALL LDSPLY(INVPPD,DUMMY)_^1_$GO TO 165_^11_]_^1C_#DATE OK- RETRIEVE AMOUNT ‚‚_^1 185 K=K+1_^1_$CALL LPKAMT(IOBUF,K,MASREC,MPPAMT)_^1C_#AMOUNT MUST BE LESS THAN THE CURRENT BALANCE_^1_$CALL CCSCST(MASREC,MPPAMT,NINE,MASREC,CURBAL,NINE,COMPIN)_^1_$IF(COMPIN.LE.0) GO TO 190_^1_$CALL LDSPLY(INVPPA,DUMMY)_^1_$GO TO 165_^11_]_^1C_#AMOUNT VALID. ASK FOR VALIDATION OF PROMISE TO PAY DATE AND AMOUNT_^1 190 CALL LDSPLY(VPPFDS,MASREC)_^11_]_^1C_#ENTRY OF 'OK' OR CAR ‚‚RIAGE RETURN VALIDATES. ANY OTHER ENTRY IS_^1C_#TREATED AS REENTRY OF THE FIELDS._^1_$IF(IOBUF(41).EQ.0.OR.IOBUF(1).EQ.OK) GO TO 195_^1C***************************************************************138*A010_^1C_(ONE CARD DELETED_^1C***************************************************************138*A010_^1_$GO TO 165_^11_]_^1C_#SAVE PROMISE TO PAY FIELDS IN TRANFL_^1 195 CALL CCSM ‚‚VA(MASREC,MPPDAT,15,TRNSBF,TPPDAT,15)_^1.‚_]_^1C_#PROMPT FOR LETTER FIELDS IF REQUESTED OR REQUIRED_^1 200 IF(LTR.EQ.BLANKS.AND.LETREQ.EQ.0) GO TO 300_^1_$CALL LDSPLY(ELTRFD,DUMMY)_^11_]_^1C_(CHECK FOR VALID ADDRESSEE_^1 205 CALL CCSGET ( IOBUF, ONE, J )_^1_$IF(J.EQ.$42.OR.J.EQ.$48.OR.J.EQ.$31.OR.J.EQ.$32.OR.J.EQ.$33)_^1_#1_!GO TO 210_^1_$CALL LDSPLY(INVADC,DUMMY)_^1_$GO TO 205_^ ‚‚11_]_^1C_#SAVE ADDRESSEE CODE_^1 210 ACODE = J_^11_]_^1C_#NEXT CHARACTER MUST BE A COMMA, FORMAT ERROR IF NOT._^1_$CALL CCSGET(IOBUF,TWO,J)_^1_$IF(J.EQ.$2C) GO TO 220_^1 215 CALL LDSPLY(FELTR,DUMMY)_^1_$GO TO 270_^11_]_^1C_#NEXT TWO CHARACTERS ARE LETTER CODE AND MUST BE NUMERIC. SAVE THEM_^1 220 CALL CCSGET(IOBUF,THREE,J)_^1_$CALL CCSGET(IOBUF,FOUR,K)_^1_$IF((J.GE.$30.AND.J.LE. ‚‚$39).AND.(K.GE.$30.AND.K.LE.$39)) GO TO 225_^11_]_^1C_#LETTER NUMBER NOT NUMERIC OR NOT IN VALID LIST IN UTIFIL_^1 222 CALL LDSPLY(INVLC,DUMMY)_^1_$GO TO 270_^11_]_^11_]_^1C_(VALIDATE THAT THE LETTER NUMBER ENTERED IS ONE OF THE VALID_^1C_(NUMBERS IN UTIFIL_^1 225 IFD = 0_^1_$DO 227 LL = 1,50_^1_$IF(LTRNUM(LL).NE.IOBUF(2)) GO TO 227_^1_$IFD = 1_^1_$LL = 50_^1 227 CONTINUE_^1_$IF ‚‚(IFD.EQ.0) GO TO 222_^1C_#VALID LETTER NUMBER FOUND-SAVE IT_^1_$LTR = IOBUF(2)_^11‚_]_^1C_#CHECK NEXT CHARACTER. INPUT COMPLETE IF BLANK, MORE IF COMMA._^1_$CALL CCSGET(IOBUF,FIVE,J)_^1_$IF(J.EQ.$20) GO TO 260_^1_$IF(J.NE.$2C) GO TO 215_^1C_]_^1C_#CHECK NEXT CHARACTER FOR A COMMA INDICATING DEFAULT LETTER DATE US_^1_$K = 6_^1_$CALL CCSGET(IOBUF,K,J)_^1_$IF(J.NE.$2C) GO TO 230_^11_] ‚‚_^1C_#NO DATE ENTERED, LEAVE FIELD BLANK_^1_$GO TO 255_^11_]_^1C_#CHECK TENTH CHARACTER TO DETERMINE IF FOUR OR SIX CHARACTER DATE_^1C_#ENTERED._^1 230 K = 10_^1_$CALL CCSGET(IOBUF,K,J)_^1_$IF(J.EQ.$2C.OR.J.EQ.$20) GO TO 235_^11_]_^1C_#SIX CHARACTER DATE ENTERED_^1_$CALL CCSMVA(IOBUF,SIX,SIX,TRNSBF,TLDT,SIX)_^1_$K=12_]_^1_$GO TO 245_^11_]_^1C_#FOUR CHARACTER DATE_^1 235 CALL CCSM ‚‚VA(IOBUF,SIX,FOUR,TRNSBF,TLDT,FOUR)_^11_]_^1C_#DETERMINE YEAR_^1_$J=YEAR_^1_$IF(IOBUF(1).LT.MONTH.OR.(IOBUF(1).EQ.MONTH.AND.IOBUF(2).LT.DAY))_^1_#1_!J = NXTYR_^11_]_^1C_#SAVE YEAR_^1 240 CALL CCSMVA(J,ONE,TWO,TRNSBF,TLDT+4,TWO)_^11_]_^1C_#CHECK FOR VALID DATE ENTRY_^1 245 IF(IDATVR(TRNSBF,TLDT).GE.0) GO TO 250_^1_$CALL LDSPLY(INVLDT,DUMMY)_^1_$GO TO 270_^11_]_^1C_#CHECK NEXT CHAR ‚‚ACTER. INPUT COMPLETE IF BLANK,MORE INPUT IF COMMA_^1 250 CALL CCSGET(IOBUF,K,J)_^1_$IF(J.EQ.$20) GO TO 260_^1_$IF(J.NE.$2C) GO TO 215_^11_]_^1C_#RETRIEVE THE AMOUNT ENTERED_^1 255 K=K+1_^1_$CALL LPKAMT(IOBUF,K,TRNSBF,TLTAMT)_^11_]_^1C_#ASK FOR VALIDATION OF LETTER FIELDS_^1 260 TRNSBF(21) = LTR_^1_$CALL LDSPLY(VLTRFD,TRNSBF)_^11_]_^1C_"CONTINUE IF REPLY = CR OR OK, OTHERWISE EN ‚‚TRY REPRESENTS NEW_^1C_#FIELDS_^1_$IF(IOBUF(41).EQ.0.OR.IOBUF(1).EQ.OK) GO TO 300_^11_]_^1C_#BLANK LETTER FIELDS IN TRANSACTION BUFFER AND RECEIVE REVISED FIEL_^1 270 CALL CCSBLK(TRNSBF(53),NUMLEN)_^1_$GO TO 205_^1._]_^1C_#CHECK IF COMMENT ENTRY REQUIRED AND NOT MADE_^1 300 IF(COMREQ.EQ.0.OR.(COM(1).NE.BLANKS)) GO TO 320_^1 305 CALL LDSPLY(COMRQD,DUMMY)_^1 310 IF (IOBUF(41).EQ. ‚‚0) GO TO 305_^1_$LENGTH=IOBUF(41)_^11_]_^1C_#SAVE COMMENT. REENTER IF COMMENT TOO LONG._^1_$IF(LENGTH.LE.COMLEN) GO TO 315_^1_$CALL LDSPLY(COMLNG,DUMMY)_^1_$GO TO 310_^1 315 CALL CCSMVA(IOBUF,ONE,LENGTH,COM,ONE,LENGTH)_^12_]_^1C_#PROMPT FOR ENTRY OF NCD UNLESS SPECIAL VALUE FOR NCD USED_^1 320 IF(ACT.EQ.SR) GO TO 360_^1_$IF(RES.EQ.PP) GO TO 365_^1_$IF(NCD.NE.0) GO TO 322_^11_]_^1 ‚‚C_#NO CHANGE ALLOWED FROM CURRENT NEXT CONTACT DATE. MOVE CURRENT NCD_^1C_#INTO TRANSACTION BUFFER._^1_$CALL CCSMVA(MASREC,MNCD,SIX,TRNSBF,TNCD,SIX)_^1_$GO TO 385_^11_]_^1 322 CALL LDSPLY(ENCD,DUMMY)_^1 325 IF(IOBUF(41).EQ.0) GO TO 370_^11_]_^1C_#CHECK FOR FOUR OR SIX CHARACTER DATE_^1_$CALL CCSGET(IOBUF,FIVE,J)_^1_$IF(J.EQ.$20) GO TO 335_^11_]_^1C_#SIX CHARACTERS_^1_$DO 330 I=1, ‚‚3_^1 330 TRNSBF(I+49) = IOBUF(I)_^1_$GO TO 345_^11_]_^1C_#FOUR CHARACTER DATE_^1 335 TRNSBF(50)=IOBUF(1)_^1_$TRNSBF(51)=IOBUF(2)_^1_$J=YEAR_^1_$IF(IOBUF(1).LT.MONTH.OR.(IOBUF(1).EQ.MONTH.AND.IOBUF(2).LT.DAY))_^1_#1_!J=NXTYR_^1 340 TRNSBF(52)=J_^11_]_^1C_#NEXT CONTACT DATE MUST BE A VALID DATE WITHIN THE RANGE OF_^1C_#TODAY'S DATE AND A MAXIMUM OF A CUSTOMER DEFINED LIMIT IN THE_ ‚‚^1C_#FUTURE._^11_]_^1C_#DETERMINE YEARS DIFFERENCE FROM CURRENT YEAR._^1 345 J = ICCSAD(TRNSBF(52)) - ICCSAD(YEAR)_^1C_#CALCULATE JULIAN DATE FOR INPUT DATE. RETURNED <0 IF NOT VALID._^1_$I = ICALJL(TRNSBF,TNCD)_^1C_#DETERMINE DATE RELATIVE TO TODAY IN DAYS._^1_$J = I + J*365 - JDATE_^1_$IF(I.GT.0.AND.J.GE.0.AND.J.LE.MAXNCD) GO TO 385_^11_]_^11_]_^1C_#INVALID DATE_^1 355 CALL LD ‚‚SPLY(INVNCD,DUMMY)_^1_$GO TO 325_^11_]_^1C_#ACTION = SR. NCD AUTOMATICALLY SET ON TO NEXT DAY._^1 360 NCD=ICALJL(DATE,ONE)+1_^1_$GO TO 375_^11_]_^1C_#RESULT = PP. NCD AUTOMATICALLY SET TO A CUSTOMER DEFINED NCD_^1C_#AFTER DAY PROMISED TO PAY._^1 365 NCD=ICALJL(MASREC,MPPDAT)+PPLAG_^1C***************************************************************138*A010_^1C_(SAVE YEAR OF PP DATE ‚‚. COULD HAVE ALREADY PLACED PP DATE_^1C_(IN NEXT YEAR._^1_$CALL CCSMVA(MASREC,MPPDAT+4,TWO,J,ONE,TWO)_^1_$GO TO 377_^1C***************************************************************138*A010_^11_]_^1C_#DEFAULT NCD SELECTED._^1 370 NCD = ICALJL(DATE,ONE) + NCD_^11_]_^1C_#CONVERT NCD BACK TO CALENDAR DATE AND SAVE._^1 375 J=YEAR_^1C************************************************** ‚‚*************138*A010_^1 377 IF(NCD.GT.365) J=NXTYR_^1C***************************************************************138*A010_^11_]_^1C_#CONVERT NCD AND SAVE YEAR._^1 380 CALL JULCAL(NCD,TRNSBF,TNCD)_^1_$TRNSBF(52)=J_^1._]_^1C_#SAVE INFORMATION IN TRANSACTION FILE_^1 385 DO 390 I=1,6_^1 390 TRNSBF(I+15) = STRING(I)_^11_]_^11_]_^1C_#SAVE ACTIVITY COMMENT IN TRANSACTION BUFFER._ ‚‚^1_$CALL CCSMVA(COM,ONE,COMLEN,TRNSBF(22),ONE,COMLEN)_^11_]_^1C_#SAVE LETTER DATE AND AMOUNT IN MASTER RECORD IF LETTER SENT._^1_$IF(LTR.NE.BLANKS) CALL CCSMVA(TRNSBF,TLDT,15,MASREC,MLTRDT,15)_^11_]_^1C_#SAVE NCD IN MASTER RECORD_^1_$CALL CCSMVA(TRNSBF,TNCD,SIX,MASREC,MNCD,SIX)_^1C_(SAVE THE ACTIVITY COUNT NUMBER_^1_$CALL CCSPUT(ACTCNT,136,TRNSBF)_^11_]_^1C_#SET TRANSACTION TYPE TO ‚‚ '01', COLLECTION ACTIVITY._^1_$TRNSBF(15) = TYPE1_^11_]_^1C_#SAVE TRANSACTION_^1_$CALL LSVTRN_^12_]_^1C_#SAVE ACTIVITY IN MASTER FILE. FORCE STRING INTO COLLECTION ACTIVIT_^1C_#BLOCK._^1_$OSW = ASC01_^1_$CALL PUTACF(STRING,MASREC(154),LMASBL,OSW)_^1C_(BUMP ACTIVITY COUNT BY 1_^1_$ACTCNT = ACTCNT + 1_^11_]_^1C_#ACTIVITY COMPLETE. SET FLAG INDICATING A NEW ACTIVITY HAS BEEN_^1C_#ENT ‚‚ERED, THEN PROMPT FOR NEXT REQUEST._^1 400 ACTRET = 0_^1C_#SET NEXT SCREEN TO PROMPT FOR NEXT FUNCTION REQUEST._^1_$J = -2_^12_]_^1C_#DISPLAY NEXT SCREEN REQUESTED, EITHER ERROR MESSAGE OR NEXT FUNCTI_^1C_#PROMPT._^1C_#DETERMINE IF MESSAGE IS FOR A CHANGE SCREEN OR NOT._^1 410 IF(LS.EQ.33.OR.LS.EQ.35.OR.LS.EQ.94) J=J+1_^1_$CALL LDSPLY(J,DUMMY)_^1C_#RETURN._^1_$GO TO 450_^11_]_^1C ‚‚_#RL FOR BUSY RESULT._^1 420 IOBUF(1)=RL_^12_]_^1C_#RETURN._^1 450 RETURN_^1_$END_]_^__ ‚‚LEATRN CSY/ F40 0010 ‚‚1_$SUBROUTINE LEATRN_^1_#1_2/F40 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#TRAINING METHOD OF ENTRY FOR ACTIVITY._^1C_]_^1C_#ROUTINE TO PERFORM THE TRAINING METHOD OF ENTERING AN ACTIVITY ON_^1C_#AN ACCOUNT. THIS CONSISTS OF PROMPTING FO ‚‚R EACH FIELD INDIVIDUALLY_^1C_#NOT COMBINING LIKE FIELDS AS IN THE NORMAL METHOD. THE ROUTINE_^1C_#PROMPTS FIRST FOR ACTION AND RESULT CODES. AFTER VERIFICATION OF_^1C_#THE ACTION AND RESULT CODE, PROMISED TO PAY FIELDS ARE ENTERED IF_^1C_#RESULT WAS 'PP'. THEN A PROMPT FOR LETTER CODE IS ISSUED. A BYPASS_^1C_#OF LETTER FIELDS CAN BE DONE BY ENTERING NO LETTER CODE, PROVIDING_^1C_# ‚‚NO LETTER IS REQUIRED. AFTER ENTRY OF LETTER FIELDS, A PROMPT IS_^1C_#MADE FOR A COMMENT. NO ENTRY WILL BYPASS ANY COMMENT ENTRY UNLESS_^1C_#A COMMENT IS REQUIRED. FINALLY, A PROMPT IS ISSUED FOR ENTRY OF_^1C_#NEXT CONTACT DATE, UNLESS A SPECIAL VALUE IS TO BE USED. A PRE-_^1C_#DETERMINED DEFAULT NEXT CONTACT DATE CAN BE USED BY NOT ENTERING_^1C_#ONE._]_^12_]_^1C_#BRING IN COMMON M ‚‚ACRO._^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER EACTCD,ERESCD,INVACT,EAPPD,EAEPPD,EAPPA,EAEPPA,EALCD_^1_$INTEGER EALTRQ,EAELCD,EAACD,EAEACD,EALDT,EAELTD,EALTA,EAVLTR,EACOM_^1_$INTEGER EAVPP_^1_$INTEGER NA_^11_]_^1_$DATA EACTCD/70/,ERESCD/71/,INVACT/72/,EAPPD/74/,EAEPPD/75/_^1_$DATA EAPPA/76/,EAEPPA/77/,EALCD/78/,EALTRQ/79/,EAELCD/80/_^1_$DATA EAACD/81/,EAEACD/82/,EALDT/83 ‚‚/,EAELTD/84/,EALTA/85/_^1_$DATA EAVLTR/86/,EACOM/87/,EAVPP/88/_^1_$DATA NA/'NA'/_^12_]_^1C_#CHECK IF ACTIVITY IS ALLOWED ON THIS ACCOUNT._^1_$J = STATCD_^1_$IF(J.NE.$52.AND.J.NE.$53.AND.J.NE.$57) GO TO 10_^1C_#NO ACTIVITY ALLOWED, STATUS CODE IS R, S, OR W._^1_$J = NOACT_^1_$GO TO 600_^11_]_^1C_#ACTIVITY ALLOWED, BLANK STRING AND PROMPT FOR ACTION CODE._^1 10 CALL CCSBLK(STRING,S ‚‚TRLEN)_^1_$CALL LDSPLY(EACTCD,DUMMY)_^1C_#SAVE ACTION CODE._^1_$ACT = IOBUF(1)_^11_]_^1C_#PROMPT FOR RESULT CODE._^1_$CALL LDSPLY(ERESCD,DUMMY)_^1C_#SAVE RESULT CODE._^1_$RES = IOBUF(1)_^11_]_^1C_#VERIFY ACTION AND RESULT CODES._^1_$CALL AVMVAC(AVMAT,ACT,RES,LETREQ,COMREQ,NCD)_^1_$IF(NCD+1) 60,50,100_^11_]_^1C_#INVALID ACTION CODE._^1 50 J = INVACT_^1_$GO TO 600_^11_]_^1C_#INVALI ‚‚D RESULT CODE OR COMBINATION._^1 60 J = INVRES_^1_$GO TO 600_^11_]_^1C_#CHECK FOR RESULT OF BZ FOR WHICH AN RL FUNCTION NEEDS TO BE_^1C_#PERFORMED._^1 100 IF(RES.EQ.BZ) GO TO 620_^1C_#IF UTIFIL OLPM RECORD NA = 'Y' AND RESULT CODE = NA, IT SHOULD BE_^1C_#TREATED AS AN RL (REVIEW LATER)_^1_$IF(NAEQRL.EQ.$59.AND.RES.EQ.NA) GO TO 620_^11_]_^1C_#CHECK FOR RESULT OF PROMISED TO PAY._ ‚‚^1_$IF(RES.NE.PP) GO TO 150_^11_]_^1C_#HAVE PROMISED TO PAY RESULT. MOVE IN DATE COMMITMENT MADE AND SET_^1C_#PROMISED TO PAY FLAG._^1_$CALL CCSMVA(DATE,ONE,SIX,MASREC,PPMADE,SIX)_^1_$J = $59_^1_$CALL CCSPUT(J,PPFLAG,MASREC)_^11_]_^1C_#PROMPT FOR PROMISED TO PAY DATE._^1_$CALL LDSPLY(EAPPD,DUMMY)_^1C_#PICK UP FIRST FOUR CHARACTERS OF DATE._^1 105 CALL CCSMVA(IOBUF,ONE,FOUR,MASREC, ‚‚MPPDAT,FOUR)_^1C_#CHECK FOR FOUR OR SIX CHARACTER DATE ENTERED._^1_$IF(IOBUF(3).EQ.BLANKS) GO TO 110_^11_]_^1C_#HAVE SIX CHARACTER DATE, SAVE YEAR ENTERED._^1_$J = IOBUF(3)_^1_$GO TO 120_^11_]_^1C_#HAVE FOUR CHARACTER DATE, DETERMINE YEAR._^1 110 J = YEAR_^1_$IF(IOBUF(1).LT.MONTH.OR.(IOBUF(1).EQ.MONTH.AND.IOBUF(2).LT.DAY))_^1_#1_$J = NXTYR_^11_]_^1C_#SAVE YEAR._^1 120 CALL CCSMVA ‚‚(J,ONE,TWO,MASREC,MPPDAT+4,TWO)_^11_]_^1C_#DATE MUST BE IN RANGE OF TODAY'S DATE TO A MAXIMUM OF C+P (FROM_^1C_#OPLM RECORD IN UTILITY FILE) DAYS IN THE FUTURE._^11_]_^1C_#DETERMINE NUMBER OF YEARS FROM CURRENT YEAR._^1_$J = ICCSAD(J) - ICCSAD(YEAR)_^1C_#DETERMINE JULIAN CONVERSION OF DATE. RETURNED <0 IF NOT VALID._^1_$I = ICALJL(MASREC,MPPDAT)_^1C_#CALCULATE NUMBER OF DAYS INPUT ‚‚ DATE IS RELATIVE TO TODAY'S DATE._^1_$J = I + J*365 - JDATE_^1C_#CHECK IF DATE VALID AND WITHIN RANGE._^1_$IF(I.GT.0.AND.J.GE.0.AND.J.LE.MAXNCD+PPLAG) GO TO 130_^1C_#INVALID DATE, REENTER._^1_$CALL LDSPLY(EAEPPD,DUMMY)_^1_$GO TO 105_^11_]_^1C_#PROMPT FOR ENTRY OF PROMISED TO PAY AMOUNT._^1 130 CALL LDSPLY(EAPPA,DUMMY)_^1C_#RETRIEVE AMOUNT AS STANDARD NINE DIGIT AMOUNT FIELD._^1 1 ‚‚35 CALL LPKAMT(IOBUF,ONE,MASREC,MPPAMT)_^11_]_^1C_#AMOUNT ENTERED MUST BE LESS THAN THE CURRENT BALANCE._^1_$CALL CCSCST(MASREC,MPPAMT,NINE,MASREC,CURBAL,NINE,COMPIN)_^1_$IF(COMPIN.LE.0) GO TO 140_^1C_#INVALID AMOUNT, BAD FIELD OR GREATER THAN THE CURRENT BALANCE._^1_$CALL LDSPLY(EAEPPA,DUMMY)_^1_$GO TO 135_^11_]_^1C_#VERIFY PORMISED TO PAY FIELDS._^1 140 CALL LDSPLY(EAVPP,MASREC ‚‚)_^1C_#ENTRY OF CR OR OK VALIDATES, ANY OTHER ENTRY IS NEW PP DATE._^1_$IF(IOBUF(41).EQ.0.OR.IOBUF(1).EQ.OK) GO TO 145_^1C_#NEW DATE ENTERED, GO RETRIEVE REVISED DATE AND AMOUNT._^1_$GO TO 105_^11_]_^1C_#SAVE PROMISED TO PAY FIELDS IN TRANASCTION BUFFER._^1 145 CALL CCSMVA(MASREC,MPPDAT,15,TRNSBF,TPPDAT,15)_^1._]_^1C_#PROMPT FOR ENTRY OF LETTER CODE._^1 150 CALL LDSPLY(EALCD,DUMM ‚‚Y)_^1C_#CHECK IF ANY ENTRY MADE._^1 155 IF(IOBUF(41).NE.0) GO TO 160_^1C_#NO ENTRY MADE, INVALID IF LETTER REQUIRED._^1_$IF(LETREQ.EQ.0) GO TO 300_^1C_#LETTER REQUIRED._^1_$CALL LDSPLY(EALTRQ,DUMMY)_^1_$GO TO 155_^11_]_^1C_#CHECK FOR NUMERIC ENTRY ON LETTER CODE._^1 160 CALL CCSGET(IOBUF,ONE,J)_^1_$CALL CCSGET(IOBUF,TWO,K)_^1_$IF(J.GE.$30.AND.J.LT.$3A.AND.K.GE.$30.AND.K.LT.$3A) G ‚‚O TO 165_^1C_#LETTER NUMBER NOT NUMERIC OR NOT IN VALID NUMBERS IN UTIFIL_^1 162 CALL LDSPLY(EAELCD,DUMMY)_^1_$GO TO 155_^11_]_^1C_#VALIDATE THAT THE NUMBER ENTERED IS IN UTIFIL_^1 165 IFD = 0_^1_$DO 166 LL = 1,50_^1_$IF(LTRNUM(LL).NE.IOBUF(1)) GO TO 166_^1_$IFD = 1_^1_$LL = 50_^1 166 CONTINUE_^1_$IF(IFD.EQ.0) GO TO 162_^1C_#VALID LETTER NUMBER FOUND-SAVE IT_^1_$LTR = IOBUF(1)_^ ‚‚11_]_^1C_#PROMPT FOR ADDRESSEE CODE._^1_$CALL LDSPLY(EAACD,DUMMY)_^1C_#MUST BE H, B, 1, 2, OR 3._^1 170 CALL CCSGET(IOBUF,ONE,J)_^1_$IF(J.EQ.$48.OR.J.EQ.$42.OR.J.EQ.$31.OR.J.EQ.$32.OR.J.EQ.$33)_^1_#1_$GO TO 175_^1C_#INVALID ADDRESSEE ENTERED, REENTER._^1_$CALL LDSPLY(EAEACD,DUMMY)_^1_$GO TO 170_^11_]_^1C_#SAVE ADDRESSEE CODE._^1 175 ACODE = J_^1C_#PROMPT FOR LETTER REQUEST DATE._ ‚‚^1_$CALL LDSPLY(EALDT,DUMMY)_^1C_#CHECK FOR DEFAULT (NO) LETTER DATE ENTERED._^1 180 IF(IOBUF(41).EQ.0) GO TO 200_^11_]_^1C_#NO, DATE ENTRY MADE. SAVE FIRST FOUR CHARACTERS._^1_$CALL CCSMVA(IOBUF,ONE,FOUR,TRNSBF,TLDT,FOUR)_^1C_#CHECK IF A FOUR OR SIX CHARACTER DATE ENTERED._^1_$IF(IOBUF(3).EQ.BLANKS) GO TO 185_^1C_#SIX CHARACTER DATE, SAVE YEAR ENTERED._^1_$J = IOBUF(3)_^1_$GO TO ‚‚190_^11_]_^1C_#FOUR CHARACTER DATE, DETERMINE YEAR._^1 185 J =YEAR_^1_$IF(IOBUF(1).LT.MONTH.OR.(IOBUF(1).EQ.MONTH.AND.IOBUF(2).LT.DAY))_^1_#1_$J = NXTYR_^11_]_^1C_#SAVE YEAR._^1 190 CALL CCSMVA(J,ONE,TWO,TRNSBF,TLDT+4,TWO)_^1C_#VERIFY DATE ENTERED._^1_$IF(IDATVR(TRNSBF,TLDT).GE.0) GO TO 200_^1C_#INVALID DATE, REENTER._^1_$CALL LDSPLY(EAELTD,DUMMY)_^1_$GO TO 180_^11_]_^1C_#PROMPT ‚‚FOR LETTER REQUEST AMOUNT._^1 200 CALL LDSPLY(EALTA,DUMMY)_^1C_#CHECK IF DEFAULT (NO) AMOUNT ENTERED._^1_$IF(IOBUF(41).EQ.0) GO TO 210_^1C_#NO, RETRIEVE AMOUNT ENTERED._^1 205 CALL LPKAMT(IOBUF,ONE,TRNSBF,TLTAMT)_^11_]_^1C_#ASK FOR VERIFICATION OF LETTER DATE AND AMOUNT IF ANY ENTERED._^1 210 IF(TRNSBF(54).EQ.BLANKS.AND.TRNSBF(57).EQ.BLANKS) GO TO 300_^1_$CALL LDSPLY(EAVLTR,TRNS ‚‚BF)_^1C_#ENTRY OF CR OR OK VALIDATES, OTHER ENTRIES ARE NEW DATE._^1_$IF(IOBUF(41).EQ.0.OR.IOBUF(1).EQ.OK) GO TO 300_^1C_#RETRIEVE REVISED DATE AND AMOUNT._^1_$GO TO 180_^1._]_^1C_#PROMPT FOR ACTIVITY COMMENT._^1 300 CALL LDSPLY(EACOM,DUMMY)_^1C_#CHECK FOR ENTRY OF A COMMENT._^1 305 IF(IOBUF(41).GT.0) GO TO 310_^1C_#NONE ENTERED, CHECK IF A COMMENT IS REQUIRED._^1_$IF(COMREQ.EQ.0 ‚‚) GO TO 400_^1C_#YES, A COMMENT IS REQUIRED, REENTER._^1_$J = COMRQD_^1 307 CALL LDSPLY(J,DUMMY)_^1_$GO TO 305_^11_]_^1C_#CHECK IF COMMENT ENTERED IS TOO LONG._^1 310 IF(IOBUF(41).LE.COMLEN) GO TO 320_^1C_#COMMENT TOO LONG, REPORT ERROR AND CHECK THE NEXT ENTRY._^1_$J = COMLNG_^1_$GO TO 307_^11_]_^1C_#COMMENT OK, SAVE COMMENT ENTERED._^1 320 CALL CCSMVA(IOBUF,ONE,IOBUF(41),COM,O ‚‚NE,IOBUF(41))_^1_$GO TO 400_^13_]_^1C_#PROMPT FOR NEXT CONTACT DATE UNLESS A SPECIAL VALUE IS TO BE USED._^1 400 IF(ACT.EQ.SR) GO TO 440_^1_$IF(RES.EQ.PP) GO TO 450_^1_$IF(NCD.GT.0) GO TO 410_^1C_#NO CHANGE FROM CURRENT NEXT CONTACT DATE ALLOWED, SAVE CURRENT_^1C_#NEXT CONTACT DATE IN TRANSACTION BUFFER._^1_$CALL CCSMVA(MASREC,MNCD,SIX,TRNSBF,TNCD,SIX)_^1_$GO TO 500_^11_]_^1C_#PRO ‚‚MPT FOR NEXT CONTACT DATE._^1 410 CALL LDSPLY(ENCD,DUMMY)_^1C_#CHECK IF DEFAULT NEXT CONTACT DATE TO BE USED._^1 415 IF(IOBUF(41).EQ.0) GO TO 460_^11_]_^1C_#NO, ENTRY OF A DATE MADE. SAVE FIRST FOUR CHARACTERS OF IT._^1_$CALL CCSMVA(IOBUF,ONE,FOUR,TRNSBF,TNCD,FOUR)_^1C_#CHECK FOR FOUR OR SIX CHARACTER DATE ENTERED._^1_$IF(IOBUF(3).EQ.BLANKS) GO TO 420_^1C_#SIX CHARACTER DATE, SAV ‚‚E ENTERED YEAR._^1_$J = IOBUF(3)_^1_$GO TO 425_^11_]_^1C_#FOUR CHARACTER DATE, DETERMINE YEAR._^1 420 J = YEAR_^1_$IF(IOBUF(1).LT.MONTH.OR.(IOBUF(1).EQ.MONTH.AND.IOBUF(2).LT.DAY))_^1_#1_$J = NXTYR_^11_]_^1C_#SAVE YEAR._^1 425 CALL CCSMVA(J,ONE,TWO,TRNSBF,TNCD+4,TWO)_^11_]_^1C_#NEXT CONTACT MUST BE WITHIN RANGE OF TODAY'S DATE AND A CUSTOMER_^1C_#DEFINED LIMIT IN THE FUTURE._^11_] ‚‚_^1C_#DETERMINE YEARS DIFFERENCE FROM CURRENT YEAR._^1_$J = ICCSAD(J) - ICCSAD(YEAR)_^1C_#CALCULATE JULIAN DATE FOR INPUT DATE._^1_$I = ICALJL(TRNSBF,TNCD)_^1C_#DETERMINE DATE RELATIVE TO TODAY IN DAYS._^1_$J = I + J*365 - JDATE_^1_$IF(I.GT.0.AND.J.GE.0.AND.J.LE.MAXNCD) GO TO 500_^1C_#INVALID DATE, REENTER._^1 430 CALL LDSPLY(INVNCD,DUMMY)_^1_$GO TO 415_^11_]_^1C_#ACTION CODE = SR ‚‚, NEXT CONTACT DATE IS NEXT DAY._^1 440 NCD = ICALJL(DATE,ONE) + 1_^1_$GO TO 470_^11_]_^1C_#RESULT CODE = PP, NEXT CONTACT IS CUSTOMER DEFINED GRACE PERIOD_^1C_#AFTER A BROKEN PROMISE TO PAY._^1 450 NCD = ICALJL(MASREC,MPPDAT) + PPLAG_^1C***************************************************************138*A020_^1C_(SAVE YEAR OF PP DATE. COULD HAVE ALREADY PLACED PP DATE_^1C_(IN NEX ‚‚T YEAR._^1_$CALL CCSMVA(MASREC,MPPDAT+4,TWO,J,ONE,TWO)_^1_$GO TO 477_^1C***************************************************************138*A020_^11_]_^1C_#DEFUALT NEXT CONTACT DATE TO BE USED._^1 460 NCD = ICALJL(DATE,ONE) + NCD_^11_]_^1C_#CONVERT NEXT CONTACT DATE BACK TO CALENDAR DATE AND SAVE._^1 470 J = YEAR_^1C***************************************************************13 ‚‚8*A020_^1 477 IF(NCD.GT.365) J=NXTYR_^1C***************************************************************138*A020_^1_$CALL JULCAL(NCD,TRNSBF,TNCD)_^1_$TRNSBF(52) = J_^1._]_^1C_#PUT CONTACT DATE IN STRING._^1 500 DO 510 I=1,3_^1 510 STRING(I) = DATE(I)_^11_]_^1C_#SAVE COLLECTOR ID IN STRING._^1_$STRING(7) = CID(1)_^1_$STRING(8) = CID(2)_^11_]_^1C_#SAVE CONTACT DATE AND ACTIVITY COD ‚‚E IN TRANSACTION BUFFER._^1_$DO 520 I=1,6_^1 520 TRNSBF(I+15) = STRING(I)_^11_]_^1C_#SAVE ACTIVITY COMMENT IN TRANSACTION BUFFER._^1C_(SAVE THE ACTIVITY COUNT NUMBER_^1_$CALL CCSPUT(ACTCNT,136,TRNSFB)_^1_$CALL CCSMVA(COM,ONE,COMLEN,TRNSBF(22),ONE,COMLEN)_^11_]_^1C_#SAVE LETTER DATE AND AMOUNT IN MASTER FILE IF LETTER SENT._^1_$IF(LTR.NE.BLANKS) CALL CCSMVA(TRNSBF,TLDT,15,MASREC,ML ‚‚TRDT,15)_^11_]_^1C_#SAVE NEXT CONTACT DATE IN MASTER RECORD._^1_$CALL CCSMVA(TRNSBF,TNCD,SIX,MASREC,MNCD,SIX)_^11_]_^1C_#SET TRANSACTION TYPE TO '01', COLLECTION ACTIVITY._^1_$TRNSBF(15) = ASC01_^11_]_^1C_(BUMP ACTIVITY COUNT BY 1_^1_$ACTCNT = ACTCNT + 1_^1C_#SAVE TRANSACTION._^1_$CALL LSVTRN_^11_]_^1C_#SAVE ACTIVITY IN MASTER FILE. FORCE STRING INTO COLLECTION ACITIVT_^1C_#BLOCK._ ‚‚^1_$OSW = ASC01_^1_$CALL PUTACF(STRING,MASREC(154),LMASBL,OSW)_^11_]_^1C_#ACTIVITY COMPLETE. SET FLAG INDICATING A NEW ACTIVITY HAS BEEN_^1C_#ENTERED. THEN PROMPT FOR NEXT FUNCTION._^1_$ACTRET = 0_^1_$J = -2_^1._]_^1C_#LDSPLY NEXT SCREEN REQUESTED, EITHER ERROR SCREEN OR NEXT FUCNTION_^1C_#PROMPT SCREEN. ALTER MESSAGE NUMBER IF MESSAGE IS FOR A CHANGE_^1C_#SCREEN._^1 600 IF(LS.EQ. ‚‚33.OR.LS.EQ.35.OR.LS.EQ.94) J=J+1_^1_$CALL LDSPLY(J,DUMMY)_^1C_#RETURN._^1_$GO TO 650_^11_]_^1C_#RL NEXT FUNCTION REQUEST FOR BZ RESULT._^1 620 IOBUF(1) = RL_^11_]_^1C_#RETURN._^1 650 RETURN_^1_$END_]_^__ ‚‚LNMSRC CSY/ F51 4890 ‚‚1_$SUBROUTINE LNMSRC_^1_#1_2/F51 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#PERFORM NAME SEARCH ON BORROWER'S NAME._^1C_]_^1C_#ROUTINE TO SEARCH THE DELINQUENT MASTER FILE FOR A SELECTED NAME._^1C_#THE MASTER FILE HAS TWO KEYS, THE SECOND ‚‚ARY BEING THE FIRST SIX_^1C_#CHARACTERS OF THE BORROWER'S NAME. AN INITIAL 'READR' REQUEST IS D_^1C_#TO POSITION TO THE START OF THOSE RECORDS WITH THE CORRECT KEY,_^1C_#THEN SUCCESSIVE 'GETS' REQUESTS ARE PERFORMED TO EXTRACT ALL_^1C_#ACCOUNTS MATCHING THE INPUT NAME. AS THE ACCOUNTS ARE FOUND, ONE_^1C_#LINE FOR EACH IS DISPLAYED CONTAINING THE ACCOUNT NAME, ADDRESS LI_^1C_#ONE, A ‚‚ND THE ACCOUNT NUMBER. A MAXIMUM OF NINE NAMES ARE DISPLAYED_^1C_#PER SCREEN. A PROMPT IS THEN ISSUED FOR SELECTION OF AN ACCOUNT_^1C_#LISTED ON THE SCREEN, DISCONTINUATION OF SEARCH, OR CONTINUATION_^1C_#OF SEARCH. IF NO NAME MATCHING THE REQUESTED NAME IS FOUND, A_^1C_#MESSAGE TO THAT EFFECT IS OUTPUT AND CONTROL RETURNED TO CALLER._^1C_#THE RETURN INDICATORS FOR NAME FOUND OR NO ‚‚T FOUND IS THE ACCOUNT_^1C_#NUMBER ARRAY. IF THE DESIRED ACCOUNT IS FOUND, THE ACCOUNT NUMBER_^1C_#IS SAVED IN THE ACCOUNT NUMBER ARRAY. IF THE DESIRED ACCOUNT IS NO_^1C_#FOUND, THE FIRST POSITION OF THE ACCOUNT NUMBER ARRAY IS SET TO -1_^1C_#UPON COMPLETION OF SEARCH, AN 'END OF SEARCH' MESSAGE IS OUTPUT._^1C_]_^1C_#RETRIEVE THE COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VAR ‚‚IABLES._^1_$INTEGER ACTNPS,AD1PS,ADLEN,ADPOS,ENDLEN,ENDMSG(9),KEYLEN_^1_$INTEGER LF,NAMLEN,SERMES,SAVLEN,SAVW13_^1_$DATA ACTNPS/63/,AD1PS/48/,ADLEN/27/,ADPOS/35/,ENDLEN/60/,LF/$A00/_^1_$DATA NAMLEN/30/,SERMES/66/_^1_$DATA ENDMSG/$D0D,'_!END OF SEARCH'/_^1_$DATA ENDLEN/18/_^1._]_^1C_#TWEAK FILE MANAGER REQUEST BUFFER FOR DELINQUENT MASTER FILE TO_^1C_#ALLOW RETRIEVAL BY KEY 2, THE F ‚‚IRST SIX CHARACTERS OF BORROWER'S_^1C_#NAME._^1_$REQBFD(14) = 2_^11_]_^1C_#SAVE CURRENT VALUE OF WORD 13 OF REQUEST BUFFER, THEN CLEAR_^1C_#RECORD LOCKING FLAG._^1_$SAVW13 = REQBFD(13)_^1_$REQBFD(13) = AND($7FFF,REQBFD(13))_^11_]_^1C_#INTIALIZE RETURN VALUE FOR CONTINUE SEARCH REQUEST._^1_$ASSIGN 190 TO IRTN_^11_]_^1C_#GET LENGTH OF INPUT NAME TO SEARCH FOR._^1_$SAVLEN = IOBUF(41) ‚‚- 2_^1C_#LENGTH CANNOT BE GREATER THAN 30._^1_$IF(SAVLEN.GT.30) SAVLEN = 30_^1C_#IF LENGTH IS ZERO, RETURN NAME NOT FOUND._^1_$IF(SAVLEN.EQ.0) GO TO 850_^11_]_^1C_#INITIALIZE OUTPUT COUNTER._^1_$N = 0_^1C_#BLANK KEY POSITIONS OF NAME SAVE ARRAY._^1_$CALL CCSBLK(NAMSAV,SIX)_^1C_#SAVE NAME._^1_$CALL CCSMVA(IOBUF,THREE,SAVLEN,NAMSAV,ONE,SAVLEN)_^1C_#SAVE FILE KEY TO PERFORM READR REQU ‚‚EST WITH._^1_$DO 50 I=1,3_^1 50 KEY(I) = NAMSAV(I)_^11_]_^1C_#SET LENGTH OF KEY FOR LATER COMPARISONS._^1_$KEYLEN = 6_^1C_#IF LENGTH IS LESS THAN SIX, THE KEYLEN IS SAVLEN._^1_$IF(SAVLEN.LT.6) KEYLEN = SAVLEN_^11_]_^1C_#CLEAR SCREEN._^1_$CALL WTREAD(LU,XYN,CLRSCR,ONE,ZERO,ZERO,ZERO,TC)_^12_]_^1C_#PERFORM INITIAL READR._^1_$CALL READR(REQBFD,MASREC,KEY,ISTAT)_^1C_#CHECK FOR END OF ‚‚ FILE TERMINATING SEARCH._^1_$IF(AND(ISTAT,EOF).EQ.EOF) GO TO 115_^1C_#CHECK FOR OTHER ERROR_^1 70 IF(ISTAT.LT.0) GO TO 800_^1._]_^1C_#CHECK FOR MATCH BY KEYLEN CHARACTERS. SEARCH IS COMPLETE IF THE_^1C_#RETRIEVED NAME IS GREATER THAN THE NAME IN SEARCH FOR KEYLEN CHAR-_^1C_#ACTERS._^1C***************************************************************138*A008_^1 100 CALL CCSCST(KEY ‚‚,ONE,KEYLEN,NAMSAV,ONE,KEYLEN,COMPIN)_^1C***************************************************************138*A008_^1_$IF(COMPIN.LE.0) GO TO 120_^1C_#END OF SEARCH. SET FLAG AND DISPLAY END OF SEARCH MESSAGE._^1 115 N = -AND($F,N)_^1_$CALL WTREAD(LU,XYN,ENDMSG,ENDLEN,ZERO,ZERO,ZERO,TC)_^1C_#SET RETURN VALUE FOR CONTINUE SEARCH REQUEST TO AN INVALID REQUEST_^1_$ASSIGN 170 TO IRTN_^1_ ‚‚$GO TO 160_^11_]_^1C_#COMPARISON BY KEYLEN OK. CHECK FOR MATCH BY ENTIRE LENGTH OF INPUT_^1C_#NAME. BYPASS THIS CHECK IF KEYLEN IS THE LENGTH OF INPUT NAME._^1C***************************************************************138*A008_^1 120 CALL CCSCST(MASREC,NAMPOS,SAVLEN,NAMSAV,ONE,SAVLEN,COMPIN)_^1C***************************************************************138*A008_^1_$IF(COM ‚‚PIN.NE.0) GO TO 150_^11_]_^1C_#ACCOUNT MATCHING NAME FOUND. BLANK OUTPUT BUFFER AND MOVE IN NAME,_^1C_#ADDRESS, AND ACCOUNT NUMBER FOR DISPLAY._^1 140 CALL CCSBLK(OBUF,OUTBYT)_^1_$CALL CCSMVA(MASREC,NAMPOS,NAMLEN,OBUF,FOUR,NAMLEN)_^1_$CALL CCSMVA(MASREC,AD1PS,ADLEN,OBUF,ADPOS,ADLEN)_^1_$CALL CCSMVA(MASREC,ONE,NUMLEN,OBUF,ACTNPS,NUMLEN)_^1C_#PLACE ITEM NUMBER IN FRONT OF LINE._^1_$ ‚‚N = N + 1_^1_$OBUF(1) = LF + $30 + N_^1C_#PUT LINE FEED/CARRIAGE RETURN AT END OF OBUF._^1_$OBUF(40) = LF + $D_^1C_#OUTPUT LINE DISPLAYING THIS ACCOUNT._^1_$CALL WTREAD(LU,XYN,OBUF,OUTBYT,ZERO,ZERO,ZERO,TC)_^11_]_^1C_#SAVE ACCOUNT NUMBER._^1_$K = 16*(N-1) + 1_^1_$CALL CCSMVA(MASREC,ONE,NUMLEN,COSREC,K,NUMLEN)_^11_]_^1C_#CHECK IF SCREEN FULL._^1_$IF(N.GE.9) GO TO 155_^11_]_^1C_#SCRE ‚‚EN NOT FULL. RETRIEVE NEXT NAME._^1 150 CALL GETS(REQBFD,MASREC,KEY,ISTAT)_^1C_#CHECK FOR END-OF-FILE INDICATING END OF SEARCH._^1_$IF(AND(ISTAT,EOF).EQ.EOF) GO TO 115_^1C_#CHECK FOR ERROR OTHER THAN RECORD LOCKED._^1_$IF(ISTAT.LT.0.AND.AND(ISTAT,LOCKED).NE.LOCKED) GO TO 810_^1C_#NO ERROR. CHECK RETRIEVED NAME._^1_$GO TO 100_^12_]_^1C_#SCREEN FULL. OUTPUT PROMPT FOR ACTION DESIRED ‚‚. SET 'N' TO ALLOW AN_^1C_#ACCOUNT SELECTION BY INDEX NUMBER._^1 155 N = -9_^1 160 CALL LDSPLY(SERMES,DUMMY)_^1C_#CHECK FOR A CARRIAGE RETURN TO CONTINUE SEARCH._^1 165 IF(IOBUF(41).EQ.0) GO TO IRTN_^1C_#CHECK FIRST CHARACTER._^1_$CALL CCSGET(IOBUF,ONE,J)_^1C_#CHECK FOR A 'D', DISCONTINE SEARCH._^1_$IF(J.EQ.$44) GO TO 850_^1C_#CHECK FOR A NUMBER ($30-$39) INDICATING ACCOUNT SELE ‚‚CTION._^1_$IF(J.GE.$31.AND.J.LE.$39) GO TO 180_^11_]_^1C_#INVALID RESPONSE. REPORT ERROR AND ASK FOR REENTRY._^1 170 CALL LDSPLY(INVENT,DUMMY)_^1_$GO TO 165_^12_]_^1C_#NAME FOUND AND SELECTED. MOVE ACCOUNT NUMBER TO IOBUF AND RETURN._^1C_#VERIFY SELECTED NUMBER HAS AN ACCOUNT NUMBER ASSOCIATED WITH_^1C_#IT ON THE SCREEN._^1 180 J = AND($F,J)_^1_$IF(J+N.GT.0) GO TO 170_^1C_#SELECT ‚‚ED NUMBER OK, FIND AND MOVE ACCOUNT NUMBER._^1_$J = 16*(J-1) + 1_^1_$CALL CCSMVA(COSREC,J,NUMLEN,IOBUF,ONE,NUMLEN)_^1_$GO TO 900_^11_]_^1C_#CONTINUE SEARCH._^1C_#SEARCH STILL ACTIVE, RESET N, CLEAR SCREEN, AND GET NEXT ACCOUNT._^1 190 N = 0_^1_$CALL WTREAD(LU,XYN,CLRSCR,ONE,ZERO,ZERO,ZERO,TC)_^1_$GO TO 150_^1._]_^1C_]_^1C_#FILE ERRORS._^1C_]_^11_]_^1C_#READR REQUEST._^1 800 J = 1 ‚‚3_^1_$GO TO 820_^11_]_^1C_#GETS REQUEST._^1 810 J = 14_^1 820 CALL FILERR(IDATDM,J,ISTAT,LU)_^1C_#FILE ERRORS ARE FATAL, CLOSE ALL FILES AND EXIT._^1_$CALL LCLANX_^12_]_^1C_#ACCOUNT NAME NOT FOUND. RETURN WITH INDICATOR SET TO -1._^1 850 IOBUF(1) = -1_^12_]_^1C_#NORMAL EXIT. RESET FILE MANAGER REQUEST BUFFER TO ALLOW RETRIEVAL_^1C_#BY KEY 1, ACCOUNT NUMBER._^1 900 REQBFD(14) = ‚‚1_^1C_#RESET WORD 13 OF REQUEST BUFFER FOR RECORD LOCKING._^1_$REQBFD(13) = SAVW13_^1_$RETURN_^1_$END_]_^__ ‚‚LPCPRC CSY/ F52 9230 ‚‚1_$SUBROUTINE LPCPRC_^1_#1_2/F52 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#PERMANENT COMMENT CHANGE REQUEST PROCESSOR._^1C_]_^1C_#ROUTINE TO SAVE THE NEW PERMANENT COMMENT IN THE MASTER RECORD AND_^1C_#THE NEW AND THE OLD PERMANENT COMME ‚‚NT IN THE TRANSACTION FILE._^11_]_^1C_#SET STARTING POSITION IN FILE OF PERMANENT COMMENTS, LENGTH OF_^1C_#PERMANENT COMMENTS, AND TRANSACTION TYPE UPDATE CODE BIAS FOR_^1C_#PERMANENT COMMENT TRANSACTIONS._^12_]_^1C_#MOVE IN COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER PCSTRT,PCLEN,PCTRAN_^1_$DATA PCSTRT/667/,PCLEN/30/,PCTRAN/'91'/_^12_]_^1C_#DETERMINE WH ‚‚ICH PERMANENT COMMENT TO CHANGE._^1_$J = IOBUF(1) - 10_^1C_#CALCULATE POINTER TO THIS PERMANENT COMMENT._^1_$I = 30*J + PCSTRT_^1C_#SAVE OLD PERMANENT COMMENT IN TRANSACTION BUFFER._^1_$CALL CCSMVA(MASREC,I,PCLEN,TRNSBF,OLDPOS,PCLEN)_^1C_#SAVE NEW PERMANENT COMMENT IN TRANSACTION FILE._^1_$CALL CCSMVA(IOBUF,FOUR,PCLEN,TRNSBF,NEWPOS,PCLEN)_^1C_#SAVE NEW PERMANENT COMMENT IN MASTER R ‚‚ECORD._^1_$CALL CCSMVA(IOBUF,FOUR,PCLEN,MASREC,I,PCLEN)_^11_]_^1C_#SET RECORD TYPE FOR TRANSACTION FILE._^1_$TRNSBF(15) = TYPE2_^1C_#SET TYPE UPDATE._^1_$TRNSBF(16) = PCTRAN + J_^1C_#SAVE THE TRANSACTION._^1_$CALL LSVTRN_^11_]_^1C_#RETURN._^1_$RETURN_^1_$END_]_^__ ‚‚LPKAMT CSY/ F66 6360 ‚‚1_$SUBROUTINE LPKAMT(INBUF,ISTR,OBUF,OSTR)_^1_#1_2/F66 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#EDIT INPUT AMOUNT FIELD._^1C_]_^1C_#ROUTINE TO CONVERT AN INPUT AMOUNT INTO A STANDARD NINE DIGIT AMOU_^1C_#FIELD. THIS ROUTINE ALLOWS VARIA ‚‚BLE FORM INPUT OF DOLLAR AMOUNTS._^1C_#IF A DECIMAL POINT IS ENTERED, DOLLARS AND CENTS POSITIONS ARE KEY_^1C_#OFF THE POSITION OF THE DECIMAL POINT. ABSENCE OF A DECIMAL POINT_^1C_#IMPLIES THE AMOUNT ENTERED REPRESENTS DOLLARS, UP TO AN AMOUNT SEV_^1C_#DIGITS LONG._^1C_]_^1C_#CALLING SEQUENCE:_^1C_*CALL LPKAMT(INBUF,ISTR,OBUF,OSTR)_^1C_#WHERE:_^1C_#INBUF = ARRAY INPUT AMOUNT IS F ‚‚ROM._^1C_#ISTR_!= STARTING POSITION IN INPUT ARRAY FOR AMOUNT._^1C_#OBUF_!= OUTPUT ARRAY TO RECEIVE THE STANDARD NINE DIGIT FIELD._^1C_#OSTR_!= STARTING POSITION IN OBUF TO PUT THE NINE DIGIT FIELD._^1C_]_^11_]_^1_$INTEGER INBUF,ISTR,OBUF,OSTR_^12_]_^1C_#ZERO FILL OUTPUT FIELD._^1_$J = $30_^1_$L = OSTR + 8_^1_$DO 10 I=OSTR,L_^1 10 CALL CCSPUT(J,I,OBUF)_^12_]_^1C_#SCAN INPUT BUFFE ‚‚R FOR A DECIMAL POINT OR BLANK._^1_$L = ISTR + 8_^1_$DO 20 I=ISTR,L_^1_$CALL CCSGET(INBUF,I,J)_^1_$IF(J.EQ.$20) GO TO 30_^1_$IF(J.EQ.$2E) GO TO 35_^1C_#IF ENTRY NOT A BLANK, DECIMAL POINT, OR A NUMBER, FILL OUTPUT_^1C_#BUFFER WITH NINES._^1_$IF(J.LT.$30.OR.J.GE.$3A) GO TO 50_^1 20 CONTINUE_^11_]_^1C_#NO BLANK OR DECIMAL POINT ENCOUNTERED. MOVE FIRST SEVEN DIGITS AS_^1C_#A DOLLAR ‚‚FIELD._^1_$I = I - 3_^1_$GO TO 45_^12_]_^1C_#FOUND BLANK. MOVE IN ALL PLACES TO THE LEFT AS A DOLLAR AMOUNT._^1 30 I = I - 1_^1_$GO TO 45_^12_]_^1C_#FOUND DECIMAL POINT, MOVE IN NEXT TWO CHARACTERS AS CENTS IF THEY_^1C_#ARE NUMERIC._^1 35 I = I - 1_^1_$DO 40 L=2,3_^1_$CALL CCSGET(INBUF,I+L,J)_^1C_#IF CHARACTER IS NOT BLANK AND NOT NUMERIC, FILL OUTPUT BUFFER WITH_^1C_#NINES. IF ‚‚ BLANK, END OF MOVE._^1_$IF(J.EQ.$20) GO TO 45_^1_$IF(J.LT.$30.OR.J.GE.$3A) GO TO 50_^1_$CALL CCSPUT(J,OSTR+5+L,OBUF)_^1 40 CONTINUE_^12_]_^1C_#MOVE IN DOLLAR FIELD. CALCULATE LENGTH OF ENTERED DOLLAR FIELD._^1 45 I = I - ISTR + 1_^1C_#NO FIELD PRESENT IF LENGTH NOT POSITIVE INTEGER._^1_$IF(I.LE.0) GO TO 50_^1C_#FIELD PRESENT, CALCULATE STARTING POSITION IN OBUF FOR FIELD._^1_$ ‚‚L = 7 - I + OSTR_^1_$CALL CCSMVA(INBUF,ISTR,I,OBUF,L,I)_^1_$GO TO 90_^11_]_^1C_#ERROR, NOT ALL CHARACTERS NUMERIC. RETURN OUTPUT BUFFER FILLED WIT_^1C_#NINES._^1 50 J = $39_^1_$L = OSTR + 8_^1_$DO 60 I=OSTR,L_^1 60 CALL CCSPUT(J,I,OBUF)_^12_]_^1C_#OPERATION COMPLETE, RETURN._^1 90 RETURN_^1_$END_]_^__ ‚‚LSVTRN CSY/ F73 3200 ‚‚1_$SUBROUTINE LSVTRN_^1_#1_2/F73 F LA_!CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY VERISON 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_]_^1C_#SAVE TRANSACTION IN TRANSACTION FILE(S)._^1C_]_^1C_#ROUTINE TO LOG ALL TRANSACTIONS (ACTIVITY AND NON-FINANCIAL CHANGE_^1C_#INTO THE MAIN TRANSACTION FILE AND THE ‚‚ SECONDARY/BACKUP TRANSACTIO_^1C_#FILE IF USED._^1C_]_^12_]_^1C_#RETRIEVE COMMON MACRO._^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES._^1_$INTEGER BLKLEN,PUTSR_^1_$DATA BLKLEN/114/,PUTSR/11/_^12_]_^1C_#PUT STOP TIME INTO TRNASACTION BUFFER._^1_$CALL CCSTIM(TRNSBF(13))_^11_]_^1C_#SAVE TRANSACTION IN MAIN FILE IF USER NOT A TRAINEE._^1_$IF(UFLAG.EQ.0) CALL PUTS(REQBFT,TRNSBF,ONE,ISTAT ‚‚)_^1C_#CHECK FOR ERROR._^1_$IF(ISTAT.LT.0) GO TO 100_^11_]_^1C***********************************************************************_^1C_#IF A SECOND TRANSACTION FILE IS PRESENT ON THE SYSTEM (SEE OPENFL_^1C_#IN FLEGAL) IT IS ASSUMED THAT THE TRANSACTION REPLAY OPTION IS_^1C_#DESIRED. IF THE FLAG 'TRBKFL' = 0-NO BACKUP, IF = 1-BACKUP_^1_$IF(TRBKFL.EQ.0) GO TO 50_^1C_#CHECK IF USER ‚‚ IS A TRAINEE_^1_$IF(UFLAG.EQ.0) CALL PUTS(REQBFB,TRNSBF,ONE,ISTAT)_^1C_#CHECK FOR ERROR_^1_$IF(ISTAT.GE.0) GO TO 50_^1C_#ERROR OCCURRED, REPORT IT, CLOSE ALL FILES AND EXIT_^1_$CALL FILERR(IDATTB,PUTSR,ISTAT,LU)_^1_$CALL LCLANX_^1C***********************************************************************_^11_]_^1C_#TRANSACTION SAVES COMPLETE. BLANK TRANSACTION BUFFER AND RETURN._^1 ‚‚50 CALL CCSBLK(TRNSBF(13),BLKLEN)_^1_$RETURN_^12_]_^1C_#FILE ERROR ON PUTS REQUEST TO MAIN TRANSACTION FILE._^1C_#REPORT ERROR, CLOSE ALL FILES, AND EXIT._^1 100 CALL FILERR(IDATTR,PUTSR,ISTAT,LU)_^1_$CALL LCLANX_^12_]_^1_$END_]_^__ ‚‚PAYENT CSY/ F82 0010 ‚‚1_$SUBROUTINE PAYENT_^1_#1_2/F82 F LA_!CCS 3.0_5SL-149_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_]_^1C_#BRING IN COMMON MACRO_^11_]_^1M_#LEGMAC_^11_]_^1C_#LOCAL VARIABLES FOR L/A ON-LINE FINANCIAL CHANGES_^1C_]_^1_$INTEGER TDIREC(6),TIDREC(6),TNRCC(6),TRCC(6),TFEES(6),TV ‚‚ALIT_^1_$INTEGER LITEM(2),LACCT(8),LLGNO(2),LTYPE(1),LDATE(3),LAMT(5),LCR_^1_$INTEGER LAPYEN,AD,CH,DT,RT,SB,OK,AB,L505(2),L506(2),L507(2)_^1_$INTEGER L508(2),L509(2)_^1_$INTEGER LITMSN,LSBSCN,LMSGSN,LAREC(1890),TREC(47),LWREC(316)_^1C_]_^1_$INTEGER LFD,LCHAR,LGET,LPT,LWK9(5),LWK12(6),LWK18(9),LKEY(8)_^1_$INTEGER LASC0(6),LASC9(6),L2WD(2),LSTRTM(2),LSVSTR,LSLGNO_^1C_]_^1_$INTEGER LW ‚‚ASCH,LWASDT,LWASRT,LRTN,LDRTN,LRRTN,LSRTN_^1C_]_^1_$INTEGER LADMSG(37),LCHMSG(37),LDTMSG(37),LRTMSG(37),LSBMSG(37)_^1_$INTEGER LINVIT(37),LINVAC(37),LINVLG(37),LINVTY(37),LINVDT(37)_^1_$INTEGER LINVAM(37),LINVCR(37),LINVFM(37),LINVFN(37),LINVDF(37)_^1_$INTEGER LABMSG(37),LSBANS(37),LFINDF(37)_^1C_]_^1_$DATA AD/'AD'/,CH/'CH'/,DT/'DT'/,RT/'RT'/,SB/'SB'/,OK/'OK'/_^1_$DATA AB/'AB'/,LAP ‚‚YEN/'P '/,L505/'505 '/,L506/'506 '/,L507/'507 '/_^1_$DATA L508/'508 '/,L509/'509 '/_^1C_#COMMA = $2C PERIOD = $2E DASH = $2D_^1_$DATA LWASCH/0/,LWASDT/0/,LWASRT/0/_^1_$DATA LASC0/6*$3030/,LASC9/6*$3939/_^1C_]_^1_$DATA LITMSN/08/,LSBSCN/09/,LMSGSN/67/_^1C_]_^1_$DATA LFINDF/'PLEASE ENTER THE FUNCTION DESIRED_^1_#1_4'/_^1_$DATA LADMSG/'ADD-PLEASE ENTER ACCOUNT #,LEGAL AGENCY #,TYPE, ‚‚DATE,_^1_#1AMOUNT,(-)(IF CREDIT)'/_^1_$DATA LCHMSG/'CHANGE-PLEASE ENTER ITEM#,ACCT#,LGL/AGY#,TYPE,DATE, A_^1_#1MOUNT,(-)(IF CREDIT) '/_^1_$DATA LDTMSG/'DELETE-PLEASE ENTER ITEM # TO BE DELETED_^1_#1_4'/_^1_$DATA LRTMSG/'REVIEW-ENTER A VALID FUNCTION OR TO VIEW ADDITIO_^1_#1NAL ENTRIES_)'/_^1_$DATA LINVIT/'INVALID ITEM # - MUST START OVER, ENTER AND TRY_^1_#1AGAIN_/'/_^1_$ ‚‚DATA LINVAC/'INVALID ACCOUNT # - RE-ENTER ACCOUNT # OR TO BEG_^1_#1IN NEW ENTRY_('/_^1_$DATA LINVTY/'INVALID TYPE - RE-ENTER TYPE OR TO BEGIN NEW ENT_^1_#1RY_2'/_^1_$DATA LINVDT/'INVALID DATE - RE-ENTER DATE OR TO BEGIN NEW ENT_^1_#1RY_2'/_^1_$DATA LINVAM/'AMOUNT INVALID OR TOO LONG - RE-ENTER AMOUNT OR _^1_#1TO BEGIN NEW ENTRY_!'/_^0_$DATA LINVCR/'INVALID CREDIT ‚‚ SIGN MUST START OVER ENTER CARRIAGE RE_^0_#1TURN_0'/_^1_$DATA LINVFM/'INVALID FORMAT - MUST START OVER, ENTER AND TRY_^1_#1AGAIN_/'/_^1_$DATA LINVFN/'INVALID FUNCTION - RE-ENTER FUNCTION DESIRED_^1_#1_4'/_^1_$DATA LINVDF/'NO DEFAULT ON LGL/AGY# -MUST START OVER, ENTER A_^1_#1ND TRY AGAIN_('/_^1_$DATA LABMSG/'ROUTINE ABORTED--NO UPDATE TO MASTER RECORD - CARRIAG_^1_#1E RE ‚‚TURN TO ABORT_"'/_^1C_EBEGIN LEGAL AGENCY ON-LINE UPDATE_^1C_ECLEAR WORK AREAS_^1 1000 CALL CCSBLK(LAREC,3780)_^1_$CALL CCSBLK(LWREC,632)_^1_$CALL CCSBLK(TREC,94)_^1_$CALL CCSMVA(LASC0,1,4,LITEM,1,4)_^1_$LSVSTR = 1_^1_$TVALIT = 0_^1_$LNUMDT = 0_^1C_ESAVE START TIME_^1_$CALL CCSTIM(LSTRTM)_^1C_EDISPLAY FIRST SCREEN_^1 1025 LWREC(316) = $3031_^1 1030 CALL LDSPLY(LITMSN,LWREC)_^1C_EA ‚‚SK FOR FUNCTION_^1 1035 CALL LDSPLY(LMSGSN,LFINDF)_^1CC_DCHECK TYPE OF FUNCTION DESIRED_^1 1050 IF(IOBUF(1).EQ.AD) GO TO 1100_^1_$IF(IOBUF(1).EQ.CH) GO TO 1200_^1_$IF(IOBUF(1).EQ.DT) GO TO 1300_^1_$IF(IOBUF(1).EQ.RT) GO TO 1400_^1_$IF(IOBUF(1).EQ.SB) GO TO 1500_^1_$IF(IOBUF(41).EQ.0) GO TO 1035_^1_$CALL LDSPLY(LMSGSN,LINVFN)_^1_$GO TO 1050_^1C_]_^1C********************************* ‚‚**_!ADD ROUTINE ******************_^1C_]_^1 1100 CALL LDSPLY(LMSGSN,LADMSG)_^1 1110 LPT = 1_^1_$ASSIGN 1120 TO LRTN_^1C_EGO TO VALIDATE DATA ENTERED_^1_$GO TO 1700_^1C_EIF ERROR DETECTED OPERATOR_^1C_EWANTS TO START OVER_^1 1120 IF(IOBUF(41).EQ.0) GO TO 1125_^1_$GO TO 1140_^1 1125 IF(LWASRT.EQ.1) GO TO LRRTN_^1_$GO TO 1600_^1C_EHAVE VALID ENTRY-MOVE IT TO_^1C_ERECORD AND ADD TO VA ‚‚LID ITEMS CTR_^1 1140 TVALIT = TVALIT + 1_^1_$L = TVALIT_^1_$L0 = L-(L/10)*10_^1_$L = L/10_^1_$L1 = L-(L/10)*10_^1_$L = L/10_^1_$L2 = L-(L/10)*10_^1_$L = L/10_^1_$L3 = L-(L/10)*10_^1_$LITEM(1) = (L3+$30) * $100 + (L2+$30)_^1_$LITEM(2) = (L1+$30) * $100 + (L0+$30)_^1 1150 CALL CCSMVA(LITEM,1,4,LAREC,LSVSTR,4)_^1_$LSVSTR = LSVSTR + 4_^1_$CALL CCSMVA(LACCT,1,16,LAREC,LSVSTR,16)_^1_$LS ‚‚VSTR = LSVSTR + 16_^1_$CALL CCSMVA(LLGNO,1,4,LAREC,LSVSTR,4)_^1_$LSVSTR = LSVSTR + 4_^1_$CALL CCSMVA(LTYPE,1,2,LAREC,LSVSTR,2)_^1_$LSVSTR = LSVSTR + 2_^1_$CALL CCSMVA(LDATE,1,6,LAREC,LSVSTR,6)_^1_$LSVSTR = LSVSTR + 6_^1_$CALL CCSMVA(LAMT,1,9,LAREC,LSVSTR,9)_^1_$LSVSTR = LSVSTR + 9_^1_$CALL CCSMVA(LCR,1,1,LAREC,LSVSTR,1)_^1C_EMOVE LEGAL AGENCY # TO SAVE_^1C_ETO USE AS DEFAULT LATER_ ‚‚^1_$CALL CCSMVA(LLGNO,1,4,LSLGNO,1,4)_^1C_ESET UP START FIELD FOR_^1C_ENEXT ITEM IN LAREC_^1_$LSVSTR = LSVSTR + 1_^1C_EIF CALLING ROUTINE WAS REVIEW_^1_$IF(LWASRT.EQ.1) GO TO LRRTN_^1C_EGO PRINT SCREEN WITH LATEST_^1C_EITEM ON IT AND GET NEXT FNCTN_^1_$GO TO 1600_^1C_]_^1C*********************************_#CHANGE ROUTINE ****************_^1C_@ALSO USED FOR DELETE AND REVIEW TRANS_ ‚‚^1C_]_^1 1200 CALL LDSPLY(LMSGSN,LCHMSG)_^1_$LWASCH = 1_^1 1205 CALL CCSMVA(LASC0,1,4,LITEM,1,4)_^1C_ECHECK ITEM #-CAN BE 1-3 DIGITS,_^1C_EMUST BE NUMERIC AND EQUAL TO_^1C_EAN ITEM# ENTERED PREVIOUSLY_^1C_]_^1C_ECHECK FIRST DIGIT FOR NUMERIC_^1_$CALL CCSGET(IOBUF,1,LGET)_^1_$IF(LGET.LT.$30.OR.LGET.GT.$39) GO TO 1252_^1_$CALL CCSGET(IOBUF,2,LGET)_^1_$IF(LGET.EQ.$2C.OR.LGET.EQ.$20) G ‚‚O TO 1210_^1_$IF(LGET.LT.$30.OR.LGET.GT.$39) GO TO 1252_^1_$CALL CCSGET(IOBUF,3,LGET)_^1_$IF(LGET.EQ.$2C.OR.LGET.EQ.$20) GO TO 1220_^1_$IF(LGET.LT.$30.OR.LGET.GT.$39) GO TO 1252_^1_$CALL CCSGET(IOBUF,4,LGET)_^1_$IF(LGET.NE.$2C.AND.LGET.NE.$20) GO TO 1290_^1_$GO TO 1230_^1C_E1 DIGIT ITEM #_^1C_ERIGHT JUSTIFY ITEM# IN WORK AREA_^1 1210 CALL CCSMVA(IOBUF,1,1,LITEM,4,1)_^1C_EMOVE ENTRY ‚‚ OVER IN IOBUF_^1_$CALL CCSMVA(IOBUF,3,60,IOBUF,1,60)_^1_$GO TO 1240_^1C_E2 DIGIT ITEM #_^1C_ERIGHT JUSTIFY ITEM# IN WORK AREA_^1 1220 CALL CCSMVA(IOBUF,1,2,LITEM,3,2)_^1C_EMOVE ENTRY OVER IN IOBUF_^1_$CALL CCSMVA(IOBUF,4,60,IOBUF,1,60)_^1_$GO TO 1240_^1C_E3 DIGIT ITEM #_^1C_ERIGHT JUSTIFY ITEM# IN WORK AREA_^1 1230 CALL CCSMVA(IOBUF,1,3,LITEM,2,3)_^1C_EMOVE ENTRY OVER IN IOBUF_^1_ ‚‚$CALL CCSMVA(IOBUF,5,60,IOBUF,1,60)_^1_$GO TO 1240_^1C_ELOOK FOR ITEM# ALREADY ENTERED_^1 1240 LFD = 0_^1_$LWORD = 1_^1_$DO 1250 L = 1,TVALIT_^1_$IF(LITEM(1).EQ.LAREC(LWORD).AND.LITEM(2).EQ.LAREC(LWORD+1))_^1_#1GO TO 1245_^1_$LWORD = LWORD + 21_^1_$GO TO 1250_^1C_ERECORD FOUND, SET SWITCH,STOP_^1C_ELOOP (LWORD SAVED FOR LATER)_^1 1245 LFD = 1_^1_$L = TVALIT_^1 1250 CONTINUE_^1C_EIF ‚‚ RECORD WAS NOT FOUND-REPORT_^1_$IF(LFD.EQ.1) GO TO 1255_^1 1252 CALL LDSPLY(LMSGSN,LINVIT)_^1C_EOPERATOR MUST START OVER_^1_$IF(IOBUF(41).NE.0) GO TO 1252_^1_$GO TO 1035_^1C_EIF CALLING ROUTINE WAS DELETE_^1 1255 IF(LWASDT.EQ.1) GO TO LDRTN_^1C_EGO VALIDATE DATA ENTERED_^1_$ASSIGN 1260 TO LRTN_^1_$GO TO 1700_^1C_EIF ERROR FOUND OPERATOR_^1C_EMUST START OVER_^1 1260 IF(IOBUF(41).EQ ‚‚.0) GO TO 1035_^1 1270 LCHAR = (LWORD-1) * 2 + 1_^1_$CALL CCSMVA(LITEM,1,4,LAREC,LCHAR,4)_^1_$LCHAR = LCHAR + 4_^1_$CALL CCSMVA(LACCT,1,16,LAREC,LCHAR,16)_^1_$LCHAR = LCHAR + 16_^1_$CALL CCSMVA(LLGNO,1,4,LAREC,LCHAR,4)_^1_$LCHAR = LCHAR + 4_^1_$CALL CCSMVA(LTYPE,1,2,LAREC,LCHAR,2)_^1_$LCHAR = LCHAR + 2_^1_$CALL CCSMVA(LDATE,1,6,LAREC,LCHAR,6)_^1_$LCHAR = LCHAR + 6_^1_$CALL CCSMVA(L ‚‚AMT,1,9,LAREC,LCHAR,9)_^1_$LCHAR = LCHAR + 9_^1_$CALL CCSMVA(LCR,1,1,LAREC,LCHAR,1)_^1_$LWASCH = 0_^1C_EIF CALLING ROUTINE WAS REVIEW TRN_^1_$IF(LWASRT.EQ.1) GO TO LRRTN_^1C_EGO PRINT SCREEN WITH CHANGED ITEM_^1_$GO TO 1610_^1C_]_^1C_EERROR IN FORMAT OF CHANGE LINE_^1 1290 CALL LDSPLY(LMSGSN,LINVFM)_^1C_GOPERATOR MUST START OVER_^1_$IF(IOBUF(41).NE.0) GO TO 1290_^1_$GO TO 1035_^1C ‚‚*********************************_"DELETE AN ITEM **************_^1C ***USE SAME LOGIC AS CHANGE ROUTINE TO VALIDATE ITEM NUMBER ENTERED_^1 1300 CALL LDSPLY(LMSGSN,LDTMSG)_^1_$LWASDT = 1_^1_$ASSIGN 1310 TO LDRTN_^1_$GO TO 1205_^1C_EVALIDATION ROUTINE INDICATED_^1C_EITEM# ENTERED WAS VALID-_^1C_ECHANGE AMOUNT TO ZERO_^1C_ECHANGE WORD TO CHARACTER DISP_^1 1310 LWASDT = 0_^1_$LCHAR ‚‚= (LWORD-1) * 2 + 1_^1_$CALL CCSMVA(LASC0,2,9,LAREC,LCHAR+32,9)_^1C_LBLANK CREDIT SIGN_^1_$CALL CCSPUT($20,LCHAR+41,LAREC)_^1_$LNUMDT = LNUMDT + 1_^1_$GO TO 1610_^1C************************************_#REVIEW TRANSACTIONS ROUTINE_^1 1400 LWASRT = 0_^1_$CALL CCSMVA(LAREC,1,630,LWREC,1,630)_^1_$LWREC(316) = $3031_^1_$CALL LDSPLY(LITMSN,LWREC)_^1_$CALL LDSPLY (LMSGSN,LRTMSG)_^1_$IF(I ‚‚OBUF(41).EQ.0) GO TO 1410_^1C_#LWASRT = 1_^1C_#ASSIGN 1400 TO LRRTN_^1_$GO TO 1050_^1 1410 LWASRT = 0_^1_$CALL CCSMVA(LAREC,631,630,LWREC,1,630)_^1_$LWREC(316) = $3032_^1_$CALL LDSPLY(LITMSN,LWREC)_^1_$CALL LDSPLY(LMSGSN,LRTMSG)_^1_$IF(IOBUF(41).EQ.0) GO TO 1420_^1C_#LWASRT = 1_^1C_#ASSIGN 1410 TO LRRTN_^1_$GO TO 1050_^1 1420 LWASRT = 0_^1_$CALL CCSMVA(LAREC,1261,630,LWREC,1,630)_^ ‚‚1_$LWREC(316) = $3033_^1_$CALL LDSPLY(LITMSN,LWREC)_^1_$CALL LDSPLY(LMSGSN,LRTMSG)_^1_$IF(IOBUF(41).EQ.0) GO TO 1430_^1C_#LWASRT = 1_^1C_#ASSIGN 1420 TO LRRTN_^1_$GO TO 1050_^1 1430 LWASRT = 0_^1_$CALL CCSMVA(LAREC,1891,630,LWREC,1,630)_^1_$LWREC(316) = $3034_^1_$CALL LDSPLY(LITMSN,LWREC)_^1_$CALL LDSPLY(LMSGSN,LRTMSG)_^1_$IF(IOBUF(41).EQ.0) GO TO 1440_^1C_#LWASRT = 1_^1C_#ASSIGN 1 ‚‚430 TO LRRTN_^1_$GO TO 1050_^1 1440 LWASRT = 0_^1_$CALL CCSMVA(LAREC,2521,630,LWREC,1,630)_^1_$LWREC(316) = $3035_^1_$CALL LDSPLY(LITMSN,LWREC)_^1_$CALL LDSPLY(LMSGSN,LRTMSG)_^1_$IF(IOBUF(41).EQ.0) GO TO 1450_^1C_#LWASRT = 1_^1C_#ASSIGN 1440 TO LRRTN_^1_$GO TO 1050_^1 1450 LWASRT = 0_^1_$CALL CCSMVA(LAREC,3151,630,LWREC,1,630)_^1_$LWREC(316) = $3036_^1_$CALL LDSPLY(LITMSN,LWREC)_^ ‚‚1_$CALL LDSPLY(LMSGSN,LRTMSG)_^1_$IF(IOBUF(41).EQ.0) GO TO 1400_^1C_#LWASRT = 1_^1C_#ASSIGN 1450 TO LRRTN_^1_$GO TO 1050_^1C*****************************************STATEMENT BALANCE ROUTINE_^1 1500 DO 1505 L = 1,6_^1_$TDIREC(L) = $3030_^1_$TIDREC(L) = $3030_^1_$TNRCC(L) = $3030_^1_$TRCC(L) = $3030_^1_$TFEES(L) = $3030_^1 1505 CONTINUE_^1_$LCHAR = 1_^1_$DO 1580 L = 1,TVALIT_^1C_EMO ‚‚VE THE AMOUNT TO WORK-_^1C_EIF NEGATIVE, CHANGE SIGN_^1C_EACCUMULATE TOTALS_^1_$CALL CCSMVA(LAREC,LCHAR+32,9,LWK9,2,9)_^1_$CALL CCSGET(LAREC,LCHAR+41,LGET)_^1_$IF(LGET.EQ.$20) GO TO 1510_^1_$CALL CCSGET(LAREC,LCHAR+40,LGET)_^1_$IF(LGET.EQ.$30) LGET = $7D_^1_$IF(LGET.EQ.$31) LGET = $4A_^1_$IF(LGET.EQ.$32) LGET = $4B_^1_$IF(LGET.EQ.$33) LGET = $4C_^1_$IF(LGET.EQ.$34) LGET = $4D_^1_$I ‚‚F(LGET.EQ.$35) LGET = $4E_^1_$IF(LGET.EQ.$36) LGET = $4F_^1_$IF(LGET.EQ.$37) LGET = $50_^1_$IF(LGET.EQ.$38) LGET = $51_^1_$IF(LGET.EQ.$39) LGET = $52_^1_$CALL CCSPUT(LGET,10,LWK9)_^1C_EFIND THE TYPE OF CHANGE_^1 1510 CALL CCSMVA(LAREC,LCHAR+24,2,LGET,1,2)_^1_$IF(LGET.EQ.$3031) GO TO 1520_^1_$IF(LGET.EQ.$3032) GO TO 1530_^1_$IF(LGET.EQ.$3033) GO TO 1540_^1_$IF(LGET.EQ.$3034) GO TO 1 ‚‚550_^1_$IF(LGET.EQ.$3035) GO TO 1560_^1C_EADD TO TOTAL FIELDS_^1 1520 CALL CCSADD(LWK9,2,TDIREC,1,TDIREC,1)_^1_$GO TO 1570_^1 1530 CALL CCSADD(LWK9,2,TIDREC,1,TIDREC,1)_^1_$GO TO 1570_^1 1540 CALL CCSADD(LWK9,2,TNRCC,1,TNRCC,1)_^1_$GO TO 1570_^1 1550 CALL CCSADD(LWK9,2,TRCC,1,TRCC,1)_^1_$GO TO 1570_^1 1560 CALL CCSADD(LWK9,2,TFEES,1,TFEES,1)_^1C_]_^1 1570 LCHAR = LCHAR + 42_^1 1580 ‚‚ CONTINUE_^1C_;FIND ACTUAL # OF ENTRIES_^1_$L = TVALIT - LNUMDT_^1_$L0 = L-(L/10)*10_^1_$L = L/10_^1_$L1 = L-(L/10)*10_^1_$L = L/10_^1_$L2 = L-(L/10)*10_^1_$L = L/10_^1_$L3 = L-(L/10)*10_^1_$TREC(1) = (L3+$30) * $100 + (L2+$30)_^1_$TREC(2) = (L1+$30) * $100 + (L0+$30)_^1_$CALL CCSMVA(TDIREC,1,12,LWK12,1,12)_^1_$ASSIGN 1582 TO LSRTN_^1_$GO TO 1590_^1 1582 CALL CCSMVA(LWK18,1,18,TREC ‚‚,5,18)_^1_$CALL CCSMVA(TIDREC,1,12,LWK12,1,12)_^1_$ASSIGN 1584 TO LSRTN_^1_$GO TO 1590_^1 1584 CALL CCSMVA(LWK18,1,18,TREC,23,18)_^1_$CALL CCSMVA(TNRCC,1,12,LWK12,1,12)_^1_$ASSIGN 1586 TO LSRTN_^1_$GO TO 1590_^1 1586 CALL CCSMVA(LWK18,1,18,TREC,41,18)_^1_$CALL CCSMVA(TRCC,1,12,LWK12,1,12)_^1_$ASSIGN 1588 TO LSRTN_^1_$GO TO 1590_^1 1588 CALL CCSMVA(LWK18,1,18,TREC,59,18)_^1_$CALL CC ‚‚SMVA(TFEES,1,12,LWK12,1,12)_^1_$ASSIGN 1589 TO LSRTN_^1_$GO TO 1590_^1 1589 CALL CCSMVA(LWK18,1,18,TREC,77,18)_^1C_EGO PRINT SCREEN_^1_$GO TO 1598_^1C_ECHANGE LEADING ZEROS TO BLANKS_^1C_ELEAVING THE ZEROS AFTER DECIMAL_^1 1590 DO 1591 L = 1,10_^1_$CALL CCSGET(LWK12,L,LGET)_^1_$IF(LGET.NE.$30) GO TO 1592_^1_$LGET = $20_^1_$CALL CCSPUT(LGET,L,LWK12)_^1 1591 CONTINUE_^1 1592 CALL CCS ‚‚BLK(LWK18,18)_^1_$CALL CCSMVA(LWK12,12,1,LWK18,17,1)_^1_$CALL CCSGET(LWK12,12,LGET)_^1C_ECHECK FOR NEGATIVE NUMBER_^1_$IF(LGET.EQ.$7D) LWK18(9) = $302D_^1_$IF(LGET.EQ.$4A) LWK18(9) = $312D_^1_$IF(LGET.EQ.$4B) LWK18(9) = $322D_^1_$IF(LGET.EQ.$4C) LWK18(9) = $332D_^1_$IF(LGET.EQ.$4D) LWK18(9) = $342D_^1_$IF(LGET.EQ.$4E) LWK18(9) = $352D_^1_$IF(LGET.EQ.$4F) LWK18(9) = $362D_^1_$IF(LGE ‚‚T.EQ.$50) LWK18(9) = $372D_^1_$IF(LGET.EQ.$51) LWK18(9) = $382D_^1_$IF(LGET.EQ.$52) LWK18(9) = $392D_^1_$CALL CCSMVA(LWK12,11,1,LWK18,16,1)_^1C_EMOVE IN PERIOD AND EDIT FIELD_^1_$CALL CCSPUT($2E,15,LWK18)_^1_$LCHAR = 14_^1_$DO 1594 L = 10,1,-1_^1_$CALL CCSGET(LWK12,L,LGET)_^1_$IF(LGET.EQ.$20)_!GO TO 1596_^1_$CALL CCSPUT(LGET,LCHAR,LWK18)_^1_$IF(L.NE.8.AND.L.NE.5.AND.L.NE.1) GO TO 1 ‚‚593_^1_$CALL CCSGET(LWK12,L-1,LGET)_^1_$IF(LGET.EQ.$20) GO TO 1596_^1_$LCHAR = LCHAR - 1_^1_$CALL CCSPUT($2C,LCHAR,LWK18)_^1 1593 LCHAR = LCHAR - 1_^1 1594 CONTINUE_^1 1596 GO TO LSRTN_^1C_]_^1 1598 CALL LDSPLY(LSBSCN,TREC)_^1_$CALL LDSPLY(LMSGSN,LFINDF)_^1_$IF(IOBUF(1).EQ.OK) GO TO 1900_^1_$IF(IOBUF(1).EQ.RT) GO TO 1400_^1_$IF(IOBUF(1).EQ.AB) GO TO 1980_^1_$GO TO 1598_^1C********* ‚‚******************************** PRINT SCREENS *************_^1C_GADD MODE_^1 1600 L = TVALIT_^1_$GO TO 1630_^1C_GCHANGE AND DELETE MODE_^1 1610 L = ICCSAD(LITEM(1)) * 100 + ICCSAD(LITEM(2))_^1C_]_^1 1630 IF(L.GT.15) GO TO 1640_^1_$CALL CCSMVA(LAREC,1,630,LWREC,1,630)_^1_$LWREC(316) = $3031_^1_$GO TO 1690_^1 1640 IF(L.GT.30) GO TO 1650_^1_$CALL CCSMVA(LAREC,631,630,LWREC,1,630)_^1_ ‚‚$LWREC(316) = $3032_^1_$GO TO 1690_^1 1650 IF(L.GT.45) GO TO 1660_^1_$CALL CCSMVA(LAREC,1261,630,LWREC,1,630)_^1_$LWREC(316) = $3033_^1_$GO TO 1690_^1 1660 IF(L.GT.60) GO TO 1670_^1_$CALL CCSMVA(LAREC,1891,630,LWREC,1,630)_^1_$LWREC(316) = $3034_^1_$GO TO 1690_^1 1670 IF(L.GT.75) GO TO 1680_^1_$CALL CCSMVA(LAREC,2521,630,LWREC,1,630)_^1_$LWREC(316) = $3035_^1_$GO TO 1690_^1 1680 LW ‚‚REC(316) = $3036_^1_$CALL CCSMVA(LAREC,3151,630,LWREC,1,630)_^1 1690 CALL LDSPLY(LITMSN,LWREC)_^1_$GO TO 1035_^1C_EMOVE INPUT DATA TO WORK FIELDS-_^1C_ECHECKING FOR DEFAULT VALUES AND_^1C_EINPUT ERRORS_^1 1700 LPT = 1_^1_$CALL CCSBLK(LACCT,16)_^1C_EALLOW FOR ACCOUNT NUMBER LESS_^1C_ETHAN 16 DIGITS IN LENGTH_^1_$DO 1704 L = 1,16_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.NE.$2C) GO ‚‚ TO 1702_^1_$L = 16_^1_$GO TO 1704_^1 1702 CALL CCSPUT(LGET,L,LACCT)_^1_$LPT = LPT + 1_^1 1704 CONTINUE_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.NE.$2C) GO TO 1780_^1_$LPT = LPT + 1_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^1C_EIF COMMA-USE LEGAL# ENTERED_^1C_EPREVIOUSLY_^1_]_^1_$IF(LGET.EQ.$2C) GO TO 1710_^1_$CALL CCSBLK(LLGNO,4)_^1C_EALLOW FOR A LEGAL NUMBER OF LESS_^1C_ETHAN 4 DIGITS ‚‚IN LENGTH_^1_$DO 1708 L = 1,4_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.NE.$2C) GO TO 1706_^1_$L = 4_^1_$GO TO 1708_^1 1706 CALL CCSPUT(LGET,L,LLGNO)_^1_$LPT = LPT + 1_^1 1708 CONTINUE_^1_$GO TO 1715_^1C_ENO DEFAULT ON LEGAL# ALLOWED_^1C_EIF CHANGE OR FIRST ENTRY_^1 1710 IF(LWASCH.EQ.1.OR.TVALIT.EQ.0) GO TO 1785_^1C_EMOVE IN SAVE LEGAL AGENCY #_^1_$CALL CCSMVA(LSLGNO,1,4,LLGNO,1, ‚‚4)_^1_$LPT = LPT + 1_^1_$GO TO 1717_^1C_]_^1 1715 CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.NE.$2C) GO TO 1780_^1_$LPT = LPT + 1_^1 1717 CALL CCSMVA(IOBUF,LPT,2,LTYPE,1,2)_^1_$LPT = LPT + 2_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.NE.$2C) GO TO 1780_^1_$LPT = LPT + 1_^1C_EIF DEFAULT-USE SYSTEM DATE_^1_]_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.EQ.$2C) GO TO 1730_^1C_ECHECK FOR ‚‚4 OR 6 LONG DATE_^1_$CALL CCSGET(IOBUF,LPT+4,LGET)_^1_$IF(LGET.EQ.$2C) GO TO 1720_^1C_EMUST BE 6 LONG DATE_^1_$CALL CCSMVA(IOBUF,LPT,6,LDATE,1,6)_^1_$LPT = LPT + 6_^1_$GO TO 1740_^1C_EMUST BE 4 LONG DATE_^1 1720 CALL CCSMVA(IOBUF,LPT,4,LDATE,1,4)_^1C_EUSE SYSTEM YEAR_^1_$CALL CCSMVA(YEAR,1,2,LDATE,5,2)_^1_$LPT = LPT + 4_^1_$GO TO 1740_^1C_EUSE SYSTEM DATE_^1 1730 CALL CCSMVA(DATE,1 ‚‚,6,LDATE,1,6)_^1_$LPT = LPT + 1_^1_$GO TO 1742_^1C_]_^1 1740 CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.NE.$2C) GO TO 1780_^1_$LPT = LPT + 1_^1C_EMOVE IN AMOUNT-MAY BE LESS_^1C_ETHAN 9 DIGITS LONG_^1 1742 CALL CCSBLK(LAMT,10)_^1_$LDP = 0_^1_$DO 1750 L =1,10_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^1_$IF(LGET.NE.$2C.AND.LGET.NE.$20.AND.LGET.NE.$2D) GO TO 1745_^1C_EEND OF AMOUNT INPUT-STOP LOOP ‚‚_^1_$GO TO 1755_^1 1745 CALL CCSPUT(LGET,L,LAMT)_^1_$IF(LGET.EQ.$2E) LDP = 1_^1_$LPT = LPT + 1_^1 1750 CONTINUE_^1C_EBE SURE AMOUNT WAS NOT LONGER_^1C_ETHAN 7 DIGITS LONG WITH-OUT DEC._^1C_E-IF SO-FORCE AMOUNT TO BE INVALID_^1 1755 IF(L.GT.7.AND.LDP.EQ.0) CALL CCSPUT($41,1,LAMT)_^1C_EBE SURE AMOUNT IS NOT LONGER THAN_^1C_E9 DIGITS LONG WITH DECIMAL_^1_$CALL CCSGET(IOBUF,LPT,LGET)_^ ‚‚1_$IF(LGET.NE.$2C.AND.LGET.NE.$20.AND.LGET.NE.$2D) GO TO 1780_^1_$IF(LGET.EQ.$2C) LPT = LPT + 1_^1C_EMOVE IN THE CREDIT SIGN-BLANK_^1C_EOR NOT_^1_$CALL CCSMVA(IOBUF,LPT,1,LCR,1,1)_^1C_EGO VALIDATE ITEMS SAVED_^1_$GO TO 1800_^1C_]_^1C_EREPORT ERRORS FOUND AND RETURN_^1 1780 CALL LDSPLY(LMSGSN,LINVFM)_^1_$IF(IOBUF(41).EQ.0)GO TO LRTN_^1_$GO TO 1780_^1 1785 CALL LDSPLY(LMSGSN,LINVDF)_ ‚‚^1_$IF(IOBUF(41).EQ.0) GO TO LRTN_^1_$GO TO 1785_^1C_]_^1C_EALLOWS THE OPERATOR TO ONLY_^1C_ERE-ENTER ONLY THE INVALID ITEM_^1C_EINSTEAD OF THE WHOLE LINE_^1C_EVALIDATE WORK FIELDS_^1C_EACCOUNT # MUST BE MASTER FILE_^1 1800 CALL CCSMVA(LACCT,1,16,LKEY,1,16)_^1_$CALL READR(REQBFD,MASREC,LKEY,ISTAT)_^1_$IF(AND(ISTAT,WRONKY).EQ.WRONKY.OR.AND(ISTAT,EOF).EQ.EOF)_^1_#1 GO TO 1810_^1_$IF( ‚‚ISTAT.GE.0) GO TO 1830_^1_$CALL FILERR(IDATDM,13,ISTAT,LU)_^1_$CALL LCLANX_^1 1810 CALL LDSPLY(LMSGSN,LINVAC)_^1_$IF(IOBUF(41).EQ.0)GO TO LRTN_^1_$CALL CCSMVA(IOBUF,1,16,LACCT,1,16)_^1_$GO TO 1800_^1C_ENO CHECK NECESSARY FOR LEGAL_^1C_BAGENCY NUMBER-IT CAN CONTAIN_^1C_BANY TYPE DATA_^1C_ECHECK TYPE_^1 1830 IF(LTYPE.GE.$3031.AND.LTYPE.LE.$3035) GO TO 1835_^1_$CALL LDSPLY(LMSGSN,LINV ‚‚TY)_^1_$IF(IOBUF(41).EQ.0) GO TO LRTN_^1_$CALL CCSMVA(IOBUF,1,2,LTYPE,1,2)_^1_$GO TO 1830_^1C_ECHECK DATE_^1 1835 IF(LDATE(1).LT.$3031.OR.LDATE(1).GT.$3132) GO TO 1840_^1_$IF(LDATE(2).LT.$3031.OR.LDATE(2).GT.$3331) GO TO 1840_^1_$IF(LDATE(3).LT.$3030.OR.LDATE(3).GT.$3939) GO TO 1840_^1_$IF(LDATE(1).EQ.$3032.AND.LDATE(2).GT.$3239) GO TO 1840_^1_$GO TO 1850_^1 1840 CALL LDSPLY(LMSGSN ‚‚,LINVDT)_^1_$IF(IOBUF(41).EQ.0) GO TO LRTN_^1_$CALL CCSMVA(IOBUF,1,6,LDATE,1,6)_^1_$IF(LDATE(3).EQ.$2020) LDATE(3) = YEAR_^1_$GO TO 1835_^1C_ECHECK AMOUNT_^1 1850 CALL LPKAMT(LAMT,1,LWK9,1)_^1_$CALL CCSCST(LWK9,1,9,LASC9,2,9,LGET)_^1_$IF(LGET.EQ.0) GO TO 1860_^1_$CALL CCSMVA(LWK9,1,9,LAMT,1,9)_^1_$GO TO 1870_^1 1860 CALL LDSPLY(LMSGSN,LINVAM)_^1_$IF(IOBUF(41).EQ.0) GO TO LRTN_^1_$C ‚‚ALL CCSMVA(IOBUF,1,10,LAMT,1,10)_^1_$LDP = 0_^1_$DO 1865 L = 1,10_^1_$CALL CCSGET(LAMT,L,LGET)_^1_$IF(LGET.EQ.$2E) LDP = 1_^1_$IF(L.GT.7.AND.LDP.EQ.0) GO TO 1860_^1_$IF(LGET.EQ.$20) GO TO 1850_^1 1865 CONTINUE_^1_$GO TO 1850_^1 1870 CALL CCSGET(LCR,1,LGET)_^1_$IF(LGET.EQ.$20.OR.LGET.EQ.$2D) GO TO 1880_^1_$CALL LDSPLY(LMSGSN,LINVCR)_^1_$IF(IOBUF(41).EQ.0) GO TO LRTN_^1_$GO TO 1870_^ ‚‚1 1880 GO TO LRTN_^1C_EMOVE RECORD TO TRANSACTION FILE_^1C_EUNLESS TRAINING METHOD_^1 1900 IF(UFLAG.EQ.-1) GO TO 1990_^1_$LCHAR = 1_^1 1905 DO 1910 L = 1,TVALIT_^1C_EIF AMOUNT IS ZERO DO NOT PUT IN_^1C_ETRANSACTION FILE_^1_$CALL CCSCST(LAREC,LCHAR+32,9,LASC0,2,9,LGET)_^1_$IF(LGET.EQ.0) GO TO 1907_^1C_EACCOUNT #_^1_$CALL CCSMVA(LAREC,LCHAR+4,16,TRNSBF,1,16)_^1C_ESTART TIME OF PROCED ‚‚URE_^1_$CALL CCSMVA(LSTRTM,1,4,TRNSBF,21,4)_^1C_ESTOP TIME IS ENTERED IN LSVTRN_^1C_ETRANSACTION TYPE IS LITERAL 03_^1_$TRNSBF(15) = $3033_^1C_EAMOUNT-IF NEG. THE LAST BYTE_^1C_EMUST BE CHANGED_^1_$CALL CCSGET(LAREC,LCHAR+41,LGET)_^1_$IF(LGET.EQ.$20) GO TO 1906_^1_$CALL CCSGET(LAREC,LCHAR+40,LGET)_^1_$IF(LGET.EQ.$30) LGET = $7D_^1_$IF(LGET.EQ.$31) LGET = $4A_^1_$IF(LGET.EQ.$32) LGE ‚‚T = $4B_^1_$IF(LGET.EQ.$33) LGET = $4C_^1_$IF(LGET.EQ.$34) LGET = $4D_^1_$IF(LGET.EQ.$35) LGET = $4E_^1_$IF(LGET.EQ.$36) LGET = $4F_^1_$IF(LGET.EQ.$37) LGET = $50_^1_$IF(LGET.EQ.$38) LGET = $51_^1_$IF(LGET.EQ.$39) LGET = $52_^1_$CALL CCSPUT(LGET,LCHAR+40,LAREC)_^1 1906 CALL CCSMVA(LAREC,LCHAR+32,9,TRNSBF,31,9)_^1C_EDATE_^1_$CALL CCSMVA(LAREC,LCHAR+26,6,TRNSBF,40,6)_^1C_ELEGAL AGENC ‚‚Y #_^1_$CALL CCSMVA(LAREC,LCHAR+20,4,TRNSBF,46,4)_^1C_ETRANSACTION CODE-MUST BE CONVERTE_^1_$CALL CCSMVA(LAREC,LCHAR+24,2,LGET,1,2)_^1_$IF(LGET.EQ.$3031) CALL CCSMVA(L505,1,3,TRNSBF,50,3)_^1_$IF(LGET.EQ.$3032) CALL CCSMVA(L506,1,3,TRNSBF,50,3)_^1_$IF(LGET.EQ.$3033) CALL CCSMVA(L507,1,3,TRNSBF,50,3)_^1_$IF(LGET.EQ.$3034) CALL CCSMVA(L508,1,3,TRNSBF,50,3)_^1_$IF(LGET.EQ.$3035) CALL C ‚‚CSMVA(L509,1,3,TRNSBF,50,3)_^1_$CALL LSVTRN_^1 1907 LCHAR = LCHAR + 42_^1 1910 CONTINUE_^1_$GO TO 1990_^1C_EEXIT ROUTINE-_^1C_EWORK FIELDS ARE CLEARED AT_^1C_EBEGINNING_^1C_]_^1C_EOPERATOR ABORTED ROUTINE_^1 1980 CALL LDSPLY(LMSGSN,LABMSG)_^1_$IF(IOBUF(41).EQ.0) GO TO 1990_^1_$GO TO 1598_^1 1990 RETURN_^1_$END_]_^__ ‚‚MON05 CSY/ 17650 ‚‚1 MON_]_^1 OPT LPC_]_^__ ‚‚LAFUPD CSY/ F14 1850 ‚‚1_$SUBROUTINE LAFUPD_^1_#1_2/F14 F LA_!CCS 3.0_5SL-149_^1C_#UPDATE MAIN PROCESSOR MODULE (*L/A*)_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_#THIS IS THE CENTRAL PROCESSOR FOR COMPLETE UPDATE PROCESSING._^1C_#IT IS RESPONSIBLE FOR PROCESSING THE UPDATE TAPE, PERFORMI ‚‚NG THE_^1C_#REQUIRED UPDATE OPERATION (ADD, UPDATE, REACTIVATE, OR INACTIVATE_^1C_#AN ACCOUNT), AND ON END-OF-FILE ON INPUT, PRINT REQUIRED TOTALS_^1C_#AND EXIT. THE FOLLOWING MAJOR SUBROUTINES ARE USED:_^1C_(UPINIT - PERFORMS INITIALIZATION FUNCTIONS, SUCH AS OPENING_^1C_1FILES AND RETRIEVING REQUIRED PARAMETERS._^1C_(LABHAN - PROCESSES TAPE LABELS, IF PRESENT. DOES NOT PERFORM_ ‚‚^1C_1ANY CHECKING OF LABELS, BUT IS EASILY MODIFIED TO_^1C_1PERFORM CHECKING._^1C_(NXTRAN - READS NEXT TRANSACTION (RECORD) FROM INPUT SPECIFIED_^1C_1IN SWITCH SETTINGS (SEE BELOW FOR SWITCH SETTINGS)._^1C_(TOTALP - PERFORMS PRINTING OF TOTALS AT COMPLETION OF UPDATE._^1C_(UPDEND - EXIT PROCESSOR WHICH CLOSES THE OPEN FILES AND_^1C_1RETURNS CONTROL TO THE CCS EXECUTIVE. THIS MODUL ‚‚E_^1C_1IS USED FOR NORMAL TERMINATION (END-OF-FILE ON INPUT)_^1C_1AND ABNORMAL TERMINATION (FATAL FILE ERRORS)._^1C_(GETMAS - ATTEMPTS RETRIEVAL OF ACCOUNT SPECIFIED BY TAPE_^1C_1TRANSACTION FROM DELQMST (MASTER) FILE._^1C_(RSWIT - PEFORMS OPERATIONS ON THE ACCOUNT SPECIFIC FOR_^1C_1RELEASE, WRITE-OFF, OR SATISFY INACTIVATING TRANS-_^1C_1ACTIONS._^1C_(LAUNCU - PERFORMS UNCONDITION ‚‚AL UPDATE OF MASTER FILE_^1C_1"FINANCIAL" FIELDS. THIS MODULE IS USED FOR ALL_^1C_1ADD, UPDATE, AND REACTIVATION TRANSACTIONS._^1C_(CONUPD - PERFORMS CONDITIONAL UPDATE OF MASTER FILE "NON-_^1C_1FINANCIAL" FIELDS. THIS MODULE IS USED FOR ALL_^1C_1ADD, UPDATE, AND REACTIVATION TRANSACTIONS._^1C_(ADDIT - PERFORMS OPERATIONS ON THE ACCOUNT SPECIFIC FOR NEW_^1C_1(ADDED) ACCOUNTS._^1 ‚‚C_(COSUPD - PERFORMS COSIGNER ADDITION FUNCTION FOR ALL ADD,_^1C_1UPDATE, AND REACTIVATION TRANSACTIONS._^1C_(UPDIT - PERFORMS OPERATIONS ON THE ACCOUNT SPECIFIC FOR_^1C_1EXISTING ACTIVE ACCOUNTS (UPDATE TRANSACTIONS)._^1C_(REACIT - PERFORMS OPERATIONS ON THE ACCOUNT SPECIFIC FOR_^1C_1EXISTING INACTIVE ACCOUNTS (UPDATE TRANSACTIONS)._^1C_(PRTLIN - PRINTS DETAIL OR TOTAL LINE WITH ‚‚TOP-OF-FORM AND_^1C_1HEADINGS IF REQUIRED. THE OUTPUT UNIT (PRINTER OR_^1C_1FILE) IS SPECIFIED BY THE SWITCH SETTINGS BELOW._^1._]_^1C_#EXTERNAL SWITCH SETTINGS (SWITCH SETTINGS USED NORMALLY FOR RPG_^1C_#PROGRAMS) GOVERN INPUT AND OUTPUT. THE SWITCHES ARE TO BE SET_^1C_#IMMEDIATELY PRIOR TO EXECUTION OF THIS PROGRAM VIA THE CCS SWITCH_^1C_#UTILITY. THE SWITCHES U1 THRU U8 HAVE ‚‚THE FOLLOWING MEANINGS_^1C_#WITHIN THE UPDATE PROCESSING:_^1C_2POSITION (ON_^1C_(SWITCH_"=1, OFF=0)_#MEANING_^1C_(------_"------------_!-----------------------------------_^1C_*U1_4SELECTS ASCII OR EBCDIC INPUT_^1C_6ON_*INPUT IS EBCDIC FORMAT._^1C_6OFF_)INPUT IS ASCII FORMAT._^1C_*U2_4SELECTS TAPE OR FILE INPUT UNIT._^1C_6ON_*INPUT FROM FILE "UPDPRINT"._^1C_6OFF_)INPUT FROM MAGNET ‚‚IC TAPE._^1C_*U3_4SELECTS TAPE UNIT FOR INPUT (IGNORED_^1C_AIF U2 ON)._^1C_6ON_*INPUT UNIT IS MAG TAPE UNIT 1._^1C_6OFF_)INPUT UNIT IS MAG TAPE UNIT 0._^1C_*U4_4SELECTS LIST OR FILE PRINT OUTPUT_^1C_AUNIT._^1C_6ON_*PRINT OUTPUT WILL BE TO FILE_^1C_C"UPDPRINT"._^1C_6OFF_)PRINT OUTPUT WILL BE SYSTEM_^1C_CPRINTER._^1C_*U5_4NOT USED._^1C_*U6_4NOT USED._^1C_*U7_4NOT USED._^1C_*U8_4NOT U ‚‚SED._^11_]_^1C_#THE GENERALIZED PROGRAM FLOW IS AS FOLLOWS (WITH SUBROUTINES IN-_^1C_#VOLVED HIGHLIGHTED):_^1C_(1. PERFORM INITIALIZATION FUNCTIONS (*UPINIT*) AND PROCESS_^1C_+TAPE LABELS (*LABHAN*)._^1C_(2. RETRIEVE NEXT TRANSACTION INPUT (*NXTRAN*); IF END-OF-FILE,_^1C_+PRINT TOTALS (*TOTALP*) AND PERFORM EXIT FUNCTIONS_^1C_+(*UPDEND*); ELSE, PROCESS ACCOUNT BY TRANSACTION INDICA ‚‚TED:_^1C_.TRANSACTION_!MASTER_)ACCOUNT_^1C_.CODE_)RECORD PRESENT ACTIVE_!ACCOUNT PROCESS_^1C_.-----------_!-------------- ------- ---------------_^1C_.30X_--_+-_$INACTIVATION_^1C_.BLANK_*NO_+-_$ADD_^1C_.BLANK_)YES_)YES_$UPDATE_^1C_.BLANK_)YES_*NO_$REACTIVATION_^1C_.OTHER_+-_+-_$TRANSACTION_^1C_VREJECT_^1C_]_^1C_(3. THE INACTIVATION PROCESS INVOLVES THE FOLLOWING STEPS:_^1C_2PERF ‚‚ORM INACTIVATION SPECIFIC OPERATIONS (*RSWIT*)._^1C_2IF TRANSACTION ACCEPTED, UPDATE ACCOUNT ON MASTER_^1C_2FILE_^1C_6ELSE RESET TRANSACTION REJECTED FLAG_^1C_6INCREMENT REJECTED TRANSACTION COUNT._^1C_2PRINT DETAIL LINE (*PRTLIN*)._^1C_2CONTINUE WITH NEXT TRANSACTION._^1C_(4. THE ADD PROCESS INVOLVES THE FOLLOWING STEPS:_^1C_2PERFORM UNCONDITIONAL UPDATE OF FINANCIAL FIELDS_^1C_2( ‚‚*LAUNCU*)._^1C_2PERFORM CONDITIONAL UPDATE OF NON-FINANCIAL FIELDS_^1C_2(*CONUPD*)._^1C_2PERFORM ADD SPECIFIC OPERATIONS (*ADDIT*)._^1C_2PERFORM COSIGNER ADDITION FUNCTION (*COSUPD*)._^1C_2ADD ACCOUNT TO MASTER FILE._^1C_2PRINT DETAIL LINE (*PRTLIN*)._^1C_2CONTINUE WITH NEXT TRANSACTION._^1C_(5. THE UPDATE PROCESS INVOLVES THE FOLLOWING STEPS:_^1C_2PERFORM UPDATE SPECIFIC OPERATION ‚‚S (*UPDIT*)._^1C_2PERFORM UNCONDITIONAL UPDATE OF FINANCIAL FIELDS_^1C_2(*LAUNCU*)._^1C_2PERFORM CONDITIONAL UPDATE OF NON-FINANCIAL FIELDS_^1C_2(*CONUPD*)._^1C_2PERFORM COSIGNER ADDITION FUNCTION (*COSUPD*)._^1C_2UPDATE ACCOUNT ON MASTER FILE._^1C_2PRINT DETAIL LINE (*PRTLIN*)._^1C_2CONTINUE WITH NEXT TRANSACTION._^1C_(6. THE REACTIVATION PROCESS INVOLVES THE FOLLOWING STEPS:_^1C_ ‚‚2PERFORM REACTIVATION SPECIFIC OPERATIONS (*REACIT*)._^1C_2PERFORM UNCONDITIONAL UPDATE OF FINANCIAL FIELDS_^1C_2(*LAUNCU*)._^1C_2PERFORM CONDITIONAL UPDATE OF NON-FINANCIAL FIELDS_^1C_2(*CONUPD*)._^1C_2PERFORM COSIGNER ADDITION FUNCTION (*COSUPD*)._^1C_2UPDATE ACCOUNT ON MASTER FILE._^1C_2PRINT DETAIL LINE (*PRTLIN*)._^1C_2CONTINUE WITH NEXT TRANSACTION._^1C_(7. FOR REJECTED TRANS ‚‚ACTIONS DUE TO INVALID TRANSACTION CODE,_^1C_+THE FOLLOWING IS PERFORMED:_^1C_2FORMAT DETAIL LINE FOR REJECTED TRANSACTION._^1C_2INCREMENT REJECTED TRANSACTION COUNT._^1C_2PRINT DETAIL LINE (*PRTLIN*)._^1C_2CONTINUE WITH NEXT TRANSACTION._^11_]_^1C_#WITHIN EACH SUBROUTINE, THERE WILL BE SIMILAR COMMENTARY CONCERN-_^1C_#ING FUNCTIONS PERFORMED. THE MAJORITY OF DATA SPACE IS DELCLAR ‚‚ED_^1C_#IN LABELLED COMMON AND IS INITIALIZED IN A BLOCK DATA SUBPROGRAM._^1C_#THE COMMON DECLARATIONS ARE CONTAINED WITHIN A MACRO CALLED_^1C_#"UPDMAC"._^1._]_^1C_(BRING IN COMMON DECLARATION MACRO._^1M_#UPDMAC_^1C***********************************************************************_^1C*_1BEGIN PROGRAM._^1C***********************************************************************_^ ‚‚13_]_^1C***********************************************************************_^1C*_"PERFORM INITIALIZATION FUNCTIONS SUCH AS OPENING FILES,_^1C*_"RETRIEVING SYSTEM DATE AND REPORT HEADINGS._^1C***********************************************************************_^11_]_^1 100 CALL UPINIT_^12_]_^1C***********************************************************************_^1C*_"PROC ‚‚ESS TAPE LABELS, IF PRESENT._^1C***********************************************************************_^11_]_^1 110 CALL LABHAN_^13_]_^1C***********************************************************************_^1C*_"BEGIN MAIN TRANSACTION PROCESSING LOOP._^1C***********************************************************************_^11_]_^1C******************************************* ‚‚****************************_^1C*_(READ NEXT INPUT TRANSACTION._^1C***********************************************************************_^11_]_^1 200_'CALL NXTRAN_^11_]_^1C****_$IF NOT END-OF-FILE, CONTINUE TO PROCESS TRANSACTION_^1 210_'IF ( EOFFLG .EQ. 0 ) GO TO 220_^1C**_,ELSE, PRINT TOTALS AND EXIT (NO RETURN FROM UPDEND)._^1_0CALL TOTALP_^1_0CALL UPDEND_^11_]_^1C************ ‚‚***********************************************************_^1C*_(RETRIEVE ACCOUNT FROM MASTER FILE._^1C***********************************************************************_^11_]_^1 220_'CALL GETMAS_^11_]_^1C****_$IF RSW TRANSACTION (TRANSACTION CODE EQUAL TO 301, 302, OR_^1C****_$303) PERFORM REQUIRED OPERATIONS TO INACTIVATE ACCOUNT._^1 230_'CALL CCSCST ( INPBUF, N1, N3, TRN30 ‚‚3, N1, N3, COMPIN )_^1_+IF ( COMPIN .EQ. 0 ) GO TO 300_^1_+CALL CCSCST ( INPBUF, N1, N3, TRN302, N1, N3, COMPIN )_^1_+IF ( COMPIN .EQ. 0 ) GO TO 300_^1_+CALL CCSCST ( INPBUF, N1, N3, TRN301, N1, N3, COMPIN )_^1_+IF ( COMPIN .EQ. 0 ) GO TO 300_^1C**_,ELSE, CONTINUE AND PROCESS TRANSACTION._^1_0GO TO 240_^1._]_^1C*********************************************************************** ‚‚_^1C***********************************************************************_^1C*_-INACTIVATION SEQUENCE._^1C***********************************************************************_^11_]_^1C**_,PERFORM INACTIVATION SPECIFIC OPERATIONS._^1 300_,CALL RSWIT_^1C**_,IF TRANSACTION REJECTED, BYPASS MASTER FILE UPDATE AND_^1C**_,RESET TRANSACTION REJECTED FLAG AND INCREMENT REJECTED_^1C**_ ‚‚,TRANSACTION COUNT_^1_0IF ( TRNREJ .NE. 0 ) GO TO 325_^1C**_1ELSE, UPDATE ACCOUNT ON MASTER FILE._^1_5CALL UPDREC ( REQBDM, RECBDM, ISTAT )_^1C**_1IF NO FILE ERROR, CONTINUE_^1_5IF ( ISTAT .GE. 0 ) GO TO 350_^1C**_6ELSE, REPORT ERROR AND EXIT (NO RETURN FROM_^1C**_6UPDEND)._^1_:CALL FILERR ( IDATDM, N15, ISTAT, TLU )_^1_:CALL UPDEND_^11_]_^1C**_,RESET TRANSACTION REJECTED FLAG._^1 ‚‚325_,TRNREJ = 0_^1C**_,INCREMENT REJECTED TRANSACTION COUNT._^1_0CALL CCSADD ( NDAONE, N2, NUMREJ, N1, NUMREJ, N1 )_^11_]_^1C**_,PRINT DETAIL OUTPUT LINE._^1 350_,CALL PRTLIN ( DETLIN )_^11_]_^1C**_,CONTINUE WITH NEXT TRANSACTION._^1_1GO TO 700_^1C***********************************************************************_^13_]_^1C****_$IF BLANK TRANSACTION CODE, CONTINUE TO PROCESS AS ‚‚ AN ADD,_^1C****_$UPDATE, OR REACTIVATION TRANSACTION_^1 240_'CALL CCSCST ( INPBUF, N1, N3, TRNBLK, N1, N3, COMPIN )_^1_+IF ( COMPIN .EQ. 0 ) GO TO 260_^1C**_,ELSE, PROCESS REJECTED TRANSACTION - ILLEGAL TRANS-_^1C**_,ACTION CODE._^1C**_,FORMAT DETAIL OUTPUT LINE._^1_0CALL FORMLN ( N9 )_^1C**_,INCREMENT REJECTED TRANSACTION COUNT._^1_0CALL CCSADD ( NDAONE, N2, NUMREJ, N1, NUMREJ, N ‚‚1 )_^1C**_,PRINT DETAIL OUTPUT LINE._^1_0CALL PRTLIN ( DETLIN )_^11_]_^1C**_,CONTINUE WITH NEXT TRANSACTION._^1_0GO TO 700_^1._]_^1C****_$BLANK TRANSACTION CODE FOUND. IF ACCOUNT FOUND IN MASTER_^1C****_$FILE, CONTINUE TO PROCESS AS UPDATE OR REACTIVATION_^1 260_(IF ( ACCTFD .NE. 0 ) GO TO 270_^1C**_,ELSE, PERFORM REQUIRED OPERATIONS TO ADD ACCOUNT._^11_]_^1C********************** ‚‚*************************************************_^1C***********************************************************************_^1C*_-ADD SEQUENCE._^1C***********************************************************************_^11_]_^1C**_,PERFORM UNCONDITIONAL UPDATE OF FINANCIAL FIELDS._^1 400_,CALL LAUNCU_^1C**_,PERFORM CONDITIONAL UPDATE OF NON-FINANCIAL FIELDS._^1_0CALL CONUPD_^1C**_ ‚‚,PERFORM ADD SPECIFIC OPERATIONS._^1_0CALL ADDIT_^1C**_,PERFORM COSIGNER UPDATE FUNCTION._^1_0CALL COSUPD_^1C**_,ADD ACCOUNT TO MASTER FILE._^1_0CALL WRITER ( REQBDM, RECBDM, RECBDM, ISTAT )_^1C_.IF NO FILE ERROR, CONTINUE_^1_0IF ( ISTAT .GE. 0 ) GO TO 450_^1C**_1ELSE, REPORT ERROR AND EXIT (NO RETURN FROM_^1C**_1UPDEND)._^1_5CALL FILERR ( IDATDM, N12, ISTAT, TLU )_^1_5CALL UPDEND_ ‚‚^1C**_,PRINT DETAIL LINE._^1 450_,CALL PRTLIN ( DETLIN )_^1C**_,CONTINUE TO PROCESS NEXT TRANSACTION._^1_0GO TO 700_^1C***********************************************************************_^1._]_^1C****_$ACCOUNT PRESENTLY ON MASTER FILE. IF ACCOUNT IS INACTIVE,_^1C****_$CONTINUE TO PROCESS REACTIVATION TRANSACTION._^1 270_'IF ( ACCTST .NE. ACTIVE ) GO TO 600_^1C**_,ELSE, PERFORM ‚‚ REQUIRED OPERATIONS TO UPDATE ACCOUNT._^11_]_^1C***********************************************************************_^1C***********************************************************************_^1C*_-UPDATE SEQUENCE._^1C***********************************************************************_^11_]_^1C**_,PERFORM UPDATE SPECIFIC OPERATIONS._^1 500_,CALL UPDIT_^1C**_,PERFORM UNCONDI ‚‚TIONAL UPDATE OF FINANCIAL FIELDS._^1_0CALL LAUNCU_^1C**_,PERFORM CONDITIONAL UPDATE OF NON-FINANCIAL FIELDS._^1_0CALL CONUPD_^1C**_,PERFORM COSIGNER UPDATE FUNCTIONS._^1_0CALL COSUPD_^1C**_,UPDATE ACCOUNT ON MASTER FILE._^1_0CALL UPDREC ( REQBDM, RECBDM, ISTAT )_^1C**_,IF NO FILE ERROR, CONTINUE_^1_0IF ( ISTAT .GE. 0 ) GO TO 550_^1C**_1ELSE, REPORT ERROR AND EXIT (NO RETURN FROM_^ ‚‚1C**_1UPDEND)._^1_5CALL FILERR ( IDATDM, N15, ISTAT, TLU )_^1_5CALL UPDEND_^1C**_,PRINT DETAIL LINE._^1 550_,CALL PRTLIN ( DETLIN )_^1C**_,CONTINUE WITH NEXT TRANSACTION._^1_0GO TO 700_^1C***********************************************************************_^1._]_^1C***********************************************************************_^1C**************************************** ‚‚*******************************_^1C*_(REACTIVATION SEQUENCE._^1C***********************************************************************_^11_]_^1C**_'PERFORM REACTIVATION SPECIFIC OPERATIONS._^1 600_'CALL REACIT_^1C**_'PERFORM UNCONDITIONAL UPDATE OF FINANCIAL FIELDS._^1_+CALL LAUNCU_^1C**_'PERFORM CONDITIONAL UPDATE OF NON-FINANCIAL FIELDS._^1_+CALL CONUPD_^1C**_'PERFORM COSIGNER U ‚‚PDATE FUNCTIONS._^1_+CALL COSUPD_^1C**_'UPDATE ACCOUNT ON MASTER FILE._^1_+CALL UPDREC ( REQBDM, RECBDM, ISTAT )_^1C**_'IF NO FILE ERROR, CONTINUE_^1_+IF ( ISTAT .GE. 0 ) GO TO 650_^1C**_,ELSE, REPORT ERROR AND EXIT (NO RETURN FROM UPDEND)._^1_0CALL FILERR ( IDATDM, N15, ISTAT, TLU )_^1_0CALL UPDEND_^1C**_'PRINT DETAIL LINE_^1 650_'CALL PRTLIN ( DETLIN )_^1C**_'CONTINUE WITH NEXT T ‚‚RANSACTION._^1_+GO TO 700_^1C***********************************************************************_^13_]_^1C***********************************************************************_^1C*_"END OF TRANSACTION PROCESSING LOOP. GO PROCESS NEXT TRANSACTION._^1C***********************************************************************_^11_]_^1 700 GO TO 200_^12_]_^1C**** NO RETURN FROM TH ‚‚IS SUBROUTINE. EXIT IS THRU UPDEND SUBROUTINE._^1_$END_]_^__ ‚‚LAUBLK CSY/ F16 0150 ‚‚1_$BLOCK DATA_^1_#1_2/F16 F LA_!CCS 3.0_5SL-149_^1C_#BLOCK DATA SUBPROGRAM TO INITIALIZE COMMON (*L/A*)_^1C_#LEGAL AND AGENCY VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C****_#RETRIEVE MACRO DEFINITION._^1M_#UPDMAC_^1C****_#BEGIN INITIALIZATION._^1_$DATA A01 / '01' /_^1_$DATA A0360 / '0360' /_^1_ ‚‚$DATA ACCTFD / 0 /_^1_$DATA ACTIVE / $20 /_^1_$DATA ADDAD / 6*$3030 /_^1_$DATA ADDPAY / 6*$3030 /_^1_$DATA AFLG / 17 /_^1_$DATA ALRACC / '- ACCOUNT ALREADY IN ACCAGE ' /_^1_$DATA ASREAC / 3*$2020, 'CO', ' ', ' ', 'HOST', 28*$2020 /_^1_$DATA BLANKS / ' ' /_^1_$DATA BUSY / $0080 /_^1_$DATA ((COLHD(J,I), J=1,66), I=1,1) /_^1_#1_'' TRAN_%ACCOUNT_)BORROWERS_#',_^1_#2_''_.DELINQUENT ‚‚ DELINQUENT_"CUR',_^1_#3_''RENT_G'/_^1_$DATA ((COLHD(J,I), J=1,66), I=2,2) /_^1_#1_'' CODE_%NUMBER_,NAME_'',_^1_#2_''_1DATE_%AMOUNT_$PAY',_^1_#3_''OFF_$ACTION_9',$D/_^1_$DATA DETLIN / 68*$2020 /_^1_$DATA DUMMY / $FFFF /_^1_$DATA DUPKEY / $0010 /_^1_$DATA EOF / $0100 /_^1_$DATA EOFFLG / 0 /_^1_$DATA FILNFD / $0002 /_^1_$DATA ((HDLIN(J,I), J=1,66), I=1,1) /_^1_#1 $C3C, '-- HDR1 FRO ‚‚M UTILITY FILE GOES HERE -->_#',_^1_#2_''_K',_^1_#3_''_I' /_^1_$DATA ((HDLIN(J,I), J=1,66), I=2,2) /_^1_#1 $3C, '-- HDR2 FROM UTILITY FILE GOES HERE -->_#',_^1_#2_''_#DAILY MASTER FILE UPDATE REPORT_'',_^1_#3_''_=PAGE_'' /_^1_$DATA ((HDLIN(J,I), J=1,66), I=3,3) /_^1_#1 $3C, '-- HDR3 FROM UTILITY FILE GOES HERE -->_#',_^1_#2_''_0<-DATE->_2',_^1_#3_''_G',$D /_^1_$DATA IDATAD / ‚‚'LAADDACT', 8*$2020, 0, 1, 0 /_^1_$DATA IDATAG / 'LAACCAGE', 8*$2020, 1, 1, -1 /_^1_$DATA IDATCS / 'LACOSIGN', 8*$2020, 1, 1, 1 /_^1_$DATA IDATDM / 'LADLQMST', 8*$2020, 1, 1, 1 /_^1_$DATA IDATIA / 'LAINACCT', 8*$2020, 0, 1, 0 /_^1_$DATA IDATIN / 'UPDINPUT', 8*$2020, 0, 1, -1 /_^1_$DATA IDATPR / 'UPDPRINT', 8*$2020, 0, 1, 0 /_^1_$DATA IDATRF / 'LARSWFIL', 8*$2020, 0, 1, 0 /_^1_$DATA ‚‚ IDATTP / 'LATRANFL', 8*$2020, 0, 1, 0 /_^1_$DATA IDATTS / 'LATRNBCK', 8*$2020, 0, 1, 0 /_^1_$DATA IDATUT / 'LAUTIFIL', 8*$2020, 1, 1, 0 /_^1_$DATA IFLAG / 0 /_^1_$DATA KHDRX / 'HDR1' /_^1_$DATA KUPDY / 'UPDY' /_^1_$DATA LINCNT / 66 /_^1_$DATA MADLQ / 887 /_^1_$DATA MCCDT / 869 /_^1_$DATA MNAM / 18 /_^1_$DATA MNCHG / 1047 /_^1_$DATA MNXTC / 275 /_^1_$DATA MPYOF / 905 /_^1_$DATA MQU ‚‚E / 271 /_^1_$DATA MSTC / 306 /_^1_$DATA MSTDT / 857 /_^1_$DATA MTCD / 963 /_^1_$DATA MT1 / 16 /_^1_$DATA MUPDT / 863 /_^1_$DATA NDAONE / '0000000001' /_^1_$DATA NUMADD / 6*$3030 /_^1_$DATA NUMREA / 6*$3030 /_^1_$DATA NUMREJ / 6*$3030 /_^1_$DATA NUMRSW / 18*$3030 /_^1_$DATA NUMUPD / 6*$3030 /_^1_$DATA N0 / 0 /_^1_$DATA N1 / 1 /_^1_$DATA N2 / 2 /_^1_$DATA N3 / 3 /_^1_$DATA N4 / ‚‚4 /_^1_$DATA N5 / 5 /_^1_$DATA N6 / 6 /_^1_$DATA N7 / 7 /_^1_$DATA N8 / 8 /_^1_$DATA N9 / 9 /_^1_$DATA N10 / 10 /_^1_$DATA N11 / 11 /_^1_$DATA N12 / 12 /_^1_$DATA N13 / 13 /_^1_$DATA N14 / 14 /_^1_$DATA N15 / 15 /_^1_$DATA N16 / 16 /_^1_$DATA N17 / 17 /_^1_$DATA N26 / 26 /_^1_$DATA N27 / 27 /_^1_$DATA N28 / 28 /_^1_$DATA N30 / 30 /_^1_$DATA N35 / 35 /_^1_$DATA N40 / 40 /_^1_$DATA N ‚‚55 / 55 /_^1_$DATA N66 / 66 /_^1_$DATA N80 / 80 /_^1_$DATA N82 / 82 /_^1_$DATA N96 / 96 /_^1_$DATA N132 / 132 /_^1_$DATA PAGCNT / 6*$3030 /_^1_$DATA RADLQ / 59 /_^1_$DATA RDYDL / 35 /_^1_$DATA REAAD / 6*$3030 /_^1_$DATA REAPAY / 6*$3030 /_^1_$DATA RECBAG / 43*$2020 /_^1_$DATA RECBDM / 1002*$2020 /_^1_$DATA RECBIA / 14*$2020 /_^1_$DATA REQBAD / 24*0 /_^1_$DATA REQBAG / 24*0 /_^1_$DA ‚‚TA REQBCS / 24*0 /_^1_$DATA REQBDM / 24*0 /_^1_$DATA REQBIA / 24*0 /_^1_$DATA REQBIN / 24*0 /_^1_$DATA REQBPR / 24*0 /_^1_$DATA REQBRF / 24*0 /_^1_$DATA REQBTP / 24*0 /_^1_$DATA REQBTS / 24*0 /_^1_$DATA REQBUT / 24*0 /_^1_$DATA RPADLQ / 68 /_^1_$DATA RPDYDL / 38 /_^1_$DATA RPPYOF / 50 /_^1_$DATA RPQUE / 21 /_^1_$DATA RPYOF / 41 /_^1_$DATA RQUE / 17 /_^1_$DATA RSTC / 77 /_^1_$DATA R ‚‚SWPAD / 18*$3030 /_^1_$DATA RSWPAY / 18*$3030 /_^1_$DATA RSWPPY / 18*$3030 /_^1_$DATA RTCD / 25 /_^1_$DATA R9SWCH / $00E3 /_^1_$DATA SECTRF / 1 /_^1_$DATA TACCTP / 4 /_^1_$DATA TAPE / 6 /_^1_$DATA TADLQ / 375 /_^1_$DATA TDLDT / 363 /_^1_$DATA TNAM / 21 /_^1_$DATA TOTPRT / 0 /_^1_$DATA TPYOF / 393 /_^1_$DATA TQUE / 274 /_^1_$DATA TRNBLK / '_"' /_^1_$DATA TRNREJ / 0 /_^1_$DATA TRN301 ‚‚ / '301 ' /_^1_$DATA TRN302 / '302 ' /_^1_$DATA TRN303 / '303 ' /_^1_$DATA TWAMT / 26 /_^1_$DATA TWDTD / 20 /_^1_$DATA UPDAD / 6*$3030 /_^1_$DATA UPDAGE / 0 /_^1_$DATA UPDPAD / 6*$3030 /_^1_$DATA UPDPAY / 6*$3030 /_^1_$DATA UPDPPY / 6*$3030 /_^1_$DATA WRONKY / $0200 /_^11_]_^1C****_#END OF INITIALIZATION._^11_]_^1_$END_]_^__ ‚‚LAUNCU CSY/ F17 5300 ‚‚1_$SUBROUTINE LAUNCU_^1_#1_2/F17 F LA_!CCS 3.0_5SL-149_^1C_#UNCONDITIONAL UPDATE OF FINANCIAL FIELDS (*L/A*)_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS, LA JOLLA DIVISION - LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C_#LAUNCU WILL UPDATE ALL "FINANCIAL" FIELDS IN THE ROOT PORTION OF_^1C_#THE MASTER RECORD WITH THE NEW FIELD CONTEN ‚‚TS CONTAINED IN THE_^1C_#TRANSACTION INPUT RECORD. THE FOLLOWING TABLE DETAILS THE FIELDS_^1C_#BEING UPDATED:_^1C_[START START_^1C_#FIELD_JLENGTH POS_!POS_^1C_#NAME_!DESCRIPTION_=(CHAR) INPUT FILE_^1C_#------------------------------------------------------------------_^1C_#MSTDT DATE ACCOUNT LAST UPDATED BY A/R SYSTEM_#6_#--_"857_^1C_#LATLA DATE ACCOUNT ADDED TO L/A (*L/A*)_*6_# ‚‚--_!1057_^1C_#LADUE BALANCE DUE, TO L/A (*L/A*)_06_#393 1063_^1C_#MDLDT DELINQUENT DATE_<6_#363_!875_^1C_#MOPDT ACCOUNT OPEN DATE_:6_#369_!881_^1C_#MADLQ AMOUNT DELINQUENT (PAST DUE)_/9_#375_!887_^1C_#MCBAL CURRENT BALANCE_<9_#384_!896_^1C_#MPYOF CURRENT PAYOFF/TOTAL DUE_39_#393_!905_^1C_#MCPGD CURRENT PAYOFF GOOD UNTIL DATE_-6_#402_!914_^1C_#MNPA_!NEXT PAYOFF AMOUNT_99_#40 ‚‚8_!920_^1C_#MOAMT OPEN AMOUNT/CREDIT LIMIT_39_#417_!929_^1C_#MCMN_!NUMBER OF COSIGNERS_81_#426_!938_^1C_#MPTS_!CREDIT/POINT SCORE_93_#427_!947_^1C_#MBBR_!BANK BRANCH_@5_#430_!950_^1C_#MLON_!LOAN OFFICER_?8_#435_!955_^1C_#MTCD_!ACCOUNT TYPE CODE/PRODUCT TYPE_-4_#443_!963_^1C_#MTD3_!NUMBER OF TIMES 30 DAYS DELINQUENT_)2_#447_!967_^1C_#MTD6_!NUMBER OF TIMES 60 DAYS DELINQUENT_)2_#449 ‚‚_!969_^1C_#MTD9_!NUMBER OF TIMES 90 DAYS DELINQUENT_)2_#451_!971_^1C_#MSDF_!SPECIAL DECRIPTION FIELD_240_#453_!973_^1C_#MDYDL NUMBER OF DAYS ACCOUNT DELINQUENT_*3_#493 1013_^11_]_^1C_#THE FIRST FIELDS, MSTDT AND LATLA, ARE NOT UPDATED WITH INPUT RE-_^1C_#CORD CONTENTS, BUT WITH THE SYSTEM DATE. ALL OTHER FIELDS ARE IN_^1C_#THE TRANSACTION INPUT RECORD. THE INTERNAL TABLE "FINCT ‚‚B" CON-_^1C_#TAINS THE FIELD DECRIPTIONS NECESSARY TO PERFORM THE UPDATING._^1C_#THE TABLE CONSISTS OF THE FOLLOWING THREE WORD ENTRIES FOR EACH_^1C_#FIELD:_^1C_(1ST WORD = START CHARACTER POSITION IN INPUT RECORD . IF_^1C_3THIS FIELD IS ZERO, THIS ENTRY IS A NULL ENTRY._^1C_3IF THIS FIELD IS LESS THAN ZERO, THIS SIGNALS_^1C_3THE LAST ENTRY IN THE TABLE (END-OF-TABLE)._^1C_(2ND WO ‚‚RD = START CHARACTER POSTION IN FILE._^1C_(3RD WORD = LENGTH OF FIELD IN CHARACTERS (BYTES)._^1C_#THE CURRENT TABLE WILL PROCESS THE FIRST THREE ENTRIES. THESE_^1C_#ENTRIES COVER ALL FIELDS SINCE THE FIELDS FORM THREE CONTIGUOUS_^1C_#BLOCKS IN THE INPUT RECORD AND MASTER FILE RECORD. THE UPDATE_^1C_#OF ALL FIELDS IN "FINCTB" IS ACCOMPLISHED THRU THREE MOVES._^1C_#FINAL FUNCTION O ‚‚F LAUNCU IS TO EXIT ON UPDATE OR REACTIVATION_^1C_#TRANSACTIONS TO THE USER AREA MANAGEMENT ROUTINE (CCSPYT). THIS_^1C_#ROUTINE IS WRITTEN BY THE LOCAL ANALYST TO PERFORM CUSTOMER SPECI-_^1C_#FIC OPERATIONS. TWO FIELDS ARE PASSED TO THIS ROUTINE:_^1C_(1) THE MASTER FILE RECORD - IN ITS ENTIRETY_^1C_#AND 2) THE INPUT TRANSACTION RECORD - IN ITS ENTIRETY._^1C_#AFTER RETURN FROM CCS ‚‚PYT, THE ROOT PORTION OF THE MASTER FILE IS_^1C_#RESTORED WITH CONTENTS OF AN INTERNAL SAVE PRIOR TO THE EXIT TO_^1C_#CCSPYT. THIS ELIMINATES THE POSSIBILITY OF MODIFICATION OF THE_^1C_#ROOT AREA BY CCSPYT. THE USER (CUSTOMER DEFINED) ARE OF THE_^1C_#MASTER FILE RECORD IS THEN UPDATED WITH THE USER (CUTOMER DEFINED)_^1C_#ARE ON THE INPUT RECORD. THE GENERALIZED PROGRAM FLOW IS AS ‚‚_^1C_#FOLLOWS:_^1C_(1. UPDATE MSTDT AND LATLA FIELDS WITH SYSTEM DATE (*L/A*)_^1C_(2. STARTING WITH THE FIRST FIELD DESCRIPTION THRU THE LAST_^1C_+FIELD DECRIPTION, DO_^1C_0IF START POSITION IN INPUT RECORD IS ZERO, CONTINUE_^1C_5ELSE, IF START POSITION IN INPUT RECORD IS_^1C_5< 0, CONTINUE_^1C_:ELSE, END-OF-TABLE ENCOUNTERED, TERMINATE_^1C_:LOOP_^1C_5MOVE FIELDS FROM INPUT RECORD ‚‚TO MASTER FILE_^1C_5RECORD_^1C_0CONTINUE LOOP._^1C_(3. IF THIS AN ADD TRANSACTION, CONTINUE_^1C_0ELSE, SAVE ROOT PORTION OF MASTER FILE_^1C_0EXIT TO CCSPYT_^1C_0RESTORE ROOT AREA OF MASTER FILE._^1C_(4. UPDATE USER ARE WITH INPUT RECORD CONTENTS OF USER AREA._^1C_(5. RETURN._^12_]_^1C****_#RETRIEVE COMMON DECLARATION MACRO._^1M_#UPDMAC_^1C****_#LOCAL DECLARATIONS._^11_]_^1C****_#RO ‚‚OT AREA OF MASTER FILE SAVE AREA AND LENGTH (*L/A*)._^1_$INTEGER ROOTSV(693), LROOT_^1_$DATA LROOT / 1385 /_^11_]_^1C****_#START CHARACTER OF USER (CUSTOMER DEFINED) AREA IN INPUT_^1C****_#BUFFER AND LENGTH IN MASTER FILE RECORD (*L/A*)._^1_$INTEGER TCUS, LCUS_^1_$DATA TCUS / 496 /_^1_$DATA LCUS / 615 /_^11_]_^1C****_#START CHARACTER OF USER (CUSTOMER DEFINED) AREA IN MASTER_^1C*** ‚‚*_#RECORD (*L/A*)._^1_$INTEGER MCUS_^1_$DATA MCUS / 1386 /_^11_]_^1C****_#START CHARACTER POSITION OF DATE TO LA FIELD IN MASTER_^1C****_#RECORD (*L/A*)._^1_$INTEGER LATLA_^1_$DATA LATLA / 1057 /_^1._]_^1C****_#FINANCIAL FIELD UPDATE TABLE - "FINCTB" ._^1_$INTEGER FINCTB(75)_^1_$INTEGER F1(3), F2(3), F3(3), F4(3), F5(3), F6(3), F7(3),_^1_#+_(F8(3), F9(3), F10(3), F11(3), F1 ‚‚2(3), F13(3), F14(3),_^1_#+_'F15(3), F16(3), F17(3), F18(3), F19(3), F20(3), F21(3),_^1_#+_'F22(3), F23(3), F24(3), F25(3)_^1_$EQUIVALENCE ( FINCTB( 1), F1(1) ), ( FINCTB( 4), F2(1) ),_^1_#+_+( FINCTB( 7), F3(1) ), ( FINCTB(10), F4(1) ),_^1_#+_+( FINCTB(13), F5(1) ), ( FINCTB(16), F6(1) ),_^1_#+_+( FINCTB(19), F7(1) ), ( FINCTB(22), F8(1) ),_^1_#+_+( FINCTB(25), F9(1) ), ( ‚‚ FINCTB(28), F10(1) ),_^1_#+_+( FINCTB(31), F11(1) ), ( FINCTB(34), F12(1) )_^1_$EQUIVALENCE ( FINCTB(37), F13(1) ), ( FINCTB(40), F14(1) ),_^1_#+_+( FINCTB(43), F15(1) ), ( FINCTB(46), F16(1) ),_^1_#+_+( FINCTB(49), F17(1) ), ( FINCTB(52), F18(1) ),_^1_#+_+( FINCTB(55), F19(1) ), ( FINCTB(58), F20(1) ),_^1_#+_+( FINCTB(61), F21(1) ), ( FINCTB(64), F22(1) ),_^1_#+_+( FINCTB(67), F2 ‚‚3(1) ), ( FINCTB(70), F24(1) )_^1_$EQUIVALENCE ( FINCTB(73), F25(1) )_^1_$DATA F1 / 363, 875, 64 /_^1+_E1. BLOCK 1, FIELDS 4-12 BELOW_^1_$DATA F2 / 427, 947, 69 /_^1+_E2. BLOCK 2, FIELDS 13-21 BELOW_^1_$DATA F3 / 393, 1063, 9 /_^1+_E3. LADUE (*L/A*)_^1_$DATA F4 /_!-1,_"0, 0 /_^1+_E4. CURRENT DESIGN - END OF TABLE_^1_$DATA F5 / 363, 875, 6 /_^1+_E5. MDLDT_^1_$DATA F ‚‚6 / 369, 881, 6 /_^1+_E6. MOPDT_^1_$DATA F7 / 375, 887, 9 /_^1+_E7. MADLQ_^1_$DATA F8 / 384, 896, 9 /_^1+_E8. MCBAL_^1_$DATA F9 / 393, 905, 9 /_^1+_E9. MPYOF_^1_$DATA F10 / 402, 914, 6 /_^1+_D10. MCPGD_^1_$DATA F11 / 408, 920, 9 /_^1+_D11. MNPA_^1_$DATA F12 / 417, 929, 9 /_^1+_D12. MOAMT_^1_$DATA F13 / 426, 938, 1 /_^1+_D13. MCMN_^1_$DATA F14 / 427, 947 ‚‚, 3 /_^1+_D14. MPTS_^1_$DATA F15 / 430, 950, 5 /_^1+_D15. MBBR_^1_$DATA F16 / 435, 955, 8 /_^1+_D16. MLON_^1_$DATA F17 / 443, 963, 4 /_^1+_D17. MTCD_^1_$DATA F18 / 447, 967, 2 /_^1+_D18. MTD3_^1_$DATA F19 / 449, 969, 2 /_^1+_D19. MTD6_^1_$DATA F20 / 451, 971, 2 /_^1+_D20. MTD9_^1_$DATA F21 / 453, 973, 40 /_^1+_D21. MSDF_^1_$DATA F22 / 493, 1013, 3 /_^1+_D22. ‚‚MDYDL_^1_$DATA F23 /_!-1,_"0, 0 /_^1+_D23. NOT USED_^1_$DATA F24 /_!-1,_"0, 0 /_^1+_D24. NOT USED_^1_$DATA F25 /_!-1,_"0, 0 /_^1+_D25. NOT USED_^12_]_^1C****_#MAXIMUM NUMBER OF ENTRIES IN TABLE._^1_$INTEGER NUMENT_^1_$DATA NUMENT / 25 /_^1._]_^1C***********************************************************************_^1C*_:BEGIN PROGRAM._;*_^1C************************************ ‚‚***********************************_^12_]_^1C**** UPDATE MSTDT FIELD._^1 100 CALL CCSMVA ( DATE, N1, N6, RECBDM, MSTDT, N6 )_^11_]_^1C**** UPDATE DATE TO L/A FIELD (*L/A*)._^1 105_!CALL CCSMVA ( DATE, N2, N6, RECBDM, LATLA, N6 )_^11_]_^1C**** STARTING WITH FIRST FIELD DESCRIPTION THRU LAST FIELD DESCRIPTION,_^1C**** DO (J IS POINTER TO CURRENT 3 WORD FIELD DESCRIPTION)_^1 110_!DO ‚‚ 130 I=1,NUMENT_^1_%J = 3*I - 2_^1C**_'IF START POSITION OF FIELD IN INPUT RECORD IS ZERO, CONTINUE_^1_+IF ( FINCTB(J) .EQ. 0 ) GO TO 130_^1C**_,ELSE, IF START POSITION OF FIELD IN INPUT RECORD IS_^1C**_,POSITIVE, CONTINUE_^1_0IF ( FINCTB(J) .GE. 0 ) GO TO 120_^1C**_1ELSE, END-OF-TABLE ENCOUNTERED, TERMINATE LOOP_^1_5GO TO 140_^1C**_,MOVE FIELD FROM INPUT RECORD TO MASTER FILE RECO ‚‚RD_^1 120_,CALL CCSMVA ( INPBUF, FINCTB(J) , FINCTB(J+2),_^1_#+_8RECBDM, FINCTB(J+1), FINCTB(J+2) )_^1C**_,CONTINUE WITH LOOP._^1 130_!CONTINUE_^11_]_^1C**** IF THIS IS AN ADD TRANSACTION, CONTINUE_^1 140_!IF ( ACCTFD .EQ. 0 ) GO TO 150_^1C**_'ELSE, SAVE ROOT AREA OF MASTER FILE_^1_+CALL CCSMVA ( RECBDM, N1, LROOT, ROOTSV, N1, LROOT )_^1C**_'EXIT TO USER (CUSTOMER DEFINED) AREA MA ‚‚NAGEMENT ROUTINE_^1_+CALL CCSPYT ( RECBDM, INPBUF )_^1C**_'RESTORE ROOT AREA OF MASTER FILE._^1_+CALL CCSMVA ( ROOTSV, N1, LROOT, RECBDM, N1, LROOT )_^11_]_^1C**** SAVE USER (CUSTMOMER DEFINED) AREA FROM INPUT RECORD._^1 150_!CALL CCSMVA ( INPBUF, TCUS, LCUS, RECBDM, MCUS, LCUS )_^11_]_^1C**** UNCONDITIONAL UPDATE OF FINANCIAL FIELDS COMPLETE, RETURN._^1 200_!RETURN_^1_%END_]_^__ ‚‚MON06 CSY/ 17790 ‚‚1 MON_]_^1 OPT LPC_]_^__ ‚‚LU4BLK CSY/ 00150 ‚‚1_$BLOCK DATA_^1_#1_2/F78 F LA_!CCS 3.0_5SL-149_^1C_#BLOCK DATA SUBPROGRAM TO INITIALIZE COMMON FOR LUD400_^1C_#CYBERCREDIT SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^11_]_^1C****_#RETRIEVE MACRO DEFINITION._^1M_#UP4MAC_^1C****_#BEGIN INITIALIZATION._^1_$DATA ACCTFD / 0 /_^1_$DATA AFLG / 17 /_^1_ ‚‚$DATA AZEROS / 15*$3030 /_^1_$DATA BLANKS / ' ' /_^1_$DATA BUSY / $0080 /_^1_$DATA ((COLHD(J,I), J=1,66), I=1,1) /_^1_#1_'' TRAN_#ACCOUNT_9',_^1_#2_''_K',_^1_#3_''_K'/_^1_$DATA ((COLHD(J,I), J=1,66), I=2,2) /_^1_#1_'' CODE_#NUMBER_/NEW DATA_!',_^1_#2_''_6OLD DATA_,',_^1_#3_''_(ACTION_9',$D/_^1_$DATA DETLIN / 68*$2020 /_^1_$DATA DUMMY / $FFFF /_^1_$DATA EOF / $0100 /_^1_$DATA EOF ‚‚FLG / 0 /_^1_$DATA ((HDLIN(J,I), J=1,66), I=1,1) /_^1_#1 $C3C, '-- HDR1 FROM UTILITY FILE GOES HERE -->_#',_^1_#2_''_K',_^1_#3_''_I' /_^1_$DATA ((HDLIN(J,I), J=1,66), I=2,2) /_^1_#1 $3C, '-- HDR2 FROM UTILITY FILE GOES HERE -->_#',_^1_#2_''_#DAILY MASTER FILE NON-FINANCIAL UPDATE ',_^1_#3_''REPORT_7PAGE_'' /_^1_$DATA ((HDLIN(J,I), J=1,66), I=3,3) /_^1_#1 $3C, '-- HDR3 FROM U ‚‚TILITY FILE GOES HERE -->_#',_^1_#2_''_6<-DATE->_,',_^1_#3_''_G',$D /_^1_$DATA IDATAD / 'LAADDACT', 8*$2020, 0, 1, 0 /_^1_$DATA IDATCS / 'LACOSIGN', 8*$2020, 1, 1, 1 /_^1_$DATA IDATDM / 'LADLQMST', 8*$2020, 1, 1, 1 /_^1_$DATA IDATIN / 'UP4INPUT', 8*$2020, 0, 1, -1 /_^1_$DATA IDATPR / 'UP4PRINT', 8*$2020, 0, 1, 0 /_^1_$DATA IDATUT / 'LAUTIFIL', 8*$2020, 1, 1, 0 /_^1_$DATA IFLAG / 0 ‚‚/_^1_$DATA KHDRX / 'HDR1' /_^1_$DATA LINCNT / 66 /_^1_$DATA MNAM / 18 /_^1_$DATA MNCHG / 1047 /_^1_$DATA MT1 / 16 /_^1_$DATA NDAONE / '0000000001' /_^1_$DATA NUMREJ / 6*$3030 /_^1_$DATA NUMUPD / 6*$3030 /_^1_$DATA N0 / 0 /_^1_$DATA N1 / 1 /_^1_$DATA N2 / 2 /_^1_$DATA N3 / 3 /_^1_$DATA N4 / 4 /_^1_$DATA N5 / 5 /_^1_$DATA N6 / 6 /_^1_$DATA N7 / 7 /_^1_$DATA N9 / 9 /_^1_$DATA N10 / ‚‚10 /_^1_$DATA N11 / 11 /_^1_$DATA N13 / 13 /_^1_$DATA N14 / 14 /_^1_$DATA N15 / 15 /_^1_$DATA N16 / 16 /_^1_$DATA N35 / 35 /_^1_$DATA N40 / 40 /_^1_$DATA N80 / 80 /_^1_$DATA N132 / 132 /_^1_$DATA PAGCNT / 6*$3030 /_^1_$DATA RECBDM / 1002*$2020 /_^1_$DATA REQBAD / 24*0 /_^1_$DATA REQBCS / 24*0 /_^1_$DATA REQBDM / 24*0 /_^1_$DATA REQBIN / 24*0 /_^1_$DATA REQBPR / 24*0 /_^1_$DATA REQB ‚‚UT / 24*0 /_^1_$DATA R9SWCH / $00E3 /_^1_$DATA TAPE / 6 /_^1_$DATA TNFLD / 20 /_^1_$DATA TOTPRT / 0 /_^1_$DATA WRONKY / $0200 /_^11_]_^1C****_#END OF INITIALIZATION._^11_]_^1_$END_]_^__ ‚‚MON07 CSY/ 17790 ‚‚1 MON_]_^1 OPT LPC_]_^__ ‚‚ZLA83 CSY/ 18450 ‚‚1_$PROGRAM ZLA83_^1_#1_2/F83 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA84 CSY/ 18580 ‚‚1_$PROGRAM ZLA84_^1_#1_2/F84 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA85 CSY/ 18710 ‚‚1_$PROGRAM ZLA85_^1_#1_2/F85 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA86 CSY/ 18840 ‚‚1_$PROGRAM ZLA86_^1_#1_2/F86 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA87 CSY/ 18970 ‚‚1_$PROGRAM ZLA87_^1_#1_2/F87 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA88 CSY/ 19100 ‚‚1_$PROGRAM ZLA88_^1_#1_2/F88 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA89 CSY/ 19230 ‚‚1_$PROGRAM ZLA89_^1_#1_2/F89 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA90 CSY/ 19360 ‚‚1_$PROGRAM ZLA90_^1_#1_2/F90 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA91 CSY/ 19490 ‚‚1_$PROGRAM ZLA91_^1_#1_2/F91 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ZLA92 CSY/ 19620 ‚‚1_$PROGRAM ZLA92_^1_#1_2/F92 F CCS CCS 3.0_5SL-149_^1C_]_^1C_#LEGAL AND AGENCY SYSTEM VERSION 3_^1C_#DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA_^1C_#COPYRIGHT CONTROL DATA CORPORATION, 1979_^1C_]_^1C_#COSY DECK FOR FUTURE PROGRAM DEVELOPMENT_^12_]_^1_$END_]_^__ ‚‚ END/ ‚‚ ‚