|
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;