|
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: 37525 (0x9295)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »DPTPGM_S«
└─⟦415b26bc8⟧ Bits:30008568 DDMQ1-0003_Source_For_Q1_Payroll_Package_Diskette_1_1
└─⟦this⟧ »DPTPGM_S«
/* This Program - DEPARTMT File Maintenance - April 15th 1978 */
DCL DEPARTMT FILE;
DCL OLDNO FIXED(3);
DCL OLDNAME CHAR(16);
DCL WHICH(2) CHAR(3) INIT('YTD','QTD');
DCL ANS CHAR(1);
DCL ANS3 CHAR(3);
DCL ANS9 CHAR(9);
DCL ANS10 CHAR(10);
DCL ANS16 CHAR(16);
DCL GROSS_FICA FIXED(9,2);
DCL DNUM FIXED(3);
DCL J BINARY INIT(0);
DCL JJ BINARY INIT(0);
DCL JJJ BINARY INIT(0);
DCL 1 DEPARTMENT,
2 ID# FIXED(3), /* Department Number */
2 INM CHAR(16), /* Department Name-Optional */
2 ISEX(2) BINARY, /* 1- # of Males, 2- # of F */
2 ITOTALS(2), /* 1 - YTD , 2 - QTD */
3 IVAC FIXED(8,2), /* Number of Vacation Hours */
3 ISICK FIXED(8,2), /* Number of Sick Hours */
3 IREG FIXED(8,2), /* Number of Regular Hours */
3 IOVER FIXED(8,2), /* Number of Overtime Hours */
3 IOTHRA FIXED(9,2), /* "Other-Taxable" Amount */
3 IOTHRB FIXED(9,2), /* "Other-NonTaxble" Amount */
3 IVAC$ FIXED(9,2), /* Total Vacation Amount */
3 ISICK$ FIXED(9,2), /* Total Sick Amount */
3 IREG$ FIXED(9,2), /* Total Regular Pay Amount */
3 IOT$ FIXED(9,2), /* Total Overtime Pay Amt */
3 IGROSS FIXED(9,2), /* Total Gross for Departmt */
3 IFEDTX FIXED(9,2), /* Total Federal Tax Amount */
3 IFICA FIXED(7,2), /* Total FICA Tax Amount */
3 ISUI FIXED(7,2), /* Total SUI & DIS Amount */
3 ISTATE FIXED(9,2), /* Total State Taxes Amount */
3 ICITY FIXED(9,2), /* Total City Taxes Amount */
2 DCOUNTER CHAR(2), /* '00'-Ready for current Pay-Freq #M,F */
2 IFILLER(4) CHAR(10) INIT(' ',' ',' ',' Y');
DCL 1 TINIT,
2 SVAC FIXED(8,2) INIT(0),
2 SSICK FIXED(8,2) INIT(0),
2 SREG FIXED(8,2) INIT(0),
2 SOVER FIXED(8,2) INIT(0),
2 SOTHRA FIXED(9,2) INIT(0),
2 SOTHRB FIXED(9,2) INIT(0),
2 SVAC$ FIXED(9,2) INIT(0),
2 SSICK$ FIXED(9,2) INIT(0),
2 SREG$ FIXED(9,2) INIT(0),
2 SOT$ FIXED(9,2) INIT(0),
2 SGROSS FIXED(9,2) INIT(0),
2 SFEDTX FIXED(9,2) INIT(0),
2 SFICA FIXED(7,2) INIT(0),
2 SSUI FIXED(7,2) INIT(0),
2 SSTATE FIXED(9,2) INIT(0),
2 SCITY FIXED(9,2) INIT(0);
/* Hours And Pay Amounts Procedure HERE */
HOURS_AND_PAY:PROC;
I = ANS;
TINIT = ITOTALS(I);
J = 0;
JJ = 0;
JJJ = 0;
HD: J = 1;
PUT FILE(D) SKIP EDIT('View/Modify')(A(14))
('Department:')(A(11))(ID#)(P'ZZ9')(' ')(A(3))
(INM)(A(16))(' ')(A(7))(WHICH(I))(A(3))(' TOTALS- ')
(A(10))('Hours & Amounts Paid')(A(20))(' ')(A(7));
PUT FILE(D) EDIT(J)(P'Z9')(')#Reg Hrs:')(A(11));
IF (J = JJ) THEN DO;
HD1: GET SKIP LIST(ANS9);
ANS = SUBSTR(ANS9,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H1E;
IF (VERIFY(ANS9,' .0123456789') = 0) THEN GOTO HD1;
SREG = ANS9;
JJJ = 1;
JJ = 27;
H1E: END;
J = J + 1; /* J = 2 */
PUT FILE(D) EDIT(SREG)(P'ZZZZZ9V.99')(', ')(A(2))
(J)(P'Z9')(')Reg Pay:')(A(10));
IF (J = JJ) THEN DO;
HD2: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H2E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO HD2;
SREG$ = ANS10;
JJJ = 1;
JJ = 27;
H2E: END;
PUT FILE(D) EDIT(SREG$)(P'$$$$$$9V.99')(' ')(A);
J = J + 1; /* J = 3 */
PUT FILE(D) EDIT(J)(P'Z9')(')#O/T Hrs:')(A(11));
IF (J = JJ) THEN DO;
HD3: GET SKIP LIST(ANS9);
ANS = SUBSTR(ANS9,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H3E;
IF (VERIFY(ANS9,' .0123456789') = 0) THEN GOTO HD3;
SOVER = ANS9;
JJJ = 1;
JJ = 27;
H3E: END;
J = J + 1; /* J = 4 */
PUT FILE(D) EDIT(SOVER)(P'ZZZZZ9V.99')(', ')(A(2))
(J)(P'Z9')(')O/T Pay:')(A(10));
IF (J = JJ) THEN DO;
HD4: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H4E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO HD4;
SOT$ = ANS10;
JJJ = 1;
JJ = 27;
H4E: END;
PUT FILE(D) EDIT(SOT$)(P'$$$$$$9V.99')(' ')(A);
J = J + 1; /* J = 5 */
PUT FILE(D) EDIT(J)(P'Z9')(')#Sick Hrs:')(A(11));
HD5: IF (J = JJ) THEN DO;
GET SKIP LIST(ANS9);
ANS = SUBSTR(ANS9,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H5E;
IF (VERIFY(ANS9,' .0123456789') = 0) THEN GOTO HD5;
SSICK = ANS9;
JJJ = 1;
JJ = 27;
H5E: END;
J = J + 1; /* J = 6 */
PUT FILE(D) EDIT(SSICK)(P'ZZZZZ9V.99')(', ')(A(2))
(J)(P'Z9')(')Sick Pay:')(A(10));
IF (J = JJ) THEN DO;
HD6: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H6E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO HD6;
SSICK$ = ANS10;
JJJ = 1;
JJ = 27;
H6E: END;
PUT FILE(D) EDIT(SSICK$)(P'$$$$$$9V.99')(' ')(A);
J = J + 1; /* J = 7 */
PUT FILE(D) EDIT(J)(P'Z9')(')Vac Hrs:')(A(11));
IF (J = JJ) THEN DO;
HD7: GET SKIP LIST(ANS9);
ANS = SUBSTR(ANS9,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H7E;
IF (VERIFY(ANS9,' .0123456789') = 0) THEN GOTO HD7;
SVAC = ANS9;
JJJ = 1;
JJ = 27;
H7E: END;
J = J + 1; /* J = 8 */
PUT FILE(D) EDIT(SVAC)(P'ZZZZZ9V.99')(', ')(A(2))
(J)(P'Z9')(')Vac Pay:')(A(10));
IF (J = JJ) THEN DO;
HD8: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H8E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO HD8;
SVAC$ = ANS10;
JJJ = 1;
JJ = 27;
H8E: END;
PUT FILE(D) EDIT(SVAC$)(P'$$$$$$9V.99')(' ')(A);
J = J + 1; /* J = 9 */
PUT FILE(D) EDIT('OtherPay-')(A(9))(J)(P'Z9')(')Tx:')(A(4));
IF (J = JJ) THEN DO;
HD9: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO H9E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO HD9;
SOTHRA = ANS10;
JJJ = 1;
JJ = 27;
H9E: END;
J = J + 1; /* J = 10*/
PUT FILE(D) EDIT(SOTHRA)(P'$$$$$$9V.99')(', ')(A(2))
(J)(P'Z9')(')NonTx:')(A(7));
IF (J = JJ) THEN DO;
HDT: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO HTE;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO HDT;
SOTHRB = ANS10;
JJJ = 1;
JJ = 27;
HTE: END;
PUT FILE(D) EDIT(SOTHRB)(P'$$$$$$9V.99')(' OK ? ')(A);
HD_ASK:
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') ö (ANS = ' ') THEN GOTO HD_RETURN;
IF (VERIFY(ANS,'N123456789') = 0) THEN GOTO HD_ASK;
IF (ANS ¬= 'N') THEN DO;
JJ = ANS3;
IF (JJ > 10) THEN DO;
JJ = 0;
GOTO HD_ASK;
END;
GOTO HD;
END;
PUT FILE(D) EDIT('ENTER # Of Item To Be Changed : ')(A);
HD_ASK1:
GET SKIP LIST(ANS3);
IF (VERIFY(ANS3,' 0123456789') = 0) THEN GOTO HD;
JJ = ANS3;
IF (JJ > 10) THEN DO;
JJ = 0;
GOTO HD_ASK1;
END;
GOTO HD;
HD_RETURN:
IF (JJJ > 0) THEN DO;
ITOTALS(I) = TINIT;
REWRITE FILE(DEPARTMT) FROM(DEPARTMENT);
END;
JJJ = 0;
JJ = 0;
J = 0;
RETURN;
END;
/* Gross And Tax Amounts Procedure HERE */
GROSS_AND_TAX:PROC;
I = ANS;
TINIT = ITOTALS(I);
J = 0;
JJ = 0;
JJJ = 0;
GD: J = 1;
PUT FILE(D) SKIP EDIT('View/Modify')(A(14))('Department:')
(A(11))(ID#)(P'ZZ9')(' ')(A(3))(INM)(A(16))
(' ')(A(47))(' ')(A(8))(WHICH(I))(A(3))(' TOTALS- ')
(A(9))('Gross & Tax Amounts')(A(19))(' ')(A(8));
PUT FILE(D) EDIT(J)(P'Z9')(')GrossPay:')(A(10));
IF (J = JJ) THEN DO;
GD1: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO G1E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO GD1;
SGROSS = ANS10;
JJJ = 1;
JJ = 27;
G1E: END;
J = J + 1; /* J = 2 */
GROSS_FICA = SGROSS - SSICK$;
PUT FILE(D) EDIT(SGROSS)(P'$$$$$$9V.99')
(' (Less SickPay=')(A(15))(GROSS_FICA)(P'$$$$$$9V.99');
PUT FILE(D) EDIT(J)(P'Z9')(')Fed Tax :')(A(10));
IF (J = JJ) THEN DO;
GD2: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO G2E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO GD2;
SFEDTX = ANS10;
JJJ = 1;
JJ = 27;
G2E: END;
J = J + 1; /* J = 3 */
PUT FILE(D) EDIT(SFEDTX)(P'$$$$$$9V.99')(' ')(A(5))
(J)(P'Z9')(')FICA :')(A(7));
IF (J = JJ) THEN DO;
GD3: GET SKIP LIST(ANS9);
ANS = SUBSTR(ANS9,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO G3E;
IF (VERIFY(ANS9,' .0123456789') = 0) THEN GOTO GD3;
SFICA = ANS9;
JJJ = 1;
JJ = 27;
G3E: END;
J = J + 1; /* J = 4 */
PUT FILE(D) EDIT(SFICA)(P'$$$$$9V.99')(' ')(A(2))
(J)(P'Z9')(')State(s):')(A(10));
IF (J = JJ) THEN DO;
GD4: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO G4E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO GD4;
SSTATE = ANS10;
JJJ = 1;
JJ = 27;
G4E: END;
J = J + 1; /* J = 5 */
PUT FILE(D) EDIT(SSTATE)(P'$$$$$$9V.99')(' ')(A(3))
(J)(P'Z9')(')SUI-SDI :')(A(10));
IF (J = JJ) THEN DO;
GD5: GET SKIP LIST(ANS9);
ANS = SUBSTR(ANS9,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO G5E;
IF (VERIFY(ANS9,' .0123456789') = 0) THEN GOTO GD5;
SSUI = ANS9;
JJJ = 1;
JJ = 27;
G5E: END;
PUT FILE(D) EDIT(SSUI)(P'$$$$$9V.99')(' ')(A(2));
IF (SCITY > 0) THEN DO;
J = J + 1; /* J = 7 */
PUT FILE(D) EDIT(J)(P'Z9')(')CITY Tax(es) :')(A(15));
IF (J = JJ) THEN DO;
GD6: GET SKIP LIST(ANS10);
ANS = SUBSTR(ANS10,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO G6E;
IF (VERIFY(ANS10,' .0123456789') = 0) THEN GOTO GD6;
SCITY = ANS10;
JJJ = 1;
JJ = 27;
G6E: END;
PUT FILE(D) EDIT(SCITY)(P'$$$$$$9V.99')(' ')(A(20));
END;
PUT FILE(D) EDIT('OK ? ')(A);
GD_ASK:
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') ö (ANS = ' ') THEN GOTO GD_RETURN;
IF (VERIFY(ANS,'N1234567') = 0) THEN GOTO GD_ASK;
IF (ANS ¬= 'N') THEN DO;
JJ = ANS;
IF (JJ > J) THEN DO;
JJ = 0;
GOTO GD_ASK;
END;
GOTO GD;
END;
PUT FILE(D) EDIT('ENTER # Of Item To Be Changed : ')(A);
GD_ASK1:
GET SKIP LIST(ANS);
IF (VERIFY(ANS,' 01234567') = 0) THEN GOTO GD;
JJ = ANS;
IF (JJ > J) THEN DO;
JJ = 0;
GOTO GD_ASK1;
END;
GOTO GD;
GD_RETURN:
IF (JJJ > 0) THEN DO;
ITOTALS(I) = TINIT;
REWRITE FILE(DEPARTMT) FROM(DEPARTMENT);
END;
JJJ = 0;
JJ = 0;
J = 0;
RETURN;
END;
/* MAIN Part of DEPARTMT Maintenance Program Follows */
DM: OPEN DEPARTMT;
PUT FILE(D) SKIP EDIT('View / Modify Department')(A(94))
('ENTER DEPARTMENT#: ')(A);
DM1: GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'E') ö (ANS = '0') THEN GOTO EOP;
IF (VERIFY(ANS3,' 0123456789') = 0) THEN GOTO DM1;
DNUM = ANS3;
IF (DNUM = 0) THEN GOTO DM1;
DM2: ON ERROR GOTO D_MSG;
READ KEY(DNUM) FILE(DEPARTMT) INTO(DEPARTMENT) KEYTO(ID#);
DM3: J = 1; /* J = 1 */
PUT FILE(D) SKIP EDIT('View/Modify ')(A(14))
('Department:')(A(11))(ID#)(P'ZZ9')(' ')(A(3))
(INM)(A(16))('DO YOU WANT-')(A(16))('1)CHANGE Dept#:')(A(15));
IF (J = JJ) THEN DO;
D3R: GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'E') ö (ANS = '0') THEN GOTO D3E;
IF (VERIFY(ANS3,' 0123456789') = 0) THEN GOTO D3R;
OLDNO = ID#;
ID# = ANS3;
IF (ID# > 0) THEN JJJ = 1;
IF (ID# = 0) THEN ID# = OLDNO;
JJ = 27;
GOTO DM3;
D3E: END;
J = J + 1;
PUT FILE(D) EDIT(ID#)(P'ZZ9')(' ')(A(29))('2)DeptName:')(A(11));
IF (J = JJ) THEN DO;
GET SKIP LIST(ANS16);
ANS = SUBSTR(ANS16,1,1);
IF (ANS = 'E') ö (ANS = ' ') THEN GOTO D4E;
OLDNAME = INM;
INM = ANS16;
JJJ = 1;
JJ = 27;
GOTO DM3;
D4E: END;
J = J + 1;
PUT FILE(D) EDIT(INM)(A(16))(' ')(A(20))
('3)QTD or 4)YTD Hours & Pay Amts')(A(47))
('5)QTD or 6)YTD Gross & Tax Amts')(A(47))
('7)All Of 3 thru 6 Above')(A(49)); /* (A(47))
('Print Of 8)This, 9)All Dept(s)')(A(49))
('ENTER CHOICE : ')(A); */
PUT FILE(D) EDIT('ENTER CHOICE : ')(A);
D5R: GET SKIP LIST(ANS);
IF (JJJ > 0) THEN DO;
REWRITE FILE(DEPARTMT) FROM(DEPARTMENT);
JJJ = 0;
END;
IF (ANS = 'E') ö (ANS = '0') THEN GOTO DM;
IF (VERIFY(ANS,'123456789') = 0) THEN GOTO D5R;
IF (ANS = '1') THEN GOTO CHANGE1;
IF (ANS = '2') THEN GOTO CHANGE2;
IF (ANS = '3') THEN GOTO CHANGE3;
IF (ANS = '4') THEN GOTO CHANGE4;
IF (ANS = '5') THEN GOTO CHANGE5;
IF (ANS = '6') THEN GOTO CHANGE6;
IF (ANS = '7') THEN GOTO CHANGE7;
/* IF (ANS = '8') THEN GOTO PRINT1;
IF (ANS = '9') THEN GOTO PRINT2; */
GOTO DM3; /* Until 8) & 9) Operative */
CHANGE1:
JJ = 1;
GOTO DM3;
CHANGE2:
JJ = 2;
GOTO DM3;
CHANGE3:
ANS = '2';
CALL HOURS_AND_PAY;
GOTO DM3;
CHANGE4:
ANS = '1';
CALL HOURS_AND_PAY;
GOTO DM3;
CHANGE5:
ANS = '2';
CALL GROSS_AND_TAX;
GOTO DM3;
CHANGE6:
ANS = '1';
CALL GROSS_AND_TAX;
GOTO DM3;
CHANGE7:
ANS = '2';
CALL HOURS_AND_PAY;
ANS = '2';
CALL GROSS_AND_TAX;
ANS = '1';
CALL HOURS_AND_PAY;
ANS = '1';
CALL GROSS_AND_TAX;
GOTO DM3;
/* PRINT1:
CALL PRINT_FILE;
GOTO DM3;
PRINT2:
OPEN DEPARTMT;
P2: ON ENDFILE GOTO DM;
READ FILE(DEPARTMT) INTO(DEPARTMENT);
CALL PRINT_FILE;
GOTO P2; */
GOTO EOP;
D_MSG:
PUT FILE(D) SKIP EDIT('DEPARTMENT#:')(A)(DNUM)(P'ZZ9')
(' Not Found')(A);
GET SKIP LIST('');
GOTO DM;
EOP: CALL TYPIST('PAYROLL┣0d┫',8);
END;