|
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: 39342 (0x99ae)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »RPTPGM_S«
└─⟦415b26bc8⟧ Bits:30008568 DDMQ1-0003_Source_For_Q1_Payroll_Package_Diskette_1_1
└─⟦this⟧ »RPTPGM_S«
/* RPTPGM - Payroll Reports Program - Source : May 10th 1978 */
DCL 1 D_DATE,
2 MONTH FIXED(2),
2 DAY FIXED(2),
2 YEAR FIXED(2);
DCL E_21 FIXED(11,2);
DCL E_22 FIXED(11,2);
DCL PAGE FIXED(1) INIT(1);
DCL ANS CHAR(1);
DCL ANS2 CHAR(2);
DCL ANS3 CHAR(3);
DCL ANS4 CHAR(4);
DCL ANS5 CHAR(5);
DCL ANS6 CHAR(6);
DCL ANS7 CHAR(7);
DCL ANS8 CHAR(8);
DCL ANS9 CHAR(9);
DCL ANS10 CHAR(10);
DCL W_Q(5) CHAR(6)
INIT('First','Second','Third','Fourth','WHICH');
DCL RPTFILE FILE;
DCL 1 M_F_REC, /* # of MALES & FEMALES */
2 R_MF_RECNO CHAR(1) INIT('S'),
2 STATE_M(20) BINARY, /* NUMBER of MALES by STATE */
2 STATE_F(20) BINARY, /* NUMBER of FEMALES by STATE */
2 DEPT_M(29) BINARY, /* NUMBER of MALES by DEPT */
2 DEPT_F(29) BINARY, /* NUMBER of FEMALES by DEPT */
2 TOTAL_MALES FIXED(7) INIT(0),
2 TOTAL_FEMALES FIXED(7) INIT(0),
2 CUSTOMER_NAME CHAR(15) INIT('CUSTOM ALLOY CO'),
2 T_CITY_3(20) CHAR(3), /* Balance of CITY Tax Name */
2 M_F_FILLER CHAR(20) INIT(' ');
DCL 1 R_REC1(3),
2 R_1_RECNO FIXED(1),
2 T_SUI_OR_FICA(20) FIXED(13,2), /* TOTAL S/F by FD/STATE/CITY */
2 T_DEDUCTIONS(8) FIXED(13,2), /* TOTAL per DEDUCTION */
2 T_WHICH_DDNS(8) CHAR(10), /* ARRAY of DEDUCTION NAMES */
2 T_ALL_DDNS FIXED(13,2), /* TOTAL of All DEDUCTIONS */
2 T_FUTA FIXED(13,2), /* Total Wages > FUTA Base Amt */
2 T_1_FILLER CHAR(9);
DCL 1 R_REC4(3),
2 R_4_RECNO FIXED(1),
2 T_INCOME_TAX(20) FIXED(13,2), /* TAX TOTALS by FD/STATE/CITY */
2 T_TAXNAME(20) CHAR(2), /* T_TAXNAME(1) = 'NI' Means */
2 T_TAX_TYPE(20) CHAR(1), /* This Array Not Yet Initlzed */
2 T_CITY_2(20) CHAR(2), /* 1st 3 Char Of City Tax Name */
2 T_TRANS_COMMUTER(20) CHAR(1), /* A '*' HERE Indicates that */
/* Income Tax in Same Index */
/* In array Above Represents */
/* A Trans/Commuter Tax Amount */
2 T_NET_PAY FIXED(13,2), /* 'CASH' Amt on D-Journal Rpt */
2 T_GRAND_TOTAL FIXED(13,2), /* This - T_FUTA = FUTA Taxabl */
2 T_SUMKEY FIXED(1), /* 0 - In CURRENT Values Means */
/* Pgm was Called fm PAYPGM_B */
/* & so QTD/YTD Nd 2 B Updated */
2 T_DATE CHAR(8), /* Holds LAST-PAY Date */
2 T_ALL_DPTS FIXED(13,2), /* Total of All Departments */
2 T_4_FILLER CHAR(9);
DCL 1 R_REC7(3),
2 R_7_RECNO FIXED(1),
2 T_DEPARTMENT(29) FIXED(13,2), /* TOTALS by DEPARTMENT */
2 T_DEPT_NO(29) FIXED(3), /* DEPT #s Corresponding To */
/* Above Array */
2 T_7_FILLER CHAR(9);
DCL 1 REC1,
2 R11 FIXED(1),
2 R12(20) FIXED(13,2),
2 R13(8) FIXED(13,2),
2 R14(8) CHAR(10),
2 R15 FIXED(13,2) INIT(0),
2 R16 FIXED(13,2) INIT(0),
2 R17 CHAR(9) INIT('RECORDS 1');
DCL 1 REC2,
2 R21 FIXED(1),
2 R22(20) FIXED(13,2),
2 R23(20) CHAR(2),
2 R24(20) CHAR(1),
2 R25(20) CHAR(2),
2 R26(20) CHAR(1),
2 R27 FIXED(13,2) INIT(0),
2 R28 FIXED(13,2) INIT(0),
2 R29 FIXED(1) INIT(5),
2 R2A CHAR(8) INIT('00/00/00'),
2 R2B FIXED(13,2) INIT(0),
2 R2C CHAR(9) INIT('RECORDS 4');
DCL 1 REC3,
2 R31 FIXED(1),
2 R32(29) FIXED(13,2),
2 R33(29) FIXED(3),
2 R34 CHAR(9) INIT('RECORDS 7');
/* DECLARES for DEDUCTION-REPORT : Generated at Payroll 05/01/78 */
DCL EMPLOYEE FILE;
DCL DEDUCTNS FILE;
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 DDNRPT DECLARES ***************************/
/* READ RPTFILE Into Buffer, I Values : 1-Current 2-QTD 3-YTD */
READ_RPTFILE:PROC;
IF (I > 1) THEN GOTO READ1;
READ FILE(RPTFILE) INTO(M_F_REC);
READ FILE(RPTFILE) INTO(R_REC1);
READ FILE(RPTFILE) INTO(R_REC4);
READ FILE(RPTFILE) INTO(R_REC7);
READ1: REC1 = R_REC1(I);
REC2 = R_REC4(I);
REC3 = R_REC7(I);
RETURN;
END;
REWRITE_RPTFILE:PROC;
UNSPEC(RPTFILE) = 0;
WRITE FILE(RPTFILE) FROM(M_F_REC);
UNSPEC(RPTFILE) = 1;
WRITE FILE(RPTFILE) FROM(R_REC1);
UNSPEC(RPTFILE) = 4;
WRITE FILE(RPTFILE) FROM(R_REC4);
UNSPEC(RPTFILE) = 7;
WRITE FILE(RPTFILE) FROM(R_REC7);
RETURN;
END;
/* YTD/QTD Report Fields Update Module of RPTPGM - April 1978 */
Y_Q_UPDATE:PROC;
REC1 = R_REC1(I);
REC2 = R_REC4(I);
REC3 = R_REC7(I);
R15 = R15 + T_ALL_DDNS;
R16 = R16 + T_FUTA;
R27 = R27 + T_NET_PAY;
R28 = R28 + T_GRAND_TOTAL;
R2B = R2B + T_ALL_DPTS;
DO J = 1 TO 8;
R13(J) = R13(J) + T_DEDUCTIONS(J);
END;
DO J = 1 TO 20;
IF (T_TAXNAME(J) = '**') THEN GOTO YQ1;
R12(J) = R12(J) + T_SUI_OR_FICA(J);
R22(J) = R22(J) + T_INCOME_TAX(J);
END;
YQ1: DO J = 1 TO 29;
R32(J) = R32(J) + T_DEPARTMENT(J);
END;
CALL REWRITE_RPTFILE;
RETURN;
END;
/* PAYROLL DISTRIBUTION JOURNAL Module of RPTPGM - April 1978 */
PAYROLL_DISTRIBUTION:PROC;
PUT FILE(D) SKIP EDIT('ALIGN PAPER for TOTALS PAGE')(A);
GET SKIP LIST('');
PUT SKIP(3) EDIT(CUSTOMER_NAME)(A(15))(' ')(A(10))
('PAYROLL DISTRIBUTION JOURNAL')(A(28))(' ')(A(12))
('RUN : ')(A(6))(R2A)(A(8))(' ')(A(11))
('PAGE ')(A(5))(PAGE)(P'9');
PUT SKIP(5) EDIT(' ')(A(61))('DEBIT')(A(5))(' ')(A(24))
('CREDIT')(A(6));
PUT SKIP EDIT('DESCRIPTION')(A(11))(' ')(A(49))('AMOUNT')
(A(6))(' ')(A(24))('AMOUNT')(A(6));
PUT SKIP(2) EDIT('CASH')(A(4))(' ')(A(75))
(R27)(P'$$,$$$,$$$,$$9V.99');
PUT SKIP EDIT('FEDERAL TAX')(A(11))(' ')(A(68))
(R22(1))(P'$$,$$$,$$$,$$9V.99');
PUT SKIP EDIT('FICA TAX')(A(8))(' ')(A(71))
(R12(1))(P'$$,$$$,$$$,$$9V.99');
DO I = 1 TO 19;
J = I + 1;
IF (R22(J) = 0) THEN GOTO PDJ3; /* TAX AMT ZERO */
IF (R23(J) = '**') THEN GOTO PDJ5;
IF (R24(J) = '5') THEN GOTO PDJ1; /* CITY TAX */
/* HERE We Have a State Tax */
PUT SKIP EDIT(R23(J))(A(2))(' STATE INCOME TAX')
(A(17))(' ')(A(60));
GOTO PDJ2; /* PRINT R22(J) */
/* HERE We Have a City Tax */
PDJ1: PUT SKIP EDIT(R25(J))(A(2))(T_CITY_3(J))(A(3))
(' CITY (')(A(7))(R23(J))(A(2))(' STATE) TAX')
(A(11))(' ')(A(54));
/* PRINT R22(J) HERE */
PDJ2: PUT EDIT(R22(J))(P'$$,$$$,$$$,$$9V.99');
/* If Can Provide Trans/Commuter Also-Put It HERE */
PDJ3: IF (R12(J) = 0) THEN GOTO PDJ4; /* SUI-SDI = 0 */
PUT SKIP EDIT(R23(J))(A(2))(' STATE SUI-SDI')(A(14))
(' ')(A(63))(R12(J))(P'$$,$$$,$$$,$$9V.99');
PDJ4: END;
PDJ5: PUT SKIP EDIT('DEDUCTIONS-')(A(11));
DO I = 1 TO 8;
PUT SKIP EDIT(R14(I))(A(10))(' ')(A(69))
(R13(I))(P'$$,$$$,$$$,$$9V.99');
END;
PUT SKIP EDIT('DEPARTMENTS-')(A(12));
DO I = 1 TO 29;
IF (R32(I) = 0) THEN GOTO PDJ6;
PUT SKIP EDIT(R33(I))(P'999')(' ')(A(46))
(R32(I))(P'$$,$$$,$$$,$$9V.99');
PDJ6: END;
PUT SKIP(2) EDIT('***JOURNAL TOTAL')(A(16))(' ')(A(30))
('***')(A(3))(R2B)(P'$$,$$$,$$$,$$9V.99')(' ')
(A(10))('***')(A(3))(R28)(P'$$,$$$,$$$,$$9V.99');
PUT SKIP(3) EDIT('FUTA : Wages in Excess Of FUTA')(A)
(' Limit This Pay-Period :')(A)
(R16)(P'$$,$$$,$$$,$$9V.99');
PUT SKIP;
RETURN;
END;
/* ************** DEDUCTION-REPORT Procedure Follows ************** */
DEDUCTION_RPT:PROC;
PUT FILE(D) SKIP LIST('Arrange Paper for PAYROLL DEDUCTIONS Report');
GET SKIP LIST(ANS);
IF (ANS = 'X') THEN DO;
DR_3: PUT FILE(D) SKIP LIST('ENTER PAYROLL DATE for REPORT : ');
DR_2: GET SKIP LIST(ANS6);
IF (SUBSTR(ANS6,1,1) = 'E') THEN GOTO DDN_RETURN;
IF (VERIFY(ANS6,'0123456789') = 0) THEN GOTO DR_2;
MONTH = SUBSTR(ANS6,1,2);
DAY = SUBSTR(ANS6,3,2);
YEAR = SUBSTR(ANS6,5,2);
PUT FILE(D) EDIT(MONTH)(P'99')('/')(A)(DAY)(P'99')('/')(A)
(YEAR)(P'99')(' OK ? ')(A);
GET SKIP LIST(ANS);
IF (ANS ¬= 'Y') THEN GOTO DR_3;
END;
D_BEG:
OPEN DEDUCTNS;
READ FILE(DEDUCTNS) INTO(DEDCTION);
PUT SKIP EDIT('PAYROLL DEDUCTIONS Report - ')(X(20),A)
(MONTH)(P'99')('/')(A)(DAY)(P'99')('/')(A)(YEAR)(P'99');
PUT SKIP;
DO I = 1 TO 8;
OPEN EMPLOYEE;
E_21 = 0; E_22 = 0; /* E_21=CURRENT, E_22=Tot-2-Date */
BUFF = DEDCTION(I);
PUT SKIP EDIT('Deduction #')(X(12),A)(I)(P'999')(')')(A)(DE)(A);
PUT SKIP(3) EDIT('Emp#')(A(23))('NAME')(A(20))
('Current')(A(11))('TO DATE')(A(11))
('MAXIMUM')(A);
DR_1: ON ENDFILE GOTO DDN_TOTALS;
READ FILE(EMPLOYEE) INTO(EMPLOYE);
ON ENDFILE GOTO DDN_MSG1;
READ FILE(EMPLOYEE) INTO(EMPLOYEB);
DBUFF = DEDUCTIONS(I);
IF (MONTH ¬= P_MONTH) ö (DAY ¬= P_DAY) ö (YEAR ¬= P_YEAR)
THEN GOTO DR_1;
IF (DF = 0) ö (DF = 7) ö (E# = 0) THEN GOTO DR_1;
E_21 = E_21 + DEDNS(I);
E_22 = E_22 + CU;
PUT SKIP EDIT(E#)(P'9999')(FIRST)(X(8),A(11))(MI)
(A(2))(LASTNAME)(A(14))(DEDNS(I))(X(3),P'$$$$9V.99')
(DDY(I))(X(3),P'$$$$9V.99')(MA)(X(3),P'$$$$9V.99');
PUT SKIP;
GOTO DR_1;
DDN_TOTALS:
PUT SKIP(2) EDIT('_____')(A(5))(DE)(A(11))('TOTALS')(A)
(E_21)(X(14),P'$$$,$$$,$$9V.99')(E_22)(P'$$$,$$$,$$9V.99');
PUT SKIP EDIT('_______________')(A(15));
PUT SKIP;
END;
GOTO DDN_RETURN;
DDN_MSG1:
PUT FILE(D) SKIP EDIT('ERROR on ')(A)(E#)(P'9999');
GET SKIP LIST('');
DDN_RETURN:
RETURN;
END;
/* MAIN Section of Reports Program Follows - */
OPEN RPTFILE;
I = 1;
CALL READ_RPTFILE;
IF (T_SUMKEY = 0) THEN DO;
T_SUMKEY = 5;
CALL PAYROLL_DISTRIBUTION;
I = 2;
CALL Y_Q_UPDATE;
I = 3;
CALL Y_Q_UPDATE;
CALL TYPIST('CHKPGM┣0d┫',7);
STOP;
END;
CALL DEDUCTION_RPT;
/*
RPT1: PUT FILE(D) SKIP EDIT('REPORT OPTIONS -')(A(16))('1)Quarterly Tax')
(X(7),A(47))('2)Employee W2')(A(47))('3)Inactive Employees')
(A(47))('4)Deductions by Employee')(A(47))
('5)Unemploymt/Disability')(A(49))('ENTER CHOICE : ')(A);
RPT2: GET SKIP LIST(ANS);
IF (VERIFY(ANS,' E01234') = 0) THEN GOTO RPT2;
IF (ANS = 'E') ö (ANS = '0') THEN GOTO
IF (ANS = '1') THEN GOTO
IF (ANS = '2') THEN GOTO
IF (ANS = '3') THEN GOTO
IF (ANS = '4') THEN GOTO
IF (ANS = '5') THEN GOTO */
END;