|
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: 12877 (0x324d)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »ADRUTSKR«
└─⟦169de8b1d⟧ Bits:30008745 50001578
└─⟦this⟧ »ADRUTSKR«
/* PROGRAM-ID. ADRUTSKR
DATE-WRITTEN. 1978-12-13.
AUTHOR. OLLE
REMARKS. PROGRAMMET SKRIVER ETIKETTER
FRÅN ADRESSREGISTER
WORKING-STORAGE SECTION. */
DCL FOREKOD CHAR (1);
DCL BLANK CHAR (30) INIT (' ');
DCL BLANK2 CHAR (15) INIT (' ');
DCL KNUTTAR FILE;
DCL KVVADR FILE;
DCL AROSADR FILE;
DCL 1 WRPOST,
2 FKOD CHAR (1),
2 FUKOD CHAR (1),
2 LOPNR CHAR (3),
2 NAMN CHAR (30),
2 FORETAG CHAR (30),
2 AVDELNING CHAR (15),
2 ADRESS CHAR (30),
2 PADR CHAR (21),
2 FILLER CHAR (19);
DCL 1 RAD,
2 FILL CHAR (3),
2 RNAMN CHAR (30);
DCL 1 HJRAD (5,3),
2 HJFILL CHAR (3),
2 HJNAMN CHAR (30);
/* PROCEDURE DIVISION */
TAB: PROC;
HJRAD (I,J) = RAD;
RETURN;
END;
BLANKA: PROC;
DO I = 1 TO 5;
DO J = 1 TO 3;
RNAMN = BLANK;
HJRAD (I,J) = RAD;
END;
END;
RETURN;
END;
BLRAD3: PROC;
PUT SKIP (3) EDIT (' ') (A(1));
RETURN;
END;
BLRAD4: PROC;
PUT SKIP (4) EDIT (' ') (A(1));
L = 0;
RETURN;
END;
LNOLL: PROC;
L = 0;
RETURN;
END;
A050:
L = 0;
A100:
PUT FILE (D) SKIP EDIT
('VAR GOD ANGIV FÖRETAGSKOD FÖR ETIKETTUTSKRIFT:') (A(46));
GET SKIP LIST (FOREKOD);
IF FOREKOD = 'S' THEN GO TO A700;
PUT FILE (D) EDIT (' ') (A(48));
PUT FILE (D) EDIT ('SKALL UTSKRIFT GÖRAS PÅ NY SIDA SVARA J eller N')
(A(47));
GET SKIP LIST (FILL);
IF FILL = ('J ') THEN CALL LNOLL;
CALL BLANKA;
J = 0;
K = 0;
IF FOREKOD = '7' THEN OPEN KNUTTAR;
IF FOREKOD = '8' THEN OPEN KVVADR;
IF FOREKOD = '9' THEN OPEN AROSADR;
IF FOREKOD = '7' THEN GO TO A210;
IF FOREKOD = '8' THEN GO TO A220;
IF FOREKOD = '9' THEN GO TO A230;
GO TO A100;
A210:
ON ENDFILE GO TO A399;
READ FILE (KNUTTAR) INTO (WRPOST);
GO TO A400;
A220:
ON ENDFILE GO TO A399;
READ FILE (KVVADR) INTO (WRPOST);
GO TO A400;
A230:
ON ENDFILE GO TO A399;
READ FILE (AROSADR) INTO (WRPOST);
GO TO A400;
A300:
IF FOREKOD = '7' THEN CLOSE KNUTTAR;
IF FOREKOD = '8' THEN CLOSE KVVADR;
IF FOREKOD = '9' THEN CLOSE AROSADR;
GO TO A100;
A399:
K = 1;
GO TO A500;
/* LADDNING AV NAMN- / ADRESSTABELLEN */
A400:
I = 0;
J = J + 1;
IF NAMN = BLANK THEN GO TO A410;
I = I + 1;
RNAMN = NAMN;
CALL TAB;
A410:
IF FORETAG = BLANK THEN GO TO A420;
I = I + 1;
RNAMN = FORETAG;
CALL TAB;
A420:
IF AVDELNING = BLANK2 THEN GO TO A430;
I = I + 1;
RNAMN = AVDELNING;
CALL TAB;
A430:
IF ADRESS = BLANK THEN GO TO A440;
I = I + 1;
RNAMN = ADRESS;
CALL TAB;
A440:
IF PADR = BLANK THEN GO TO A499;
I = I + 1;
RNAMN = PADR;
CALL TAB;
A499:
IF K = 1 THEN GO TO A100;
IF J = 3 THEN GO TO A500;
IF FOREKOD = '7' THEN GO TO A210;
IF FOREKOD = '8' THEN GO TO A220;
IF FOREKOD = '9' THEN GO TO A230;
/* UTSKRIFT FRÅN NAMN- / ADRESSTABELLEN */
A500:
I = 0;
L = L + 1;
A505:
J = 0;
A510:
I = I + 1;
IF I = 6 THEN GO TO A600;
J = J + 1;
RAD = HJRAD (I,J);
PUT SKIP EDIT (' ') (A(3)) (RNAMN) (A(30));
A520:
J = J + 1;
IF J = 4 THEN GO TO A505;
RAD = HJRAD (I,J);
PUT EDIT (' ') (A(3)) (RNAMN) (A(30));
GO TO A520;
A600:
CALL BLANKA;
J = 0;
IF L = 1 THEN CALL BLRAD3;
IF L = 2 THEN CALL BLRAD4;
GO TO A499;
A700:
END;