|
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: 7979 (0x1f2b)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »UPPDAT«
└─⟦4578d4c41⟧ Bits:30008744 50001576
└─⟦this⟧ »UPPDAT«
/* 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 1 REG,
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,
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));
A200:
IF ANSTNR = '999999' THEN GO TO A250;
READ FILE (PREGI) INTO (REG);
ON ENDFILE GO TO E100;
RIACC = RIACC + 1;
A250:
IF TANSTNR = '999999' THEN GO TO A300;
READ FILE (PTRANS) INTO (TRANS);
ON ENDFILE GO TO F100;
TACC = TACC + 1;
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;
IF ANSTNR = '999999' THEN GO TO A300;
READ FILE (PREGI) INTO (REG);
ON ENDFILE GO TO F100;
RIACC = RIACC + 1;
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:
F100:
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;