/*PROGRAM ARP010 - A/R CUSTOMER MASTER FILE MAINTENANCE PROGRAMMER ROBERT M. WHITE DATE WRITTEN APRIL 15, 1981 PURPOSE THIS PROGRAM ALLOWS THE OPERATOR TO UPDATE THE A/R CUSTOMER MASTER FILE RECORDS. THIS INCLUDES ALL COMMON MAINTENANCE FUNCTIONS. INPUT OUTPUT REMARKS */ ARP010: PROC; /* * * * CUSTOMER MASTER FILE MAINTENANCE PROGRAM * * * */ /* * * PROGRAM REPLACEMENTS * * */ %INCLUDE 'C:BTCCS.PLI'; %INCLUDE 'C:BTERRCS.PLI'; %REPLACE FALSE BY '0'B; %REPLACE TRUE BY '1'B; /* * * PROGRAM AREAS * * */ DCL I BIN(15); /* INDEX VARIABLE */ DCL RP CHAR(1); /* CHAR RESPONSE */ DCL NRP BIN(15); /* NUMERIC RESPONSE */ DCL RTN_COD BIN(7); /* RETURN CODE */ /* * * 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 ARM010 ENTRY; /* SCREEN ROUTINES */ DCL ARM011 ENTRY; /* * * ZERO RECORD. * * */ ZERO_MSTR: PROC; REC1.CSID=' '; REC1.CSBILCON=' '; REC1.CSBILCMP=' '; REC1.CSBILAD1=' '; REC1.CSBILAD2=' '; REC1.CSBILAD3=' '; REC1.CSBILZIP=' '; REC1.CSBILTEL=' '; REC1.CSBILEXT=0; REC1.CSTECCON=' '; REC1.CSTECCMP=' '; REC1.CSTECAD1=' '; REC1.CSTECAD2=' '; REC1.CSTECAD3=' '; REC1.CSTECZIP=' '; REC1.CSTECTEL=' '; REC1.CSTECEXT=0; REC1.CSSTAT=' '; REC1.CSTERM=' '; REC1.CSBALTYP=' '; REC1.CSPRCCOD=' '; REC1.CSDISC=' '; REC1.CSTAXCOD=' '; REC1.CSCURAMT=0; REC1.CS30DAMT=0; REC1.CS60DAMT=0; REC1.CSOVRAMT=0; REC1.CSLYRAMT=0; REC1.CSSPCL=' '; END; /* * * ENTER A FIELD. * * */ GET_FLD: PROC (I); DCL I BIN(7); GOTO FLDGET(I); FLDGET(01): CALL GETSTR(04,17,LENGTH(REC1.CSBILCON),ADDR(REC1.CSBILCON), RTN_COD); RETURN; FLDGET(02): CALL GETSTR(05,17,LENGTH(REC1.CSBILCMP),ADDR(REC1.CSBILCMP), RTN_COD); RETURN; FLDGET(03): CALL GETSTR(06,17,LENGTH(REC1.CSBILAD1),ADDR(REC1.CSBILAD1), RTN_COD); RETURN; FLDGET(04): CALL GETSTR(07,17,LENGTH(REC1.CSBILAD2),ADDR(REC1.CSBILAD2), RTN_COD); RETURN; FLDGET(05): CALL GETSTR(08,17,LENGTH(REC1.CSBILAD3),ADDR(REC1.CSBILAD3), RTN_COD); RETURN; FLDGET(06): CALL GETSTR(08,49,LENGTH(REC1.CSBILZIP),ADDR(REC1.CSBILZIP), RTN_COD); RETURN; FLDGET(07): CALL GETSTR(09,17,LENGTH(REC1.CSBILTEL),ADDR(REC1.CSBILTEL), RTN_COD); RETURN; FLDGET(08): CALL GETB15(09,36,REC1.CSBILEXT,0,9999,RTN_COD); RETURN; FLDGET(09): CALL GETSTR(11,17,LENGTH(REC1.CSTECCON),ADDR(REC1.CSTECCON), RTN_COD); RETURN; FLDGET(10): CALL GETSTR(12,17,LENGTH(REC1.CSTECCMP),ADDR(REC1.CSTECCMP), RTN_COD); RETURN; FLDGET(11): CALL GETSTR(13,17,LENGTH(REC1.CSTECAD1),ADDR(REC1.CSTECAD1), RTN_COD); RETURN; FLDGET(12): CALL GETSTR(14,17,LENGTH(REC1.CSTECAD2),ADDR(REC1.CSTECAD2), RTN_COD); RETURN; FLDGET(13): CALL GETSTR(15,17,LENGTH(REC1.CSTECAD3),ADDR(REC1.CSTECAD3), RTN_COD); RETURN; FLDGET(14): CALL GETSTR(15,49,LENGTH(REC1.CSTECZIP),ADDR(REC1.CSTECZIP), RTN_COD); RETURN; FLDGET(15): CALL GETSTR(16,17,LENGTH(REC1.CSTECTEL),ADDR(REC1.CSTECTEL), RTN_COD); RETURN; FLDGET(16): CALL GETB15(16,36,REC1.CSTECEXT,0,9999,RTN_COD); RETURN; FLDGET(17): CALL GETSTR(18,12,LENGTH(REC1.CSSTAT),ADDR(REC1.CSSTAT), RTN_COD); RETURN; FLDGET(18): CALL GETSTR(18,25,LENGTH(REC1.CSTERM),ADDR(REC1.CSTERM), RTN_COD); RETURN; FLDGET(19): CALL GETSTR(18,46,LENGTH(REC1.CSBALTYP),ADDR(REC1.CSBALTYP), RTN_COD); RETURN; FLDGET(20): CALL GETSTR(18,64,LENGTH(REC1.CSPRCCOD),ADDR(REC1.CSPRCCOD), RTN_COD); RETURN; FLDGET(21): CALL GETSTR(18,76,LENGTH(REC1.CSDISC),ADDR(REC1.CSDISC), RTN_COD); RETURN; FLDGET(22): CALL GETSTR(19,14,LENGTH(REC1.CSTAXCOD),ADDR(REC1.CSTAXCOD), RTN_COD); RETURN; FLDGET(23): CALL GETSTR(19,29,LENGTH(REC1.CSSPCL),ADDR(REC1.CSSPCL), RTN_COD); RETURN; FLDGET(24): CALL GETD92(20,13,REC1.CSCURAMT,0,0,RTN_COD); RETURN; FLDGET(25): CALL GETD92(20,39,REC1.CS30DAMT,0,0,RTN_COD); RETURN; FLDGET(26): CALL GETD92(20,65,REC1.CS60DAMT,0,0,RTN_COD); RETURN; FLDGET(27): CALL GETD92(21,13,REC1.CSOVRAMT,0,0,RTN_COD); RETURN; FLDGET(28): CALL GETD92(21,41,REC1.CSLYRAMT,0,0,RTN_COD); RETURN; END GET_FLD; /* * * UPDATE A FIELD * * */ UPD_FLDS: PROC; DCL I BIN(15); UPD_LOOP: CALL EOL(23,1); CALL PUTMSG(23,1, 'PLEASE ENTER FIELD NUMBER TO CHANGE OR FOR END: '); CALL GETB15(23,57,I,0,28,RTN_COD); IF I=0 THEN RETURN; CALL GET_FLD(I); GOTO UPD_LOOP; END UPD_FLDS; /* * * PRINT A RECORD. * * */ PRNT_MSTR: PROC; CALL ARM011; /* PUT BACKGROUND ON SCREEN. */ CALL PUTSTR(04,17,LENGTH(REC1.CSBILCON),ADDR(REC1.CSBILCON)); CALL PUTSTR(05,17,LENGTH(REC1.CSBILCMP),ADDR(REC1.CSBILCMP)); CALL PUTSTR(06,17,LENGTH(REC1.CSBILAD1),ADDR(REC1.CSBILAD1)); CALL PUTSTR(07,17,LENGTH(REC1.CSBILAD2),ADDR(REC1.CSBILAD2)); CALL PUTSTR(08,17,LENGTH(REC1.CSBILAD3),ADDR(REC1.CSBILAD3)); CALL PUTSTR(08,49,LENGTH(REC1.CSBILZIP),ADDR(REC1.CSBILZIP)); CALL PUTSTR(09,17,LENGTH(REC1.CSBILTEL),ADDR(REC1.CSBILTEL)); CALL PUTB15(09,36,REC1.CSBILEXT); CALL PUTSTR(11,17,LENGTH(REC1.CSTECCON),ADDR(REC1.CSTECCON)); CALL PUTSTR(12,17,LENGTH(REC1.CSTECCMP),ADDR(REC1.CSTECCMP)); CALL PUTSTR(13,17,LENGTH(REC1.CSTECAD1),ADDR(REC1.CSTECAD1)); CALL PUTSTR(14,17,LENGTH(REC1.CSTECAD2),ADDR(REC1.CSTECAD2)); CALL PUTSTR(15,17,LENGTH(REC1.CSTECAD3),ADDR(REC1.CSTECAD3)); CALL PUTSTR(15,49,LENGTH(REC1.CSTECZIP),ADDR(REC1.CSTECZIP)); CALL PUTSTR(16,17,LENGTH(REC1.CSTECTEL),ADDR(REC1.CSTECTEL)); CALL PUTB15(16,36,REC1.CSTECEXT); CALL PUTSTR(18,12,LENGTH(REC1.CSSTAT),ADDR(REC1.CSSTAT)); CALL PUTSTR(18,25,LENGTH(REC1.CSTERM),ADDR(REC1.CSTERM)); CALL PUTSTR(18,46,LENGTH(REC1.CSBALTYP),ADDR(REC1.CSBALTYP)); CALL PUTSTR(18,64,LENGTH(REC1.CSPRCCOD),ADDR(REC1.CSPRCCOD)); CALL PUTSTR(18,76,LENGTH(REC1.CSDISC),ADDR(REC1.CSDISC)); CALL PUTSTR(19,14,LENGTH(REC1.CSTAXCOD),ADDR(REC1.CSTAXCOD)); CALL PUTSTR(19,29,LENGTH(REC1.CSSPCL),ADDR(REC1.CSSPCL)); CALL PUTD92(20,13,ADDR(REC1.CSCURAMT)); CALL PUTD92(20,39,ADDR(REC1.CS30DAMT)); CALL PUTD92(20,65,ADDR(REC1.CS60DAMT)); CALL PUTD92(21,13,ADDR(REC1.CSOVRAMT)); CALL PUTD92(21,41,ADDR(REC1.CSLYRAMT)); END PRNT_MSTR; /* * PRINT SECTION HEADING * */ PRNT_HDNG: PROC (SUB); DCL SUB CHAR(25) VARYING; DCL BLANKS CHAR(13) STATIC INITIAL(' '); DCL NUM_BLANKS BIN(15); /* ADJUST INPUT. */ NUM_BLANKS=DIVIDE(25-LENGTH(SUB),2,5); IF LENGTH(SUB)<25 THEN SUB=SUBSTR(BLANKS,1,NUM_BLANKS)||SUB; /* PRINT HEADINGS. */ CALL CLRSCRN; CALL PUTMSG(1,15,'* * * CUSTOMER FILE MAINTENANCE * * *'); CALL PUTMSG(2,22,SUB); /* RETURN TO CALLER. */ END PRNT_HDNG; /* * * START OF MAIN PROGRAM * * */ MAIN_MENU: BEGIN; CALL ARM010; /* PRINT MENU */ CALL GETB15(09,23,NRP,0,04,RTN_COD); /* GET FUNCTION 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; /* * * ADD BY ID * * */ MAIN_FUNC(01): BEGIN; /* GET THE KEY FIELD. */ CALL ZERO_MSTR; /* ZERO THE RECORD. */ CALL PRNT_HDNG('***ADD A CUSTOMER***'); CALL PUTMSG(3,1,'ENTER ID:'); CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD); IF REC1.CSID=' ' THEN DO; CALL PUTERR('*** 1)ID IS INVALID OR MISSING. ***'); GOTO ADD_NEXT; END; CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN DO; CALL PUTERR('RECORD ALREADY EXISTS!'); GOTO ADD_NEXT; END; IF RTN_COD=3 THEN /* RECORD DOESN'T EXIST.*/ DO; END; ELSE DO; CALL PUTERR('ADD RETURN CODE ='||RTN_COD||'.'); GOTO ADD_NEXT; END; /* GET EACH FIELD IN THE RECORD. */ CALL PRNT_HDNG('ADDING: '||REC1.CSID); CALL PRNT_MSTR; /* FORMAT THE SCREEN. */ CALL EOL(23,1); /* ERASE CURRENT LINE. */ CALL PUTMSG(23,1,'PLEASE ENTER EACH FIELD AS PROMPTED.'); DO I=1 TO 28; CALL GET_FLD(I); END; CALL UPD_FLDS; /* ADD THE RECORD TO THE FILE. */ CALL BTREE(BT_WRITE,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN DO; CALL PUTERR('RECORD SUCCESSFULLY ADDED'); END; ELSE DO; CALL PUTERR('ADD RETURN CODE ='||RTN_COD||'.'); END; /* EITHER RETURN OR DO ANOTHER RECORD */ ADD_NEXT: CALL EOL(23,1); /* ASK ABOUT ANOTHER ADD */ CALL PUTMSG(23,1,'DO YOU WISH TO ADD ANOTHER N/A (Y/N)? '); CALL GETSTR(23,39,1,ADDR(RP),RTN_COD); IF RP~='N' THEN GOTO MAIN_FUNC(01); GOTO MAIN_MENU; END; /* * * UPDATE BY ID * * */ MAIN_FUNC(02): BEGIN; /* GET THE RECORD TO BE UPDATED */ CALL PRNT_HDNG('***UPDATE A CUSTOMER***'); CALL PUTMSG(3,1,'ENTER ID:'); CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD); IF REC1.CSID=' ' THEN DO; CALL PUTERR('*** 1)ID IS INVALID OR MISSING. ***'); GOTO UPD_NEXT; END; CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN DO; END; ELSE DO; CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.'); GOTO UPD_NEXT; END; /* UPDATE THE FIELDS IN THIS RECORD */ CALL PRNT_HDNG('UPDATING: '||REC1.CSID); CALL PRNT_MSTR; /* FORMAT THE SCREEN. */ CALL UPD_FLDS; /* UPDATE THE RECORD. */ CALL BTREE(BT_UPDATE,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN DO; CALL PUTERR('RECORD SUCCESSFULLY UPDATED.'); END; ELSE DO; CALL PUTERR('UPDATE RETURN CODE ='||RTN_COD||'.'); END; /* EITHER RETURN OR DO ANOTHER RECORD. */ UPD_NEXT: CALL EOL(23,1); /* ASK ABOUT ANOTHER ADD */ CALL PUTMSG(23,1,'DO YOU WISH TO UPDATE ANOTHER N/A (Y/N)? '); CALL GETSTR(23,42,1,ADDR(RP),RTN_COD); IF RP~='N' THEN GOTO MAIN_FUNC(02); GOTO MAIN_MENU; END; /* * * DELETE BY ID * * */ MAIN_FUNC(03): BEGIN; /* GET THE RECORD. */ CALL PRNT_HDNG('***DELETE A CUSTOMER***'); CALL PUTMSG(3,1,'ENTER ID:'); CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD); CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN DO; END; ELSE DO; CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.'); GOTO DELT_NEXT; END; /* DISPLAY THE RECORD. */ CALL PRNT_HDNG('DELETING: '||REC1.CSID); CALL PRNT_MSTR; /* FORMAT THE SCREEN. */ /* ISSUE THE DELETE TO MDBS. */ CALL PUTMSG(23,1,'DO YOU REALLY WANT TO DELETE THIS(Y/N)? '); CALL GETSTR(23,41,1,ADDR(RP),RTN_COD); IF RP~='Y' THEN GOTO DELT_NEXT; CALL BTREE(BT_DELETE,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN DO; CALL PUTERR('DELETE WAS SUCCESSFUL.'); END; ELSE DO; CALL PUTERR('DELETE RETURN CODE ='||RTN_COD||'.'); END; /* EITHER RETURN OR DO ANOTHER RECORD. */ DELT_NEXT: CALL EOL(23,1); /* ASK ABOUT ANOTHER ADD */ CALL PUTMSG(23,1,'DO YOU WISH TO DELETE ANOTHER N/A (Y/N)? '); CALL GETSTR(23,42,1,ADDR(RP),RTN_COD); IF RP~='N' THEN GOTO MAIN_FUNC(03); GOTO MAIN_MENU; END; /* * * DISPLAY BY ID * * */ MAIN_FUNC(04): BEGIN; /* GET THE RECORD TO BE DISPLAYED. */ CALL PRNT_HDNG('***DISPLAY A CUSTOMER***'); CALL PUTMSG(3,1,'ENTER ID:'); CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD); CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD); IF RTN_COD=0 THEN DO; END; ELSE DO; CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.'); GOTO DSPL_NEXT; END; /* DISPLAY THE RECORD. */ CALL PRNT_HDNG('DISPLAYING: '||REC1.CSID); CALL PRNT_MSTR; /* FORMAT THE SCREEN. */ /* EITHER RETURN OR DO ANOTHER RECORD. */ DSPL_NEXT: CALL EOL(23,1); /* ASK ABOUT ANOTHER ADD */ CALL PUTMSG(23,1,'DO YOU WISH TO DISPLAY ANOTHER N/A (Y/N)? '); CALL GETSTR(23,42,1,ADDR(RP),RTN_COD); IF RP~='N' THEN GOTO MAIN_FUNC(04); GOTO MAIN_MENU; END; END ARP010;