/*PROGRAM ARP030 - HWCS A/R BILLING LABEL REPORT PROGRAMMER ROBERT M. WHITE DATE WRITTEN APRIL 15, 1981 PURPOSE THIS ROUTINE PRINTS LABELS FOR THE BILLING CONTACTS IN THE A/R CUSTOMER FILE. INPUT OUTPUT REMARKS 1. PRINTING IS TERMINATED IF THE ESC KEY IS PRESSED AT THE END OF THE NEXT LABEL. */ ARP030: 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 */ /* * * 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 ARM030 ENTRY; /* EXTERNAL MAPS */ %INCLUDE 'OUTZIP.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 A RECORD. * * */ PRNT_RECS: PROC; DCL NUM_BLANK BIN(7); /* NUMBER OF BLANK LINES */ /* DO INITIALIZATION. */ NUM_BLANK=0; /* PRINT 1ST LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILCON) (A(32)); /* PRINT 2ND LINE. */ IF REC1.CSBILCMP~=' ' THEN DO; PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILCMP) (A(32)); END; ELSE NUM_BLANK=NUM_BLANK+1; /* PRINT 3RD LINE. */ IF REC1.CSBILAD1~=' ' THEN DO; PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD1) (A(32)); END; ELSE NUM_BLANK=NUM_BLANK+1; /* PRINT 4TH LINE. */ IF REC1.CSBILAD2~=' ' THEN DO; PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD2) (A(32)); END; ELSE NUM_BLANK=NUM_BLANK+1; /* PRINT 5TH LINE. */ PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD3,OUT_ZIP(REC1.CSBILZIP)) (A(23),X(2),A(10)); PUT FILE(PRINTFILE) SKIP; /* PRINT FILLER/SEPERATOR LINES. */ DO I=1 TO NUM_BLANK; PUT FILE(PRINTFILE) SKIP; END; /* RETURN TO CALLER. */ RETURN; END PRNT_RECS; /* * * START OF MAIN PROGRAM * * */ MAIN_MENU: BEGIN; CALL ARM030; /* 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; /* ALIGN LABELS. */ ALN_LBL: CALL EOL(24,1); CALL PUTMSG(24,1,'PRINT TEST LABEL (Y/N):'); CALL GETSTR(24,25,1,ADDR(RP),RTN_COD); IF RP~='Y' THEN GOTO END_ALN; PUT FILE(PRINTFILE) SKIP LIST('1111111111111111111111111111111'); PUT FILE(PRINTFILE) SKIP LIST('2222222222222222222222222222222'); PUT FILE(PRINTFILE) SKIP LIST('3333333333333333333333333333333'); PUT FILE(PRINTFILE) SKIP LIST('4444444444444444444444444444444'); PUT FILE(PRINTFILE) SKIP LIST('5555555555555555555555555555555'); PUT FILE(PRINTFILE) SKIP; GOTO ALN_LBL; END_ALN: /* PRINT THE DATA FROM THE FILE. */ RCD_CNT=0; PUT SKIP LIST('PRINTING THE REPORT...'); 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 ARP030;