|
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: 19908 (0x4dc4)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »DDNPGM_S«
└─⟦415b26bc8⟧ Bits:30008568 DDMQ1-0003_Source_For_Q1_Payroll_Package_Diskette_1_1
└─⟦this⟧ »DDNPGM_S«
/* This Program permits Customer to Initialize AND Maintain DEDUCTNS */
/* File 02/20/78 --- "DEDUCTION PROGRAM - Version 1" Version Message */
A0: PUT FILE(D) SKIP EDIT('DEDUCTION PROGRAM - Version : 1')(A(47))
('This Routine permits you to Initialize and')(A(47))
('Maintain a MAXIMUM of 8 Payroll Deductions')(A(47));
DCL DEDUCTNS FILE;
DCL ANS CHAR(1);
DCL ANS2 CHAR(2);
DCL ANS3 CHAR(3);
DCL 1 BUFF,
2 DESCR CHAR(10),
2 AMT FIXED(7,2),
2 FREQ BINARY, /* 0-No Participation 1-4 Same as P_FREQ */
2 PF_P FIXED(4,2),
2 MAX FIXED(7,2),
2 TOTAL FIXED(9,2);
DCL 1 OBUFF,
2 ODESCR CHAR(10),
2 OAMT FIXED(7,2),
2 OFREQ BINARY, /* 7-Maximum Attained-No More Deductions */
2 OPF_P FIXED(4,2),
2 OMAX FIXED(7,2),
2 OTOTAL FIXED(9,2);
DCL 1 DEDUCTION(8),
2 D CHAR(10),
2 A FIXED(7,2),
2 F BINARY,
2 PFPCT FIXED(4,2),
2 MX FIXED(7,2),
2 T FIXED(9,2);
I = 0;
M = 0;
N = 0;
BEG: GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'E') THEN GOTO EOP;
B5: OPEN DEDUCTNS;
A1: I = I + 1;
READ FILE(DEDUCTNS) INTO(DEDUCTION(I));
IF (I < 8) THEN GOTO A1;
I = 0;
B6: PUT FILE(D) SKIP LIST('# DESCR FREQ AMT/PCT-LIMIT');
PUT FILE(D) LIST(' MAXIMUM CURRENTLY');
A2: I = I + 1;
BUFF = DEDUCTION(I);
PUT FILE(D) EDIT(I)(A(1))(DESCR)(X(1),A(5))(' ')(A)
(FREQ)(P'Z9')(' ')(A);
IF (FREQ > 10) THEN DO;
PUT FILE(D) EDIT(PF_P)(P'Z9V.99')('-')(A)(AMT)(P'ZZZZ9V.99');
END;
IF (FREQ < 10) THEN DO;
PUT FILE(D) EDIT(' ')(A)(AMT)(P'ZZZZ9V.99')(' ')(A);
END;
PUT FILE(D) EDIT(' ')(A)(MAX)(P'ZZZZ9V.99')(' ')(A)
(TOTAL)(P'ZZZZZZ9V.99');
IF (I < 8) THEN GOTO A2;
PUT FILE(D) EDIT('DO YOU WANT TO 1)MAKE CHANGES')(A(47))
('2)PRINT LIST OF DEDUCTIONS ')(X(15),A);
PUT FILE(D) EDIT('ENTER CHOICE: ')(X(22),A);
B3: GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'E') THEN DO;
N = 1;
GOTO B4;
END;
/*************************************************************/
/* */
/* Have Yet to Alter the Print Routine in This Program to */
/* Accomodate the Increased Fields for Dedction AF & MXF Amts */
/* AND to Indicate Where Deduction is on a Percent Basis */
/**************************************************************/
IF (ANS ='1') THEN GOTO A3;
IF (ANS ¬= '2') THEN GOTO B3;
IF (N = 1) THEN DO;
UNSPEC(DEDUCTNS) = 0;
WRITE FILE(DEDUCTNS) FROM(DEDUCTION); END;
I = 0;
PUT SKIP(3);
PUT EDIT('DESCRIPT"N AMOUNT-FREQ MAX-AMT ')(X(6),A)
('CURRENT_TOT PERCENT')(A);
PUT SKIP;
PUT SKIP(2);
B7: I = I + 1;
BUFF = DEDUCTION(I);
PUT EDIT(DESCR)(X(6),A(12))(AMT)(P'$$$$9V.99')
('-')(A)(FREQ)(P'Z9')(' ')(A(3))(MAX)(P'$$$$9V.99')
(' ')(A)(TOTAL)(P'$$$$$$9V.99')(' ')(A)(PF_P)(P'Z9V.99')('%')(A);
PUT SKIP(2);
IF (I < 8) THEN GOTO B7;
GOTO EOP;
B4: IF (N = 0) THEN DO;
I = 0;
GOTO B6;
END;
UNSPEC(DEDUCTNS) = 0;
WRITE FILE(DEDUCTNS) FROM(DEDUCTION);
CLOSE DEDUCTNS;
GOTO EOP;
A3: PUT FILE(D) SKIP LIST('ENTER # OF DEDUCTION TO BE MODIFIED: ');
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'E') ö (ANS = '0') THEN GOTO B4;
IF (VERIFY(ANS,'12345678') = 0) THEN GOTO A0;
I = ANS;
BUFF = DEDUCTION(I);
OBUFF = BUFF;
B2: PUT FILE(D) SKIP EDIT('1)DEDUCTION: ')(A(16))(DESCR)(A(31))
('2)FREQUENCY: ')(A(16))(FREQ)(P'Z9')(' ')(A(29));
IF (FREQ > 10) THEN DO;
PUT FILE(D) EDIT('3)PCT-LIMIT')(A(16))(PF_P)(P'Z9V.99')
('-')(A)(AMT)(P'ZZZZ9V.99')(' ')(A(17));
END;
IF (FREQ < 10) THEN DO;
PUT FILE(D) EDIT('3)AMOUNT:')(A(16))(AMT)(P'ZZZZ9V.99')
(' ')(A(23));
END;
PUT FILE(D) EDIT('4)MAXIMUM: ')(A(16))(MAX)(P'ZZZZ9V.99')
(' ')(A(23))('5)CURRENT-TOT:')(A(16))(TOTAL)(P'ZZZZZZ9V.99')
(' ')(A(21))(' ENTER CHOICE: ')(A);
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'E') & (M ¬= 0) THEN GOTO A8;
IF (ANS = 'E') THEN GOTO A3;
IF (VERIFY(ANS,'12345') = 0) THEN GOTO A8;
IF (ANS = '1') THEN GOTO A4;
IF (ANS = '3') THEN GOTO A5;
IF (ANS = '2') THEN GOTO A6;
IF (ANS = '4') THEN GOTO A7;
B1: PUT FILE(D) SKIP EDIT('OLD TOTAL : ')(A(12))(TOTAL)(P'$$$$$$9V.99')
('NEW TOTAL : ')(X(25),A(12));
GET SKIP LIST(TOTAL);
PUT FILE(D) EDIT(TOTAL)(P'$$$$$$9V.99')('OK ? ')(X(25),A(5));
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') THEN DO;
M = M + 1;
GOTO B2;
END;
TOTAL = OTOTAL;
GOTO B2;
A4: PUT FILE(D) SKIP EDIT('ARE YOU 1)RENAMING ONLY')(A(47))
('2)INITIALIZING DEDUCTION')(X(15),A(32))('ENTER CHOICE: ')(X(17),A);
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'E') THEN GOTO B2;
J = 0;
IF (ANS = '2') THEN J = 1;
IF (ANS ¬= '1') & (ANS ¬= '2') THEN GOTO B2;
X3: PUT FILE(D) SKIP EDIT('OLD NAME :')(A(12))(DESCR)(A(35))
('NEW NAME :')(A(12));
GET SKIP LIST(DESCR);
PUT FILE(D) EDIT(DESCR)(A(35))('OK ? ')(A(5));
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') THEN DO;
M = M + 1;
IF (J = 1) THEN GOTO A6;
GOTO B2;
END;
DESCR = ODESCR;
GOTO X3;
A5: IF (FREQ > 10) THEN DO;
PUT FILE(D) SKIP EDIT('OLD PERCENT: ')(A(16))(PF_P)(P'Z9V.99')
(' NEW PERCENT: ')(A(16));
GET SKIP LIST(PF_P);
PUT FILE(D) EDIT(PF_P)(P'Z9V.99')(' ')(A(5))('OLD LIMIT')
(A(13))(AMT)(P'ZZZZ9V.99')(' NEW LIMIT: ')(A(13));
GET SKIP LIST(AMT);
PUT FILE(D) EDIT(AMT)(P'ZZZZ9V.99')(' ')(A(5))('OK ? ')(A);
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') THEN DO;
M = M + 1;
IF (J = 1) THEN GOTO A7;
GOTO B2;
END;
AMT = OAMT;
PF_L = OPF_L;
GOTO A5;
END;
IF (FREQ < 10) THEN DO;
PUT FILE(D) SKIP EDIT('OLD AMOUNT : ')(A(15))(AMT)(P'ZZZZ9V.99')
('NEW AMOUNT : ')(X(24),A(15));
GET SKIP LIST(AMT);
PUT FILE(D) EDIT(AMT)(P'ZZZZ9V.99')('OK ? ')(X(24),A);
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') THEN DO;
M = M + 1;
IF (J = 1) THEN GOTO A7;
GOTO B2;
END;
AMT = OAMT;
GOTO A5;
END;
A6: PUT FILE(D) SKIP EDIT('OLD FREQUENCY : ')(A(16))(FREQ)(P'Z9')
(' ')(A(29))('NEW FREQUENCY : ')(A(16));
A9: GET SKIP LIST(FREQ);
IF (FREQ > 4) THEN DO; IF (FREQ > 14) THEN GOTO A9;
IF (FREQ < 10) & (FREQ ¬= 7) THEN GOTO A9; END;
PUT FILE(D) EDIT(FREQ)(P'Z9')('OK ? ')(X(29),A);
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') THEN DO;
M = M + 1;
IF (J = 1) THEN GOTO A5;
GOTO B2;
END;
FREQ = OFREQ;
GOTO A6;
A7: PUT FILE(D) SKIP EDIT('OLD MAXIMUM : ')(A(15))(MAX)(P'ZZZZ9V.99')
('NEW MAXIMUM : ')(X(24),A(15));
GET SKIP LIST(MAX);
PUT FILE(D) EDIT(MAX)(P'ZZZZ9V.99')('OK ? ')(X(24),A);
GET SKIP LIST(ANS3);
ANS = SUBSTR(ANS3,1,1);
IF (ANS = 'Y') THEN DO;
M = M + 1;
GOTO B2;
END;
MAX = OMAX;
GOTO A7;
/* YET TO ADD % TO THE BELOW --- LISTING FOR OLD/NEW VALUES */
A8: IF (M = 0) THEN GOTO A3;
N = 1;
PUT SKIP(3);
PUT EDIT('DESCRIPT"N AMOUNT-FREQ MAX-AMT CURRENT-TOT')(X(16),A(54));
PUT SKIP;
PUT EDIT('OLD *** ')(X(6),A(10))(ODESCR)(A(12))(OAMT)(P'ZZZZ9V.99')
(' ')(A)(OFREQ)(P'Z9')(' ')(A(4))(OMAX)(P'ZZZZ9V.99')(' ')
(A(3))(OTOTAL)(P'ZZZZZZ9V.99');
PUT SKIP;
PUT EDIT('NEW *** ')(X(6),A(10))(DESCR)(A(12))(AMT)
(P'ZZZZ9V.99')(' ')(A)(FREQ)(P'Z9')(' ')(A(4))(MAX)(P'ZZZZ9V.99')
(' ')(A(4))(TOTAL)(P'ZZZZZZ9V.99');
PUT SKIP;
DEDUCTION(I) = BUFF;
M = 0; I = 0;
GOTO B6;
EOP: END;