|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 79711 (0x1375f)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »CHKADJ_S«
└─⟦415b26bc8⟧ Bits:30008568 DDMQ1-0003_Source_For_Q1_Payroll_Package_Diskette_1_1
└─⟦this⟧ »CHKADJ_S«
/* COMMON DECLARES - EMPPGM_A & EMPPGM_B & CHK_ADJ Pgms 4/27/78 */
PUT FILE(D) SKIP EDIT('EMPLOYEE FILE MAINTENANCE - ')(A)
('Version : 2.0')(A(47));
DCL DEDUCTNS FILE;
DCL EMPLOYEE FILE;
DCL DISP_F FIXED(1);
DCL D_FLAG BINARY;
DCL D_RATE FIXED(7,2);
DCL DFT(16) FIXED(7,2);
DCL PAY_DESCR(2) CHAR(8) INIT('HOURLY','SALARIED');
DCL DEDNT FIXED(9,2);
DCL L_FLAG CHAR(1);
DCL WHICH(2) CHAR(16) INIT(' YEAR to DATE ',' QUARTR to DATE ');
DCL WHICH_P(4) CHAR(11) INIT('MONTHLY','SemiMONTHLY','BiWEEKLY','WEEKLY');
DCL WHICH_C(2) CHAR(11) INIT('HourlyWAGE:','WeeklyRATE:');
DCL T_FLAG BINARY INIT(0);
DCL ANS CHAR(1);
DCL ANS2 CHAR(2);
DCL ANS3 CHAR(3);
DCL ANS4 CHAR(4);
DCL ANS8 CHAR(8);
DCL ANS9 CHAR(9);
DCL DATE CHAR(6);
DCL STATUS CHAR(7);
DCL MARYTAL(2) CHAR(10) INIT('SINGLE','MARRIED');
DCL DEDN FIXED(6,2); /* Change This? */
DCL NUM BINARY;
DCL PAYSTATUS CHAR(8);
DCL T_CODE CHAR(1);
DCL T# CHAR(10);
DCL ENUM FIXED(4);
DCL NUM8 CHAR(8);
DCL NUM9 CHAR(9);
DCL 1 DEDCTION(8),
2 DEF CHAR(10),
2 AF FIXED(7,2),
2 FF BINARY, /* 0-No Participation */
2 PFP FIXED(4,2), /* 11-14 % Dn w/F: 1-4 */
2 MXF FIXED(7,2), /* 1-Monthly Deduction */
2 TF FIXED(9,2); /* 2-SemiMonthly Dedn */
DCL 1 BUFF, /* 3-BiWeekly Deductn */
2 DE CHAR(10), /* 4-Weekly Deduction */
2 ADM FIXED(7,2), /* 7-Maximum Attained */
2 F BINARY,
2 PF_P FIXED(4,2),
2 MX FIXED(7,2),
2 T FIXED(9,2);
DCL 1 IBUFF,
2 BV FIXED(4,1),
2 BS FIXED(4,1),
2 BR1 FIXED(8,2),
2 BR2 FIXED(8,2),
2 BR3 FIXED(8,2),
2 BR4 FIXED(8,2),
2 BR7 FIXED(8,2), /* This was added later & must */
2 BR5 FIXED(8,2), /* Presently remain in this sequence */
2 BR6 FIXED(8,2),
2 BST1 FIXED(8,2),
2 BST2 FIXED(8,2),
2 BST3 FIXED(8,2),
2 BST4 FIXED(8,2);
DCL 1 DBUFF,
2 DF BINARY,
2 CN BINARY INIT(0),
2 XD BINARY INIT(0),
2 AN FIXED(7,2),
2 PP FIXED(4,2),
2 MA FIXED(7,2),
2 CU FIXED(7,2);
/* *** This Record Length 660 Bytes, 2 Recs @ 330 Bytes Each *** */
DCL 1 EMPLOYE,
2 SORT_DEPT FIXED(3),
2 G_INFO,
3 LASTNAME CHAR(14),
3 OTH_R,
4 FIRST CHAR(10),
4 MI CHAR(1),
3 RECNO FIXED(1),
3 E# FIXED(4),
3 SOC_SEC#,
4 S_3 FIXED(3),
4 S_2 FIXED(2),
4 S_4 FIXED(4),
3 BIRTHDATE,
4 B_MONTH FIXED(2),
4 B_DAY FIXED(2),
4 B_YEAR FIXED(2),
3 SEX CHAR(1),
3 ADDRESS CHAR(18),
3 CITY CHAR(16),
3 STATE CHAR(2),
3 ZIPCODE FIXED(5),
3 TEL#,
4 AC FIXED(3),
4 T_3 FIXED(3),
4 T_4 FIXED(4),
2 JOB_INFO,
3 GL_CODE,
4 DEPT FIXED(3),
4 ACOUNT# FIXED(5),
3 STARTDATE,
4 S_MONTH FIXED(2),
4 S_DAY FIXED(2),
4 S_YEAR FIXED(2),
3 PAYCODE BINARY, /* 1-Salaried ¬1-Hourly */
3 RATE FIXED(7,2), /* Maximum Weekly of $99,999.99 */
3 P_FREQ BINARY, /* 1-Monthly 2-SemiMonthly 3-BiWkly 4-Wkly */
3 #RG_HRSWK FIXED(4,2),
3 OT_RATE FIXED(3,2),
2 TAX_INFO,
3 MARITAL BINARY, /* 1 - SINGLE , 2 - MARRIED */
3 FED_EXEM BINARY,
3 STATE_EX BINARY,
3 CITY_EXEM BINARY,
3 S_TXBL BINARY, /* Sickpay 1-SUI Taxable */
2 LAST_CHECK, /* 2-FICA Taxable */
3 #REG_HRS FIXED(5,2), /* 3-BOTH Taxable */
3 SICK FIXED(5,2),
3 VAC FIXED(5,2),
3 OT_HRS FIXED(5,2), /* 0-NEITHER Txbl */
3 SICKPAY FIXED(7,2),
3 REG_EARN FIXED(7,2),
3 OT_EARN FIXED(7,2),
3 OTHER_ERN FIXED(7,2), /* Other Earnings-Taxable */
3 OTHER_NTX FIXED(7,2), /* Other Earnings-NonTxbl */
3 CHECK,
4 CHECK# FIXED(5),
4 P_DATE,
5 P_MONTH FIXED(2),
5 P_DAY FIXED(2),
5 P_YEAR FIXED(2),
4 NET FIXED(7,2),
3 TXBL_GR FIXED(7,2),
3 TOT_EARN FIXED(7,2),
3 DEDNS(8) FIXED(7,2),
3 FED_TX FIXED(7,2),
3 FICA FIXED(5,2),
3 ST_TAX FIXED(6,2),
3 CITY_TX FIXED(6,2),
3 UNEMPL_TX FIXED(6,2),
3 DDQ(8) FIXED(7,2),
3 DDY(8) FIXED(7,2),
2 I_CODE BINARY, /* Stores E# of Terminated Employees */
2 I_DATE,
3 I_MONTH FIXED(2),
3 I_DAY FIXED(2),
3 I_YEAR FIXED(2),
2 OLD_FLAG CHAR(1), /* Zero - Check is to be Printed */
2 SPECIAL_TAX_INFO, /* ¬Zero - Check Not to be Printed */
3 FED_PLUG FIXED(7,2),
3 FTABLE_FLAG CHAR(1),
3 STATE_PLUG FIXED(7,2),
3 STABLE_FLAG CHAR(1),
3 CITY_PLUG FIXED(7,2),
3 CTABLE_FLAG CHAR(1),
2 CHECK_FLAG CHAR(1),
2 FILLER CHAR(22);
DCL 1 EMPLOYEB,
2 SORT_D_B FIXED(3),
2 SORT_LN CHAR(14),
2 SORT_FN CHAR(10),
2 SORT_MI CHAR(1),
2 RECNO_B FIXED(1),
2 B# FIXED(4),
2 DEDUCTIONS(8),
3 D_FREQ BINARY,
3 COUNTER BINARY,
3 XDAYS BINARY,
3 AMOUNT FIXED(7,2),
3 PF_PCT FIXED(4,2),
3 MAX_AMT FIXED(7,2),
3 CURRENT FIXED(7,2),
2 INFO(2), /* 1-YTD, 2-QTD */
3 VAC_HRS FIXED(4,1),
3 SICK_HRS FIXED(4,1),
3 REG$ FIXED(8,2),
3 OT$ FIXED(8,2),
3 SICK$ FIXED(8,2),
3 OTHER$ FIXED(8,2),
3 OTHERNTX$ FIXED(8,2),
3 GROSS$ FIXED(8,2),
3 FEDTAX FIXED(8,2),
3 FICATX FIXED(8,2),
3 STATETX FIXED(8,2),
3 CITYTAX FIXED(8,2),
3 UNEMPLYMT FIXED(8,2),
2 FILL CHAR(8);
/************* END of COMMON DECLARES ***************************/
/************* CHECK ADJUSTMENT DECLARES HERE *************/
DCL CONTROL FILE;
DCL 1 CONTROL_REC,
2 LAST_CHECK_NO FIXED(5), /* Next Avail Check # */
2 LAST_CHECK_DATE CHAR(6),
2 CONTROL_FILL CHAR(31);
DCL TOT_BUFF FIXED(7,2);
DCL 1 CHECKBUFF,
2 OLD_REG_HRS FIXED(5,2),
2 OLD_SICK_HRS FIXED(5,2),
2 OLD_VAC_HRS FIXED(5,2),
2 OLD_OT_HRS FIXED(5,2),
2 OLD_SICKPAY FIXED(7,2),
2 OLD_REGPAY FIXED(7,2),
2 OLD_OT_PAY FIXED(7,2),
2 OLD_OPAY_TXBL FIXED(7,2),
2 OLD_OPAY_NTX FIXED(7,2),
2 OLD_CHECK,
3 OLD_NUMBER FIXED(5),
3 OLD_DATE,
4 OLD_MONTH FIXED(2),
4 OLD_DAY FIXED(2),
4 OLD_YEAR FIXED(2),
3 OLD_NET FIXED(7,2),
2 OLD_GROSS_TXBL FIXED(7,2),
2 OLD_TOT_EARN FIXED(7,2),
2 OLD_DEDNS(8) FIXED(7,2),
2 OLD_FEDTX FIXED(7,2),
2 OLD_FICA FIXED(5,2),
2 OLD_ST_TAX FIXED(6,2),
2 OLD_CITY_TX FIXED(6,2),
2 OLD_SUI FIXED(6,2),
2 OLD_DDNQ(8) FIXED(7,2),
2 OLD_DDNY(8) FIXED(7,2);
/*************** CHECK Adjustment Procedures HERE ***************/
RE_WRITE:PROC;
UNSPEC(EMPLOYEE) = UNSPEC(EMPLOYEE) - 2;
WRITE FILE(EMPLOYEE) FROM(EMPLOYE);
WRITE FILE(EMPLOYEE) FROM(EMPLOYEB);
RETURN;
END;
/* Reverse Check Amounts Procedure HERE */
REVERSE_CHECK:PROC;
IF (CHECK_FLAG = '9') THEN GOTO REV_RETURN; /* Already Rev'd */
IF (CHECK_FLAG = '5') THEN DO;
CHECK_FLAG = '9';
GOTO REV_RETURN;
END;
DO I = 1 TO 8;
BUFF = DEDCTION(I);
DBUFF = DEDUCTIONS(I);
CU = CU - OLD_DEDNS(I);
T = T - OLD_DEDNS(I);
DEDUCTIONS(I) = DBUFF;
DEDCTION(I) = BUFF;
DDQ(I) = DDQ(I) - OLD_DEDNS(I);
DDY(I) = DDY(I) - OLD_DEDNS(I);
END;
OPEN DEDUCTNS;
WRITE FILE(DEDUCTNS) FROM(DEDCTION);
DO I = 1 TO 2;
IBUFF = INFO(I);
BV = BV - OLD_VAC_HRS;
BS = BS - OLD_SICK_HRS;
BR1 = BR1 - OLD_REGPAY;
BR2 = BR2 - OLD_OT_PAY;
BR3 = BR3 - OLD_SICKPAY;
BR4 = BR4 - OLD_OPAY_TXBL;
BR7 = BR7 - OLD_OPAY_NTX;
BR5 = BR5 - OLD_TOT_EARN;
BR6 = BR6 - OLD_FEDTX;
BST1 = BST1 - OLD_FICA;
BST2 = BST2 - OLD_ST_TAX;
BST3 = BST3 - OLD_CITY_TX;
BST4 = BST4 - OLD_SUI;
INFO(I) = IBUFF;
END;
REV_RETURN:
RETURN;
END;
/********* ZERO-OUT Checkvalues for Reversed Check *********/
ZERO_OLD:PROC;
#REG_HRS = 0;
SICK = 0;
VAC = 0;
OT_HRS = 0;
SICKPAY = 0;
REG_EARN = 0;
OT_EARN = 0;
OTHER_ERN = 0;
OTHER_NTX = 0;
TXBL_GR = 0;
TOT_EARN = 0;
DO I = 1 TO 8;
DEDNS(I) = 0;
END;
FED_TX = 0;
FICA = 0;
ST_TAX = 0;
CITY_TX = 0;
UNEMPL_TX = 0;
RETURN;
END;
/********** Check CHECK Amounts Relationships HERE *********/
CHECK_RELATIONS:PROC;
D_RATE = TOT_EARN - FED_TX - FICA - ST_TAX - CITY_TX - UNEMPL_TX;
IF (D_RATE < 0) THEN GOTO RMSG_1;
DO I = 1 TO 8;
D_RATE = D_RATE - DEDNS(I);
IF (D_RATE < 0) THEN GOTO RMSG_2;
END;
IF (NET > D_RATE + .1) ö (NET < D_RATE - .1) THEN GOTO RMSG_3;
TOT_BUFF = ((SICK + #REG_HRS + (OT_HRS * OT_RATE)) * D_RATE) + .005;
TOT_BUFF = TOT_BUFF + OTHER_ERN + OTHER_NTX;
IF (TOT_BUFF > TOT_EARN + .1) ö (TOT_BUFF < TOT_EARN - .1) THEN DO;
/* *** Allow Operator to Accept New Value IFF KKEY ¬= 5 Here *** */
GOTO RMSG_6;
END;
GOTO R_RETURN;
/* AND WHAT OF the Following Relation : TOT_EARN = */
/* ((SICK + #REG_HRS + OT_HRS * OT_RATE) * D_RATE) + .005 */
/* + OTHER_ERN + OTHER_NTX; ??? Here D_RATE = Appropriate RATE */
RMSG_1:
PUT FILE(D) SKIP EDIT('GROSS Amount Entered, less Tax Amounts')
(A(47))('Entered, leaves a computed value for')(A(47))
('Net of -')(A(8))(D_RATE)(P'$$$$9V.99');
IF (KKEY = 5) THEN NET = D_RATE;
GET SKIP LIST('');
GOTO RMSG_4;
RMSG_2:
PUT FILE(D) SKIP EDIT('GROSS Amount entered, less Tax amounts')
(A(47))('and Deductions, leaves a Computed Value')(A(47))
('for NET of : -')(A(14))(D_RATE)(P'$$$$9V.99');
IF (KKEY = 5) THEN NET = D_RATE;
GET SKIP LIST('');
GOTO RMSG_4;
RMSG_3:
PUT FILE(D) SKIP EDIT('GROSS less Taxes and Deductions is')
(A(47))('NOT Within 10┣1f┫ of NET value entered-')(A(47))
('Computed NET :')(A(14))(D_RATE)(P'$$$$9V.99')
('NET Inputted :')(A(14))(NET)(P'$$$$9V.99');
IF (KKEY = 5) THEN NET = D_RATE;
GET SKIP LIST('');
GOTO RMSG_4;
RMSG_4:
IF (KKEY = 5) THEN GOTO RMSG_5;
KKEY = 4;
PUT FILE(D) SKIP EDIT('These Check Values will NOT be entered')
(A(47))('In your Employee"s Record. Please')(A(47))
('Investigate, and try again ')(A);
GET SKIP LIST('');
GOTO R_RETURN;
RMSG_5:
PUT FILE(D) SKIP EDIT('These Values will be Incremented to BOTH')
(A(47))('Your EMPLOYEE File & DEDUCTIONS File')
(A(47))('in "Current Totals" fields. Please')(A(47))
('Investigate (Or at least record) this')(A(47))
('Discrepancy, and Correct all Affected Fields')(A(47));
GET SKIP LIST(''); GOTO R_RETURN;
RMSG_6:
PUT FILE(D) SKIP EDIT('Gross Amt Entered ')(A(18))
(TOT_EARN)(P'$$$$9V.99')(' is NOT within 10┣1f┫')(A(21))
('Of amount computed on basis of #Hrs ')(A(47))
('Entered :')(A(9))(TOT_BUFF)(P'$$$$9V.99')
('for Employee#: ')(A)(E#)(P'ZZZ9');
IF (KKEY = 5) THEN TOT_EARN = TOT_BUFF;
GET SKIP LIST('');
GOTO RMSG_4;
R_RETURN:
RETURN;
END;
/*********** CHECK INCREMENT ROUTINE HERE ************/
INCREMENT_CHECK:PROC;
DO I = 1 TO 8;
BUFF = DEDCTION(I);
DBUFF = DEDUCTIONS(I);
IF ((CU + DEDNS(I)) > MA) & (KKEY ¬= 5) THEN DO;
PUT FILE(D) SKIP EDIT('Employee# :')(A(11))(E#)
(P'ZZZ9')(FIRST)(X(5),A(11))(MI)(A(2))(LASTNAME)
(A(14))('Entry of ')(A(9))(DEDNS(I))(P'$$$$9V.99')
(' for ')(A(5))(DE)(A(11))('Puts')(A(14))
('Employee Current Total over Maximum specified')
(A(47))('in Employee Record. Program Therefore')
(A(47))('Overrides your entry-New Value:')(A(31));
NET = NET + (DEDNS(I) - (MA - CU));
DEDNS(I) = MA - CU;
IF (DEDNS(I) < 0) THEN DEDNS(I) = 0;
PUT FILE(D) EDIT(DEDNS(I))(P'$$$$9V.99');
GET SKIP LIST('');
END;
CU = CU + DEDNS(I);
DEDUCTIONS(I) = DBUFF;
T = T + DEDNS(I);
DEDCTION(I) = BUFF;
DDQ(I) = DDQ(I) + DEDNS(I);
DDY(I) = DDY(I) + DEDNS(I);
END;
OPEN DEDUCTNS;
WRITE FILE(DEDUCTNS) FROM(DEDCTION);
D_RATE = RATE;
IF (#RG_HRSWK = 0) THEN #RG_HRSWK = 40;
IF (PAYCODE = 1) THEN D_RATE = (RATE / #RG_HRSWK);
SICKPAY = D_RATE * SICK + .005;
REG_EARN = D_RATE * #REG_HRS + .005;
OT_EARN = D_RATE * (OT_HRS * OT_RATE) + .005;
TOT_EARN = TXBL_GR + SICKPAY + OTHER_NTX;
DO I = 1 TO 2;
IBUFF = INFO(I);
BV = BV + VAC;
BS = BS + SICK;
BR1 = BR1 + REG_EARN;
BR2 = BR2 + OT_EARN;
BR3 = BR3 + SICKPAY;
BR4 = BR4 + OTHER_ERN;
BR7 = BR7 + OTHER_NTX;
BR5 = BR5 + TOT_EARN;
BR6 = BR6 + FED_TX;
BST1 = BST1 + FICA;
BST2 = BST2 + ST_TAX;
BST3 = BST3 + CITY_TX;
BST4 = BST4 + UNEMPL_TX;
INFO(I) = IBUFF;
END;
RETURN;
END;
/* LAST CHECK View / Modify MODULE */
LAST_CHECK_AMOUNTS:PROC;
/* CALL READ_E; */
JJ = 0;
JJJ = 0;
C_DISPLAY1:
DISP_F = 1;
J = 0;
PUT FILE(D) SKIP EDIT('View / Modify - EMPLOYEE #')(A(26))
(E#)(P'Z999')(' - ')(A(3))(LASTNAME)(A(14))
('LAST CHECK Display 1 Of 2')(X(11),A(36))(' ')(A(47));
J = J + 1;
PUT FILE(D) EDIT(J)(P'Z9')(')CHK#:')(A(6));
ANS = KKEY;
IF (J = JJ) & (VERIFY(ANS,'3567') = 0) THEN DO;
/************* HERE J = JJ & This is NOT an OffSystem Check *************/
IF (CHECK_FLAG = '0') THEN DO;
PUT FILE(D) SKIP EDIT('CHECK#:')(A(7))(CHECK#)(P'99999')
(',Not Having Been Printed,')(A(35))
('Should be Safely Avail For Use- However')(A(47))
('If You Prefer a New Number, the Next Avail')(A(47))
(' Number is:')(A(11))(LAST_CHECK_NO)(P'99999')
('. Indicate Choice- Enter')(A(32))
('"1" To keep current check number, or')(A(47))
('"2" To change it to:')(A)(LAST_CHECK_NO)(P'99999')
(' ')(A(12))('ENTER CHOICE : ')(X(14),A);
DC_R: GET SKIP LIST(ANS);
IF (VERIFY(ANS,'12') = 0) THEN GOTO DC_R;
IF (ANS = '1') THEN GOTO DO_X;
CHECK# = LAST_CHECK_NO;
LAST_CHECK_NO = LAST_CHECK_NO + 1;
REWRITE FILE(CONTROL) FROM(CONTROL_REC);
GOTO DO_X;
END;
/* HERE (CHECK_FLAG ¬= 0) & (J = JJ) & This is NOT an OffSystem Check */
IF (CHECK_FLAG = '1') THEN DO;
PUT FILE(D) SKIP EDIT('Check that Check#:')(A(18))
(CHECK#)(P'99999')(' has been VOIDED')(A(24))
('and Keyed Off. Your new Check# is:')(A(34))
(LAST_CHECK_NO)(P'99999');
CHECK# = LAST_CHECK_NO;
LAST_CHECK_NO = LAST_CHECK_NO + 1;
REWRITE FILE(CONTROL) FROM(CONTROL_REC);
GET SKIP LIST('');
GOTO DO_X;
END;
END;
/* *** HERE- ((J = JJ) & (This NOT OffSystem Check)) is FALSE *** */
IF (J = JJ) ö (KKEY = 7) THEN DO;
GET SKIP LIST(CHECK#);
IF (CHECK# > LAST_CHECK_NO) THEN DO;
PUT FILE(D) SKIP EDIT('Check Number(s) Between')(A(24))
(LAST_CHECK_NO - 1)(P'99999')(' and ')(A(5))
(CHECK#)(P'99999')(' ')(A(8))('Are Being Skipped. ')
(A(19))('PLEASE NOTE for your Records')(A(28));
LAST_CHECK_NO = CHECK# + 1;
REWRITE FILE(CONTROL) FROM(CONTROL_REC);
GET SKIP LIST('');
GOTO DO_X;
END;
IF (CHECK# < LAST_CHECK_NO) THEN DO;
PUT FILE(D) SKIP EDIT('WARNING- Next Avail Check Number')
(A(47))('According to Your CONTROL File, is ')(A(35))
(LAST_CHECK_NO)(P'99999')(' ')(A(7))('And you have')
(A(13))('entered ')(A(8))(CHECK#)(P'99999')
(' for this check.')(A(21))('This may mean duplicate')
(A(24))('Check #s were issued')(A(25));
GET SKIP LIST('');
GOTO DO_X;
END;
/************* HERE - CHECK# = LAST_CHECK_NO **************/
LAST_CHECK_NO = LAST_CHECK_NO + 1;
REWRITE FILE(CONTROL) FROM(CONTROL_REC);
END;
/************************************* HERE- (J ¬= JJ) ********/
IF (CHECK_FLAG = '5') ö (CHECK_FLAG = '9') THEN DO;
CHECK# = LAST_CHECK_NO;
LAST_CHECK_NO = LAST_CHECK_NO + 1;
REWRITE FILE(CONTROL) FROM(CONTROL_REC);
CHECK_FLAG = '0';
END;
GOTO DO_Y;
DO_X:
IF (KKEY = 7) THEN KKEY = 8;
JJ = 27;
GOTO C_DISPLAY1;
DO_Y: J = J + 1;
IF (KKEY = 8) THEN KKEY = 7;
PUT FILE(D) EDIT(CHECK#)(P'ZZZZ9')(J)(P'Z9')(')CHKDATE:')(A(9));
IF (J = JJ) ö (KKEY = 7) THEN DO;
LRE: GET SKIP LIST(DATE);
IF (VERIFY(DATE,'0123456789') = 0) THEN GOTO LRE;
P_MONTH = SUBSTR(DATE,1,2);
P_DAY = SUBSTR(DATE,3,2);
P_YEAR = SUBSTR(DATE,5,2);
END;
J = J + 1;
PUT FILE(D) EDIT(P_MONTH)(P'99')('/')(A)(P_DAY)(P'99')
('/')(A)(P_YEAR)(P'99')(J)(P'Z9')(')AMT:')(A(5));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(NET);
J = J + 1;
PUT FILE(D) EDIT(NET)(P'$$$$9V.99')('#HOURS-')(A(7))
(J)(P'Z9')(')REG :')(A(6));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(#REG_HRS);
J = J + 1;
PUT FILE(D) EDIT(#REG_HRS)(P'ZZ9V.99')(J)(P'Z9')(')O/T:')(A(5));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(OT_HRS);
J = J + 1;
PUT FILE(D) EDIT(OT_HRS)(P'ZZ9V.99')(J)(P'Z9')(')VAC:')(A(5));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(VAC);
J = J + 1;
PUT FILE(D) EDIT(VAC)(P'ZZ9V.99')(' ')(A(7))
(J)(P'Z9')(')SICK:')(A(6));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(SICK);
J = J + 1;
PUT FILE(D) EDIT(SICK)(P'ZZ9V.99')(' ')(A(6))
(J)(P'Z9')(')GrossPay:')(A(10));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(TOT_EARN);
J = J + 1;
PUT FILE(D) EDIT(TOT_EARN)(P'$$$$9V.99')('OTHER PAY-')(A(10))
(J)(P'Z9')(')TXBL:')(A(6));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(OTHER_ERN);
J = J + 1;
PUT FILE(D) EDIT(OTHER_ERN)(P'$$$$9V.99')(' ')(A)
(J)(P'Z9')(')Non-TXBL:')(A(10));
IF (J = JJ) ö (KKEY = 7) THEN GET SKIP LIST(OTHER_NTX);
PUT FILE(D) EDIT(OTHER_NTX)(P'$$$$9V.99')('OK ? ')(A);
GOTO C_ASK_1_2;
C_DISPLAY2:
DISP_F = 2;
J = 0;
PUT FILE(D) SKIP EDIT('View / Modify - EMPLOYEE #')(A(26))
(E#)(P'Z999')(' - ')(A(3))(LASTNAME)(A(14))
('LAST CHECK Display 2 Of 2')(X(11),A(36));
J = J + 1;
PUT FILE(D) EDIT('Deduction Amounts')(A(17))(J)(P'Z9')
(')1-')(A(3));
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(DEDNS(J));
J = J + 1;
PUT FILE(D) EDIT(DEDNS(J - 1))(P'$$$$9V.99')(' ')(A(4))
(J)(P'Z9')(')2-')(A(3));
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(DEDNS(J));
J = J + 1;
PUT FILE(D) EDIT(DEDNS(J - 1))(P'$$$$9V.99');
DO I = 1 TO 2;
PUT FILE(D) EDIT(J)(P'Z9')(')')(A)(J)(P'9')('-')(A);
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(DEDNS(J));
J = J + 1;
PUT FILE(D) EDIT(DEDNS(J - 1))(P'$$$$9V.99')(' ')(A(4))
(J)(P'Z9')(')')(A)(J)(P'9')('-')(A);
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(DEDNS(J));
J = J + 1;
PUT FILE(D) EDIT(DEDNS(J - 1))(P'$$$$9V.99')(' ')(A(4))
(J)(P'Z9')(')')(A)(J)(P'9')('-')(A);
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(DEDNS(J));
J = J + 1;
PUT FILE(D) EDIT(DEDNS(J - 1))(P'$$$$9V.99');
END;
PUT FILE(D) EDIT('TAX AMTS-')(A(9))(J)(P'Z9')(')FEDERAL:')(A(9));
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(FED_TX);
J = J + 1;
PUT FILE(D) EDIT(FED_TX)(P'$$$$9V.99')(' ')(A)
(J)(P'ZZ9')(')STATE:')(A(7));
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(ST_TAX);
J = J + 1;
PUT FILE(D) EDIT(ST_TAX)(P'$$$$9V.99')(J)(P'Z9')(')CITY:')(A(6));
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(CITY_TX);
J = J + 1;
PUT FILE(D) EDIT(CITY_TX)(P'$$$9V.99')(J)(P'ZZ9')(')SUI:')(A(5));
IF (J = JJ) ö (KKEY = 6) THEN DO;
UR: GET SKIP LIST(ANS8);
ANS = SUBSTR(ANS8,1,1);
IF (ANS = ' ') THEN GOTO UNC;
IF (ANS = 'X') ö (ANS = 'N') THEN DO;
S_TXBL = 5;
GOTO UNC;
END;
IF (VERIFY(ANS,'.0123456789') = 0) THEN GOTO UR;
UNEMPL_TX = SUBSTR(ANS8,1,7);
S_TXBL = 0;
END;
UNC: IF (S_TXBL = 5) THEN DO;
IF (UNEMPL_TX > 0) THEN PUT FILE(D) EDIT('X')(A)
(UNEMPL_TX)(P'$$9V.99');
IF (UNEMPL_TX = 0) THEN PUT FILE(D) EDIT(' *NONE*')(A);
END;
IF (S_TXBL = 0) THEN PUT FILE(D) EDIT(UNEMPL_TX)(P'$$$9V.99');
J = J + 1;
PUT FILE(D) EDIT(J)(P'ZZ9')(')FICA:')(A(6));
IF (J = JJ) ö (KKEY = 6) THEN GET SKIP LIST(FICA);
PUT FILE(D) EDIT(FICA)(P'$$$$9V.99')('OK ? ')(A);
GOTO C_ASK_1_2;
C_ASK_1_2:
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') & (KKEY = 7) & (DISP_F = 1) THEN KKEY = 6;
IF (ANS = 'Y') & (KKEY = 6) & (DISP_F = 2) THEN KKEY = 3;
IF (ANS = 'N') THEN GOTO GET_C_CHANGES;
IF (VERIFY(ANS,'0123456789') = 0) THEN GOTO C12;
GOTO C_ASK_1_2;
C12: IF (ANS = 'E') ö (ANS = 'Y') THEN GOTO C_REWRITE;
IF (JJ > 0) & (ANS ¬= 'Y') THEN GOTO C_ASK_1_2;
IF (JJ > 0) THEN JJJ = 1;
JJ = 0;
IF (DISP_F = 2) THEN GOTO C_DISPLAY1;
GOTO C_DISPLAY2;
GET_C_CHANGES:
IF (KKEY = 5) & (DISP_F = 1) THEN DO;
KKEY = 7;
GOTO C_DISPLAY1;
END;
IF (KKEY = 5) & (DISP_F = 2) THEN DO;
KKEY = 6;
GOTO C_DISPLAY2;
END;
IF (KKEY = 6) & (DISP_F = 2) THEN KKEY = 3;
IF (KKEY = 7) & (DISP_F = 1) THEN KKEY = 6;
PUT FILE(D) EDIT('ENTER # of ITEM TO BE CHANGED : ')(A);
CC_RE: GET SKIP LIST(ANS2);
ANS = SUBSTR(ANS2,1,1);
IF (ANS = '0') ö (ANS = 'E') THEN DO;
IF (DISP_F = 1) THEN GOTO C_DISPLAY1;
GOTO C_DISPLAY2;
END;
IF (VERIFY(ANS2,' 0123456789') = 0) THEN GOTO CC_RE;
JJ = ANS2;
IF (JJ > J) THEN DO;
JJ = 0;
GOTO CC_RE;
END;
IF (DISP_F = 2) THEN GOTO CR_10;
J = 0;
GOTO C_DISPLAY1;
CR_10: J = 0;
GOTO C_DISPLAY2;
C_REWRITE:
IF (JJ ¬= 0) THEN GOTO CJ_NOT_0;
IF (ANS = 'E') THEN GOTO C_END;
GOTO C_RETURN;
CJ_NOT_0:
JJ = 0;
JJJ = 1;
C_RETURN:
IF (DISP_F = 2) THEN GOTO C_R2;
J = 0;
IF (ANS = 'E') THEN GOTO C_END;
GOTO C_DISPLAY2;
C_R2: J = 0;
IF (ANS = 'E') THEN GOTO C_END;
GOTO C_DISPLAY1;
C_END: IF (JJJ = 0) THEN GOTO C_E;
C_U: CALL RE_WRITE;
C_E: ANS = KKEY;
KKEY = 5;
IF (VERIFY(ANS,'3567') = 0) THEN KKEY = 0;
RETURN;
END;
PRINT_CHECK:PROC;
D_RATE = RATE;
IF (PAYCODE = 1) THEN D_RATE = (RATE / #RG_HRSWK);
PUT SKIP EDIT('CHECK of -Multiple Pay For ')(A)(FIRST)
(A(11))(MI)(A(2))(LASTNAME)(A(15))('Checkdate : ')(A)
(OLD_MONTH)(P'99')('/')(A)(OLD_DAY)(P'99')('/')(A)
(OLD_YEAR)(P'99')(', CHECK#:')(A)(OLD_NUMBER)(P'ZZZZ9');
PUT SKIP EDIT('HOURS- 1)REGULAR :')(A)(OLD_REG_HRS)(P'ZZ9V.99')
(' -PAY :')(A)(OLD_REGPAY)(P'$$$$9V.99')(' ')(A(7))
('2)OVERTIME:')(A)(OLD_OT_HRS)(P'ZZ9V.99')(' -PAY :')(A)
(OLD_OT_PAY)(P'$$$$9V.99');
PUT SKIP EDIT(' ')(A(7))('3)SICK :')(A)(OLD_SICK_HRS)
(P'ZZ9V.99')(' -PAY :')(A)(OLD_SICKPAY)(P'$$$$9V.99')
(' ')(A(7))('4)VACATION:')(A)(OLD_VAC_HRS)(P'ZZ9V.99')
(' -PAY :')(A)((OLD_VAC_HRS * D_RATE) + .005)(P'$$$$9V.99');
PUT SKIP EDIT('OTHER PAY- 5)Taxable:')(A)(OLD_OPAY_TXBL)
(P'$$$$9V.99')(' 6)NonTxbl:')(A)(OLD_OPAY_NTX)
(P'$$$$9V.99')(' GROSS Fica/Futa Txbl:')(A)
(OLD_TOT_EARN - OLD_SICKPAY - OLD_OPAY_NTX)(P'$$$$9V.99')
(' GROSS EARNINGS:')(A)(OLD_TOT_EARN)(P'$$$$9V.99');
PUT SKIP EDIT('DEDUCTIONS- ')(A);
J = 0;
D_DO: DO I = 1 TO 4;
PUT EDIT(J + I)(P'9')(')-')(A)(DEDNS(J + I))(P'$$$$9V.99')
(' ')(A);
END;
IF ((J + I) < 6) THEN DO;
PUT SKIP EDIT(' ')(A(12));
J = 4;
GOTO D_DO;
END;
PUT SKIP EDIT('FEDERAL TAX:')(A)(OLD_FEDTX)(P'$$$$9V.99')
(' FICA:')(A)(OLD_FICA)(P'$$9V.99')(' ')(A(3))(STATE)
(A(2))(' State Tax:')(A)(OLD_ST_TAX)(P'$$$9V.99')
(' SUI-SDI:')(A)(OLD_SUI)(P'$$$9V.99');
PUT SKIP(3);
RETURN;
END;
/************ MAIN Routines for Check Adjustment Follow ************/
MAIN_CHECK:PROC;
KKEY = 0;
/* ENUM = E#;
ON ERROR GOTO KEY_MSG;
READ KEY(ENUM) FILE(EMPLOYEE) INTO(EMPLOYE) KEYTO(E#);
READ FILE(EMPLOYEE) INTO(EMPLOYEB); */
IF (B# ¬= E#) THEN GOTO KEY_MSG;
GOTO BEGIN;
KEY_MSG:
PUT FILE(D) SKIP LIST('KEYS DON"T WORK');
GET SKIP LIST('');
GOTO CHECK_RETURN;
BEGIN:
PUT FILE(D) SKIP EDIT(E#)(P'ZZZ9')('Check Adjustment')(X(6),A(16))
(LASTNAME)(X(6),A(15))('DO YOU WANT')(A(15))
('1)ReIssue Current Check')(A(47))('2)Alter & ReIssue Current Check')
(A(47))('3)Reverse Current Check')(A(47))('4)Record OffSystem Check')
(A(49))('ENTER CHOICE : ')(A);
CAR: GET SKIP LIST(ANS);
IF (VERIFY(ANS,'01234E') = 0) THEN GOTO CAR;
IF (ANS = '1') THEN GOTO CHECK1;
IF (ANS = '2') THEN GOTO CHECK2;
IF (ANS = '3') THEN GOTO CHECK3;
IF (ANS = '4') THEN GOTO CHECK4;
GOTO CHECK_RETURN;
CHECK1:
KKEY = 0;
IF (CHECK_FLAG ¬= '1') ö (NET <= 0) THEN GOTO C1_MSG2;
C1_C:
PUT FILE(D) SKIP EDIT('Do You Want To ReIssue All Checks From')
(A(47))('This Employee Onward ? ')(A);
GET SKIP LIST(ANS);
IF (ANS = 'Y') THEN DO;
CHECK_FLAG = '0';
ENUM = E#;
CALL RE_WRITE;
DATE = (P_MONTH) öö (P_DAY) öö(P_YEAR);
FILL = (DATE) öö (' ');
C1_READ:
ON ERROR GOTO C1_RS;
READ KEY('1') FILE(EMPLOYEE) INTO(EMPLOYE) KEYTO(CHECK_FLAG);
DATE = (P_MONTH) öö (P_DAY) öö (P_YEAR);
ANS8 = (DATE) öö (' ');
IF (DATE ¬= FILL) THEN GOTO C1_READ;
/* This Should Effectively Rule Out TERMINATED Employees As Well */
IF (CHECK_FLAG = '9') THEN GOTO C1_READ;
/* 9-Reversed Check 0-To be Printed 1-Printed 5-Not Computed */
IF (SORT_DEPT > SORT_D_B) THEN GOTO C1_RS;
IF (E# = 0) THEN GOTO C1_RS;
CHECK_FLAG = '0';
REWRITE FILE(EMPLOYEE) FROM(EMPLOYE);
GOTO C1_READ;
C1_RS: ON ERROR GOTO C1_MSG;
READ KEY(ENUM) FILE(EMPLOYEE) INTO(EMPLOYE) KEYTO(E#);
READ FILE(EMPLOYEE) INTO(EMPLOYEB);
IF (CHECK_FLAG ¬= '0') THEN GOTO C1_MSG;
GOTO CHECK_MSG;
END;
CHECK_FLAG = '0';
CALL RE_WRITE;
GOTO CHECK_MSG;
C1_MSG:
PUT FILE(D) SKIP EDIT('Problem at C1_RS: ')(A);
GET SKIP LIST('');
GOTO CHECK_MSG;
C1_MSG2:
IF (CHECK_FLAG = '5') THEN DO;
PUT FILE(D) SKIP EDIT('According to Employee Record, There is')
(A(47))('Pay period data awaiting computation-')(A(47))
('Do you mean to reissue the last pay-period"s')(A(47))
('Check before computing current one ? ENTER')(A(47))
('1)To print old check')(A(47))('2)To Exit this Routine')
(A(47))(' ENTER CHOICE : ')(A);
C1_2: GET SKIP LIST(ANS);
IF (VERIFY(ANS,'12') = 0) THEN GOTO C1_2;
IF (ANS = '2') THEN GOTO BEGIN;
IF (ANS = '1') THEN GOTO C1_C;
END;
IF (CHECK_FLAG = '9') THEN DO;
PUT FILE(D) SKIP EDIT('This Employee has no applicable check')
(A(47))('data- His last check is on record as')(A(47))
('having been reversed')(A);
GET SKIP LIST('');
GOTO CHECK_RETURN;
END;
IF (CHECK_FLAG = '0') THEN GOTO CHECK_RETURN;
/* **************************************** HERE- (NET <= 0) ***** */
PUT FILE(D) SKIP EDIT('Sorry, this Employee"s last check NET')
(A(47))('amount is less than or equal to ZERO.')(A(47))
('This program refuses to key such a check')(A(47))
('To be printed.')(A);
GET SKIP LIST('');
GOTO CHECK_RETURN;
CHECK2:
KKEY = 0;
CHECKBUFF = LAST_CHECK;
CALL LAST_CHECK_AMOUNTS;
CALL CHECK_RELATIONS;
IF (KKEY = 4) THEN DO; /* 4-BAD DATA */
KKEY = 0;
LAST_CHECK = CHECKBUFF;
CALL RE_WRITE;
GOTO CHECK_RETURN;
END;
CALL REVERSE_CHECK;
CALL INCREMENT_CHECK;
IF (CHECK_FLAG = '5') ö (CHECK_FLAG = '9') THEN CHECK_FLAG = '0';
IF (CHECK_FLAG ¬= '0') THEN DO;
CHECK_FLAG = '0';
CALL RE_WRITE;
GOTO CHECK_MSG;
END;
CALL RE_WRITE;
GOTO CHECK_RETURN;
CHECK3:
KKEY = 0;
IF (CHECK_FLAG = '9') THEN GOTO CHECK_RETURN;
/********************************************** 9- Already Reversed */
CHECKBUFF = LAST_CHECK;
CALL REVERSE_CHECK;
CALL ZERO_OLD;
IF (CHECK_FLAG ¬= '0') THEN DO;
CHECK_FLAG = '9';
CALL RE_WRITE;
GOTO CHECK_MSG;
END;
PUT FILE(D) SKIP EDIT('CHECK NUMBER ')(A(13))(CHECK#)(P'ZZZZ9')
(' IS BEING SKIPPED-Make Note of This If It Matters ')(A(51))
(' For Your Records')(A);
CHECK_FLAG = '9';
GET SKIP LIST('');
CALL RE_WRITE;
GOTO CHECK_RETURN;
CHECK_MSG:
PUT FILE(D) SKIP EDIT('Be Sure Check Already Issued Is Both')
(A(57))('1)VOIDED and')(A(47))('2)KeyedOff BEFORE ReIssuing')
(A(49))('(Use Check Rec Option)')(A);
GET SKIP LIST('');
GOTO CHECK_RETURN;
CHECK4:
PUT FILE(D) SKIP EDIT('When Last-Check Amounts Display Appears')
(A(47))('Choose To Modify any Field in 1st Display')(A(47))
('& Program will go on to Prompt for Values')(A(47))
('For All Fields In Sequence')(A);
GET SKIP LIST ('');
CHECKBUFF = LAST_CHECK;
KKEY = 5;
CALL LAST_CHECK_AMOUNTS;
CHECK_FLAG = '1'; /* 1- Already Printed */
IF (P_MONTH = OLD_MONTH) & (P_DAY = OLD_DAY) & (P_YEAR = OLD_YEAR)
THEN DO;
PUT FILE(D) SKIP EDIT('Is This Check')(A(47))
('1)Revised Check for ')(A(20))(P_MONTH)(P'Z9')
('/')(A)(P_DAY)(P'Z9')('/')(A)(P_YEAR)(P'Z9')
(' ')(A(19))('2)Additional Check for ')(A(23))
(P_MONTH)(P'Z9')('/')(A)(P_DAY)(P'Z9')('/')(A)
(P_YEAR)(P'Z9')(' ')(A(18))('ENTER CHOICE : ')(A);
C4_RE: GET SKIP LIST(ANS);
IF (VERIFY(ANS,'12') = 0) THEN GOTO C4_RE;
IF (ANS = '1') THEN DO;
CALL REVERSE_CHECK;
CALL INCREMENT_CHECK;
END;
IF (ANS = '2') THEN DO;
PUT FILE(D) SKIP EDIT('Only The Most Recent Check Data Can Be')
(A(47))('Kept On Record For Your Inspection.')(A(47))
('If You Want a Printout Of The Information ')(A(47))
('About To Be Lost, Arrange Paper & Keyin "X"')(A(47));
GET SKIP LIST(ANS);
IF (ANS = 'X') THEN DO;
CALL PRINT_CHECK;
END;
CALL INCREMENT_CHECK;
END;
KKEY = 5;
CALL CHECK_RELATIONS;
KKEY = 0;
CALL RE_WRITE;
GOTO CHECK_RETURN;
END;
KKEY = 5;
CALL INCREMENT_CHECK;
CALL CHECK_RELATIONS;
KKEY = 0;
CALL RE_WRITE;
GOTO CHECK_RETURN;
CHECK_RETURN:
RETURN;
END;
/************ MAIN Part of Check Adjustment Program Follows ************/
ENUM = E#;
OPEN EMPLOYEE;
OPEN DEDUCTNS;
READ FILE(DEDUCTNS) INTO(DEDCTION);
OPEN CONTROL;
READ FILE(CONTROL) INTO(CONTROL_REC);
ON ERROR GOTO MAIN_MSG;
READ KEY(ENUM) FILE(EMPLOYEE) INTO(EMPLOYE) KEYTO(E#);
ON ENDFILE GOTO MSG_2;
READ FILE(EMPLOYEE) INTO(EMPLOYEB);
CALL MAIN_CHECK;
GOTO EOP;
MAIN_MSG:
PUT FILE(D) SKIP EDIT('EMPLOYEE#:')(A)(ENUM)(P'9999')
(' NOT FOUND')(A);
GET SKIP LIST('');
ANS = 'X';
GOTO EOP_2;
MSG_2:
PUT FILE(D) SKIP EDIT('SECOND HALF OF ')(A)(ENUM)(P'9999')
(' RECORD NOT FOUND')(A);
GET SKIP LIST('');
ANS = 'X';
GOTO EOP_2;
EOP: ANS = 'Q';
EOP_2:
CALL TYPIST('EMPPGM_B┣0d┫',9);
END;