/*PROGRAM ARP050 - HWCS ACCOUNTS RECEIVABLE CUSTOMER FILE OFF-LOAD PROGRAMMER ROBERT M. WHITE DATE WRITTEN APRIL 15, 1981 PURPOSE THIS ROUTINE OFF-LOADS THE CUSTOMER FILE TO A SEQUENTIAL FILE. THIS COMPLEMENTS THE CUSTOMER FILE LOAD PROGRAM. INPUT OUTPUT REMARKS */ ARP050: PROC; /* * * * A/R MASTER MENU PROGRAM * * * */ /* * * PROGRAM REPLACEMENTS * * */ %INCLUDE 'C:BTCCS.PLI'; /* BT-80 FUNCTIONS */ %INCLUDE 'C:BTERRCS.PLI'; /* BT-80 ERROR RETURN CODES */ %REPLACE FALSE BY '0'B; %REPLACE TRUE BY '1'B; /* * * PROGRAM AREAS * * */ DCL I BIN(7); /* INDEX VARIABLE */ DCL RP CHAR(2); /* CHAR RESPONSE */ DCL NRP BIN(15); /* NUMERIC RESPONSE */ DCL RTN_COD BIN(7); /* SUBROUTINE RETURN CODE */ DCL SYSPRINT FILE; /* CONSOLE OUTPUT FILE */ DCL PRINTFILE FILE; /* OUTPUT PRINT FILE */ DCL PF_TITLE CHAR(15); /* FILE NAME FOR PRINTFILE */ DCL SEL_TYPE(25) CHAR(2); /* PRINT SELECT TYPES */ DCL SEL_NUM BIN(7); DCL FIRST_TIME BIT(1) STATIC INITIAL('0'B); DCL EOF_MSTR BIT(1) STATIC INITIAL('0'B); DCL NUM_MSTR BIN(7); /* 1=A ONLY, 2=A & B */ DCL RCD_CNT BIN(15); /* RECORD COUNT */ /* * * COMMON DCL INCLUDES * * */ %INCLUDE 'C:SUBS1.DCL'; %INCLUDE 'ARCOMMON.DCL'; %INCLUDE 'ARCUSTM.DCL'; /* * * COMMON PROC INCLUDES * * */ DCL BTREE ENTRY(BIN(7),BIN(7),PTR,BIN(7)); DCL ARM050 ENTRY; /* EXTERNAL MAPS */ /* * * PRINT A RECORD. * * */ GET_RECS: PROC; /* GET THE RECORD. */ CALL BTREE(BT_READN,IDX1,IOCB1P,RTN_COD); IF RTN_COD~=0 THEN EOF_MSTR='1'B; /* RETURN TO CALLER. */ END GET_RECS; /* * * PRINT A RECORD. * * */ PUT_RECS: PROC; /* READ A RECORD. */ PUT FILE(PRINTFILE) SKIP LIST(REC1.CSID, REC1.CSBILCON, REC1.CSBILCMP, REC1.CSBILAD1, REC1.CSBILAD2, REC1.CSBILAD3, REC1.CSBILZIP, REC1.CSBILTEL, REC1.CSBILEXT, REC1.CSTECCON, REC1.CSTECCMP, REC1.CSTECAD1, REC1.CSTECAD2, REC1.CSTECAD3, REC1.CSTECZIP, REC1.CSTECTEL, REC1.CSTECEXT, REC1.CSSTAT, REC1.CSTERM, REC1.CSBALTYP, REC1.CSPRCCOD, REC1.CSDISC, REC1.CSCURAMT, REC1.CS30DAMT, REC1.CS60DAMT, REC1.CSOVRAMT, REC1.CSLYRAMT, REC1.CSSPCL); PUT SKIP LIST('OFF-LOADED: ',REC1.CSID); /* RETURN TO CALLER. */ RETURN; END PUT_RECS; /* * * START OF MAIN PROGRAM * * */ MAIN_MENU: BEGIN; CALL ARM050; /* PUT UP BACKGROUND. */ CALL GETB15(06,23,NRP,0,1,RTN_COD); /* GET THE FUNCTION. */ GOTO MAIN_FUNC(NRP); /* PERFORM THE FUNCTION. */ END; /* MAIN_MENU */ /* * * RETURN TO MAIN MENU * * */ MAIN_FUNC(00): BEGIN; CALL CLRSCRN; CALL PUTMSG(1,1,'RETURNING TO MASTER MENU...'); RETURN; END; /* * * PRINT THE REPORT * * */ MAIN_FUNC(01): BEGIN; /* DO INITIALIZATION. */ CALL CLRSCRN; PUT SKIP LIST(' * * * CUSTOMER FILE LOAD PROGRAM * * *'); PUT SKIP LIST(' ***OFF-LOAD THE FILE***'); EOF_MSTR='0'B; /* OPEN THE PRINT FILE AND PRINT THE FIRST HEADING. */ CALL EOL(24,1); CALL PUTMSG(24,1,'ENTER OUTPUT FILE NAME:'); CALL GETSTR(24,26,LENGTH(PF_TITLE),ADDR(PF_TITLE),RTN_COD); OPEN FILE(PRINTFILE) STREAM OUTPUT PAGESIZE(0) LINESIZE(512) ENV(B(4096)) TITLE(PF_TITLE); /* SETL TO BEGINNING OF CUSTOMER MASTER FILE. */ DO I=1 TO LENGTH(REC1.CSID); SUBSTR(REC1.CSID,I,1)=ASCII(0); END; CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD); /* PRINT THE DATA FROM THE FILE. */ RCD_CNT=0; CALL CLRSCRN; PUT SKIP(0); PUT SKIP LIST('OFF-LOADING THE FILE......'); PRINT_LOOP: DO WHILE(EOF_MSTR='0'B); CALL GET_RECS; IF EOF_MSTR='0'B THEN DO; CALL PUT_RECS; RCD_CNT=RCD_CNT+1; END; RP=CONINP(); IF RP=ASCII(27) THEN /* OPERATOR INTERVENTION VIA ESC */ DO; EOF_MSTR='1'B; END; END; /* RETURN TO CALLER. */ PRINT_END: CLOSE FILE(PRINTFILE); PUT SKIP; PUT SKIP LIST('RECORDS PRINTED:',RCD_CNT); PUT SKIP; CALL PUTMSG(24,1,'PRESS TO CONTINUE.'); CALL GETSTR(24,60,1,ADDR(RP),RTN_COD); GOTO MAIN_MENU; END; END ARP050;