|
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: 9638 (0x25a6)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »ETIK«
└─⟦32c2b473d⟧ Bits:30008620 DDMQ1-0061_ETIK_a_H_S
└─⟦this⟧ »ETIK«
DCL 1 ETIKETT,
2 NR CHAR(5),
2 FNAMN CHAR(8),
2 ENAMN CHAR(16),
2 FIRMA CHAR(20),
2 AVD CHAR(15),
2 ADR CHAR(20),
2 BOX CHAR(10),
2 POST CHAR(18),
2 TEL CHAR(11),
2 CODE(7) CHAR(2);
DCL 1 UTSKR,
2 N1 CHAR(5),
2 FN CHAR(8),
2 EN CHAR(16),
2 FM CHAR(20),
2 AD CHAR(15),
2 BX CHAR(20),
2 PS CHAR(18);
DCL 1 UTSKR2,
2 N2 CHAR(5),
2 FN2 CHAR(8),
2 EN2 CHAR(16),
2 FM2 CHAR(20),
2 AD2 CHAR(15),
2 BX2 CHAR(20),
2 PS2 CHAR(18);
DCL 1 UTSKR3,
2 N3 CHAR(5),
2 FN3 CHAR(8),
2 EN3 CHAR(16),
2 FM3 CHAR(20),
2 AD3 CHAR(15),
2 BX3 CHAR(20),
2 PS3 CHAR(18);
DCL 1 UTSKR4,
2 N4 CHAR(5),
2 FN4 CHAR(8),
2 EN4 CHAR(16),
2 FM4 CHAR(20),
2 AD4 CHAR(15),
2 BX4 CHAR(20),
2 PS4 CHAR(18);
DCL NAM1 CHAR(35);
DCL NAM2 CHAR(35);
DCL NAM3 CHAR(35);
DCL NAM4 CHAR(35);
DCL XA CHAR(3), XB CHAR(15);
DCL SORTFIL FILE;
OPEN SORTFIL;
NOLL:IF (ONCODE=4) THEN DO;END;DCL X CHAR(5);X='99999';
R=0; DCL Y CHAR(5);
PUT FILE(D) SKIP LIST('ANGE VID VILKET KUNDNR UTSKRIFT SKA ');
PUT FILE(D) LIST('BÖRJA.("START" = FRÅN BÖRJAN): ');
GET SKIP LIST(Y);IF Y='START' THEN GO TO NYREC;
ON ERROR GO TO NOLL;
READ KEY(Y) FILE(SORTFIL) INTO(ETIKETT);R=1;GO TO HOPP;
NYREC:
R = R + 1;
IF(R = 1) THEN GO TO ONE;
IF(R = 2) THEN GO TO TWO;
IF(R = 3) THEN GO TO THREE;
IF(R = 4) THEN GO TO FOUR;
ONE: ON ENDFILE GO TO SLUT;
READ FILE(SORTFIL) INTO (ETIKETT);
HOPP: N1 = NR;
FN = FNAMN;
EN = ENAMN;
FM = FIRMA;
AD = AVD;
BX = BOX; IF(SUBSTR(BX,1,2) = ' ') THEN BX = ADR;
PS = POST;
IF(N1> X) THEN GO TO SLUT;
GO TO NYREC;
TWO: ON ENDFILE GO TO SKRIV;
READ FILE(SORTFIL) INTO (ETIKETT);
N2 = NR;
FN2 = FNAMN;
EN2 = ENAMN;
FM2 = FIRMA;
AD2 = AVD;
BX2 = BOX; IF(SUBSTR(BX2,1,2) = ' ') THEN BX2 = ADR;
PS2 = POST;
IF(N2 >= X) THEN GO TO SKRIV;
GO TO NYREC;
THREE: ON ENDFILE GO TO SKRIV;
READ FILE(SORTFIL) INTO (ETIKETT);
N3 = NR;
FN3 = FNAMN;
EN3 = ENAMN;
FM3 = FIRMA;
AD3 = AVD;
BX3 = BOX; IF(SUBSTR(BX3,1,2) = ' ') THEN BX3 = ADR;
PS3 = POST;
IF(N3 >= X) THEN GO TO SKRIV;
GO TO NYREC;
FOUR: ON ENDFILE GO TO SKRIV;
READ FILE(SORTFIL) INTO (ETIKETT);
N4 = NR;
FN4 = FNAMN;
EN4 = ENAMN;
FM4 = FIRMA;
AD4 = AVD;
BX4 = BOX; IF(SUBSTR(BX4,1,2) = ' ') THEN BX4 = ADR;
PS4 = POST;
SKRIV:
NAM1 = FN CAT EN;
NAM2 = FN2 CAT EN2;
NAM3 = FN3 CAT EN3;
NAM4 = FN4 CAT EN4;
PUT SKIP(2) EDIT(NAM1) (A(36)) (NAM2) (A(36));
PUT EDIT(NAM3) (A(36)) (NAM4) (A(36));
PUT SKIP EDIT(FM) (A(36)) (FM2) (A(36)) (FM3) (A(36)) (FM4) (A(36));
PUT SKIP EDIT(AD) (A(36)) (AD2) (A(36)) (AD3) (A(36)) (AD4) (A(36));
PUT SKIP EDIT(BX) (A(25)) (N1) (A(11)) (BX2) (A(25)) (N2) (A(11));
PUT EDIT(BX3) (A(25)) (N3) (A(11)) (BX4) (A(25)) (N4) (A(11));
PUT SKIP EDIT(PS) (A(36)) (PS2) (A(36)) (PS3) (A(36)) (PS4) (A(36));
IF (N4>= X) THEN GO TO SLUT;
R = 0;
GO TO NYREC;
SLUT:
END;