|
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: 9796 (0x2644)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »UPPDAT1«
└─⟦4578d4c41⟧ Bits:30008744 50001576
└─⟦this⟧ »UPPDAT1«
/* PROGRAM-ID. UPPDAT */
/* DATE-WRITTEN. 1978-08-18 */
/* AUTHOR. OLLE */
/* REMARKS. PROGRAMMET UPPDATERAR PERS-REG MED NYA OCH */
/* ÄNDRADE POSTER */
/* */
/* WORKING-STORAGE SECTION. */
DCL PREGI FILE,
PREGU FILE,
PTRANS FILE;
DCL RIACC FIXED (4) INIT (0000);
DCL RUACC FIXED (4) INIT (0000);
DCL TACC FIXED (4) INIT (0000);
DCL RIMAX BINARY (2) INIT (00);
DCL TIMAX BINARY (2) INIT (00);
DCL RETUR CHAR (4);
DCL 1 REG (25),
2 RFILLER CHAR (128);
DCL 1 WREG,
2 ANSTNR CHAR (6),
2 RES1 CHAR (2),
2 ENAMN CHAR (20),
2 FNAMN CHAR (12),
2 TITEL CHAR (11),
2 ADRESS CHAR (25),
2 GATUNR CHAR (4),
2 ING CHAR (4),
2 POSTNR CHAR (6),
2 RES2 CHAR (6),
2 ORTNAMN CHAR (11),
2 RIKTNR CHAR (4),
2 TELNR CHAR (6),
2 RES3 CHAR (16);
DCL 1 TRANS (25),
2 TFILLER CHAR (128);
DCL 1 WTRANS,
2 TANSTNR CHAR (6),
2 TKOD CHAR (2),
2 TENAMN CHAR (20),
2 TFNAMN CHAR (12),
2 TTITEL CHAR (11),
2 TADRESS CHAR (25),
2 TGATUNR CHAR (4),
2 TING CHAR (4),
2 TPOSTNR CHAR (6),
2 TRES2 CHAR (2),
2 TORTNAMN CHAR (11),
2 TRIKTNR CHAR (4),
2 TTELNR CHAR (6),
2 TRES3 CHAR (16);
/* PROCEDURE DIVISION. */
A100:
OPEN PREGI;
OPEN PREGU;
OPEN PTRANS;
PUT FILE (D) SKIP EDIT (' BEARBETNING PÅGÅR') (A(47));
RETUR = 'A200';
GO TO E100;
A200:
J = J + 1;
WREG = REG (J);
IF ANSTNR = '999999' THEN GO TO A250;
IF J = RIMAX THEN RETUR = 'A240';
IF J = RIMAX THEN GO TO E100;
A240:
A250:
IF TANSTNR = '999999' THEN GO TO A300;
IF TIND = 25 THEN DO;
READ FILE (PTRANS) INTO (TRANS);
ON ENDFILE GO TO F100;
TACC = TACC + 1
END;
A300:
IF TANSTNR = ANSTNR THEN GO TO B100;
IF TANSTNR > ANSTNR THEN GO TO C100;
IF TANSTNR < ANSTNR THEN GO TO D100;
PUT FILE (D) SKIP EDIT ('FEL I UPPDAT') (A(47));
GET SKIP LIST (TRES3);
WRITE FILE (PREGU) FROM (TRANS);
B100:
IF ANSTNR = '999999' THEN GO TO G100;
IF TKOD = 'DL' THEN GO TO D200;
WRITE FILE (PREGU) FROM (TRANS);
RUACC = RUACC + 1;
GO TO A200;
C100:
WRITE FILE (PREGU) FROM (REG);
RUACC = RUACC + 1;
J = J + 1;
WREG = REG (J);
IF ANSTNR = '999999' THEN GO TO A300;
IF J = RIMAX THEN RETUR = 'C200';
IF J = RIMAX THEN GO TO E100;
C200:
GO TO A300;
D100:
WRITE FILE (PREGU) FROM (TRANS);
RUACC = RUACC + 1;
D200:
IF TANSTNR = '999999' THEN GO TO A300;
READ FILE (PTRANS) INTO (TRANS);
ON ENDFILE GO TO F100;
TACC = TACC + 1;
GO TO A300;
E100:
READ FILE (PREGI) INTO (REG);
J = 0;
E200:
J = J + 1;
IF J = 25 THEN GO TO E300;
IF ANSTNR = '999999' THEN GO TO E300;
IF J < 26 THEN GO TO E200;
E300:
RIACC = RIACC + J;
G100:
WRITE FILE (PREGU) FROM (REG);
RUACC = RUACC + 1;
CLOSE PREGI;
CLOSE PREGU;
CLOSE PTRANS;
PUT SKIP (5) EDIT ('ANTAL REGPOSTER IN') (A(25)) (RIACC) (P'ZZZ9');
PUT SKIP (1) EDIT ('ANTAL REGPOSTER UT') (A(25)) (RUACC) (P'ZZZ9');
PUT SKIP (1) EDIT ('ANTAL TRANSPOSTER ') (A(25)) (TACC) (P'ZZZ9');
END;