/*PROGRAM ARP040 - HWCS A/R CUSTOMER LIST REPORT PROGRAMMER ROBERT M. WHITE DATE WRITTEN APRIL 15, 1981 PURPOSE THIS ROUTINE PRINTS THE INFORMATION NECESSARY FOR A CONCISE CALL LIST OF ALL THE CUSTOMERS. INPUT OUTPUT REMARKS 1. PRINTING IS TERMINATED IF THE ESC KEY IS PRESSED AT THE END OF THE NEXT LABEL. */ ARP040: 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(1); /* 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 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); /* TOTAL # OF RECORDS PRINTED */ DCL PAGE_NUMBER BIN(7); /* PAGE NUMBER */ DCL LINE_NUMBER BIN(7); /* LINE NUMBER */ /* * * 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 ARM040 ENTRY; /* EXTERNAL MAPS */ %INCLUDE 'OUTZIP.PLI'; %INCLUDE 'OUTTEL.PLI'; /* * * PRINT A RECORD. * * */ GET_RECS: PROC; /* DO INITIALIZATION. */ NUM_MSTR=0; /* READ RECORD FOR A. */ READ_REC_A: CALL BTREE(BT_READN,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN NUM_MSTR=1; ELSE DO; CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.'); EOF_MSTR='1'B; RETURN; END; /* SELECT THE RECORD. */ IF SEL_NUM=0 THEN RETURN; DO I=1 TO SEL_NUM; IF SEL_TYPE(I)=REC1.CSSTAT THEN GOTO GET_RECS_END; END; GOTO READ_REC_A; /* DIDN'T FIND THE TYPE SO SKIP IT. */ /* RETURN TO CALLER. */ GET_RECS_END: RETURN; END GET_RECS; /* * * PRINT THE HEADINGS. * * */ PRNT_HDNG: PROC; /* BUMP COUNTS. */ LINE_NUMBER=0; PAGE_NUMBER=PAGE_NUMBER+1; /* PRINT THE HEADING LINES. */ PUT FILE(PRINTFILE) PAGE; PUT FILE(PRINTFILE) SKIP(3) EDIT('ARP040','H & W COMPUTER SYSTEMS, INC.') (X(5),A(6),X(25),A(28)); PUT FILE(PRINTFILE) SKIP EDIT(CURDAT,'CUSTOMER LIST','PAGE',PAGE_NUMBER) (X(5),A(08),X(28),A(18),X(35),A(4),F(4)); PUT FILE(PRINTFILE) SKIP EDIT('ID', 'BILLING DATA','TECHNICAL DATA','MISCELLANEOUS') (X(5),A(06),X(1),A(32),X(5),A(32),X(5),A(24)); PUT FILE(PRINTFILE) SKIP; /* RETURN TO CALLER. */ END PRNT_HDNG; /* * * PRINT A RECORD. * * */ PRNT_DESC: PROC; /* PRINT 1ST LINE. */ PUT FILE(PRINTFILE) SKIP EDIT('ID','BILLING CONTACT', 'TECHNICAL CONTACT','STATUS','MISCELLANEOUS') (X(5),A(06),X(1),A(32),X(5),A(32),X(1),A(6),X(2),A(20)); /* PRINT 2ND LINE. */ PUT FILE(PRINTFILE) SKIP EDIT('BILLING COMPANY NAME', 'TECHNICAL COMPANY NAME','TERM','CURRENT AMOUNT') (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20)); /* PRINT 3RD LINE. */ PUT FILE(PRINTFILE) SKIP EDIT('BILLING ADDRESS #1', 'TECHNICAL ADDRESS #1','BALTYP','OVER 30 AMOUNT') (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20)); /* PRINT 4TH LINE. */ PUT FILE(PRINTFILE) SKIP EDIT('BILLING ADDRESS #2', 'TECHNICAL ADDRESS #2','PRCCOD','OVER 60 AMOUNT') (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20)); /* PRINT 5TH LINE. */ PUT FILE(PRINTFILE) SKIP EDIT('BILLING ADDRESS #3', 'TECHNICAL ADDRESS #3','DISCNT','OVER 90 AMOUNT') (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20)); /* PRINT 6TH LINE. */ PUT FILE(PRINTFILE) SKIP EDIT('BILLING PHONE/EXT', 'TECHNICAL PHONE/EXT','TAXCOD','LAST YEAR AMOUNT') (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20)); /* PRINT 7TH LINE. */ PUT FILE(PRINTFILE) SKIP; /* PRINT HEADING IF NECESSARY. */ LINE_NUMBER=LINE_NUMBER+1; IF LINE_NUMBER>07 THEN CALL PRNT_HDNG; /* RETURN TO CALLER. */ END PRNT_DESC; /* * * PRINT A RECORD. * * */ PRNT_RECS: PROC; /* PRINT 1ST LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSID,REC1.CSBILCON,REC1.CSTECCON, REC1.CSSTAT,REC1.CSSPCL) (X(5),A(06),X(1),A(32),X(5),A(32),X(5),A(2),X(2),A(20)); /* PRINT 2ND LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILCMP,REC1.CSTECCMP, REC1.CSTERM,REC1.CSCURAMT) (X(12),A(32),X(5),A(32),X(5),A(2),X(2),P'--,---,--9.V99'); /* PRINT 3RD LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD1,REC1.CSTECAD1, REC1.CSBALTYP,REC1.CS30DAMT) (X(12),A(32),X(5),A(32),X(5),A(1),X(3),P'--,---,--9.V99'); /* PRINT 4TH LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD2,REC1.CSTECAD2, REC1.CSPRCCOD,REC1.CS60DAMT) (X(12),A(32),X(5),A(32),X(5),A(1),X(3),P'--,---,--9.V99'); /* PRINT 5TH LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD3,OUT_ZIP(REC1.CSBILZIP), REC1.CSTECAD3,OUT_ZIP(REC1.CSTECZIP),REC1.CSPRCCOD,REC1.CSOVRAMT) (X(12),A(23),X(2),A(10),X(2),A(23),X(2),A(10),X(2),A(1),X(3), P'--,---,--9.V99'); /* PRINT 6TH LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(OUT_TEL(REC1.CSBILTEL),REC1.CSBILEXT, OUT_TEL(REC1.CSTECTEL),REC1.CSTECEXT,REC1.CSDISC,REC1.CSLYRAMT) (X(12),A(14),X(1),F(4),X(18),A(14),X(1),F(4),X(18),A(1),X(3), P'--,---,--9.V99'); /* PRINT 7TH LINE. */ PUT FILE(PRINTFILE) SKIP; /* PRINT HEADING IF NECESSARY. */ LINE_NUMBER=LINE_NUMBER+1; IF LINE_NUMBER>07 THEN CALL PRNT_HDNG; /* RETURN TO CALLER. */ END PRNT_RECS; /* * * START OF MAIN PROGRAM * * */ MAIN_MENU: BEGIN; CALL ARM040; /* DISPLAY BACKGROUND. */ CALL GETB15(06,23,NRP,0,1,RTN_COD); /* GET THE INPUT NUMBER. */ 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; /* GET THE STATUS CODES USED FOR RECORD SELECTION. */ SEL_NUM=0; DO I=1 TO 50; CALL EOL(24,1); CALL PUTMSG(24,1,'DO YOU WISH TO ENTER A SELECTION CODE(Y/N)?'); CALL GETSTR(24,45,1,ADDR(RP),RTN_COD); IF RP~='Y' THEN GOTO SEL_END; CALL EOL(24,1); CALL PUTMSG(24,1,'ENTER SELECTION CODE:'); SEL_NUM=SEL_NUM+1; CALL GETSTR(24,23,2,ADDR(SEL_TYPE(SEL_NUM)),RTN_COD); END; SEL_END: /* OPEN THE PRINT FILE AND PRINT THE FIRST HEADING. */ OPEN FILE(PRINTFILE) PRINT PAGESIZE(0) LINESIZE(132) TITLE('$LST'); /* SETL TO THE FIRST MEMBER. */ EOF_MSTR='0'B; DO I=1 TO LENGTH(REC1.CSID); /* FORCE KEY TO LOW VALUES. */ SUBSTR(REC1.CSID,I,1)=ASCII(0); END; CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 | RTN_COD=BT_KEYNOTFND THEN ; ELSE DO; CALL PUTERR('LOCATE RETURN CODE ='||RTN_COD||'.'); GOTO PRINT_END; END; /* PRINT THE DATA FROM THE FILE. */ RCD_CNT=0; PUT SKIP LIST('PRINTING THE REPORT...'); PAGE_NUMBER=0; CALL PRNT_HDNG; /* PRINT INITIAL HEADINGS. */ CALL PRNT_DESC; /* PRINT REPORT DESCRIPTION. */ PRINT_LOOP: DO WHILE(EOF_MSTR='0'B); CALL GET_RECS; IF EOF_MSTR='0'B THEN DO; CALL PRNT_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: PUT FILE(PRINTFILE) SKIP; PUT FILE(PRINTFILE) SKIP LIST('RECORDS PRINTED:',RCD_CNT); PUT FILE(PRINTFILE) SKIP; PUT FILE(PRINTFILE) PAGE; CLOSE FILE(PRINTFILE); GOTO MAIN_MENU; END; END ARP040;