Directory of image this file is from
This file as a plain text file
10 ;*************************************** 20 ; SOURCE PRINT0 30 ;*************************************** 40 ; 50 ;GENERATE TOP-OF-FORM ROUTINE 60 ; 70 PUTOF, CALL PUTBL 80 J=1 90 PRGLIN='XXTOF, FORMS (2,0)' 100 PLSIZ=19 110 CALL PUTPL 120 PRGSTM='INCR XXPAGE' 130 CALL PUTPL 140 PRGSTM='XXHPAG=XXPAGE' 150 PLSIZ=21 160 CALL PUTPL 170 PRGSTM=XMIT2(1) 180 PLSIZ=23 190 CALL PUTPL 200 IF (HEAD1S.NE.0) GOTO PUTOF2 210 IF (HEAD2S.EQ.0) GOTO PUTOF5 220 GOTO PUTOF3 230 PUTOF2, PRGSTM=XMIT2(2) 240 PLSIZ=23 250 CALL PUTPL 260 INCR J 270 IF (HEAD2S.EQ.0) GOTO PUTOF4 280 PUTOF3, PRGSTM=XMIT2(3) 290 PLSIZ=23 300 CALL PUTPL 310 INCR J 320 PUTOF4, PRGSTM=FORM21 330 PLSIZ=19 340 CALL PUTPL 350 INCR J 360 PUTOF5, IF (NUMHDR.EQ.0) GOTO PUTOF7 370 J=J+1+NUMHDR 380 I=1 390 PUTOF6, PRGSTM=XMIT2(4) 400 CALL BLDESD 410 PRGLIN(21,22)=DESCRP 420 PLSIZ=23 430 CALL PUTPL 440 INCR I 450 IF (I.LE.NUMHDR) GOTO PUTOF6 460 PRGSTM=FORM21 470 PLSIZ=19 480 CALL PUTPL 490 500 PUTOF7, J=60-J 510 PRGSTM='XXLINE=' 520 CALL BLDESA 530 PRGSTM(8,10)=DESCRP 540 PLSIZ=18 550 CALL PUTPL 560 IF (TOPLEV.LE.1) GOTO PUTRET 570 PRGLIN='XXTOF2,' 580 I=1 590 PUTOF8, LISTE=LISTER(I) 600 DATANE=DATANT(LISTID) 610 IF (DATALV.EQ.0) GOTO PUTOF9 620 PRGSTM='XXPF00=XX' 630 PRGLIN(18,18)=DATALV 640 DESCRP=LISTID 650 CALL BLDESC 660 PRGLIN(19,21)=DESCRP 670 CALL PUTMV0 680 PUTOF9, INCR I 690 IF (I.LE.LISTI) GOTO PUTOF8 700 GOTO PUTRET 710 ; 720 ;GENERATE COMMON TOTALER 730 ; 740 PUTOTL, IF (ACNUM.LE.0) GOTO PUTO11 750 CALL PUTBL 760 IF (TOPLEV.LE.1) GOTO PTOT8A 770 PRGLIN='XXSUM,' 780 IF (SUMARY.NE.SPACE) GOTO PUTOT4 790 PRGLIN='XXTOTX,' 800 ; 810 PUTOT4, I=1 820 PUTOT5, LISTE=LISTER(I) 830 IF (LISTAC.LE.0) GOTO PUTOT8 840 PRGSTM='XXAC00(XXLEVL+1)=XXAC00(XXLEVL+1)+XXAC00(XXLEVL)' 850 CALL BLDESB 860 PRGLIN(13,14)=DESCRP 870 PRGLIN(30,31)=DESCRP 880 PRGLIN(47,48)=DESCRP 890 PLSIZ=56 900 CALL PUTPL 910 PUTOT8, INCR I 920 IF (I.LE.LISTI) GOTO PUTOT5 930 ; 940 IF (SUMARY.EQ.SPACE) GOTO PTOT8A 950 CALL PUTRET 960 CALL PUTBL 970 PRGLIN='XXTOTX, CALL XXSUM' 980 PLSIZ=18 990 CALL PUTPL 1000 1010 PTOT8A, PRGLIN='XXTOTY,' 1020 CALL CALTOF 1030 PRGSTM='XXPLIN=' 1040 PLSIZ=15 1050 CALL PUTPL 1060 1070 I=1 1080 PUTOT9, LISTE=LISTER(I) 1090 IF (LISTAC.LE.0) GOTO PUTO10 1100 PRGSTM='XXPF00=XXAC00(XXLEVL),XXMF00' 1110 CALL BLDESB 1120 PRGLIN(20,21)=DESCRP 1130 CALL BLDESD 1140 PRGLIN(13,14)=DESCRP 1150 PRGLIN(35,36)=DESCRP 1160 PLSIZ=36 1170 CALL PUTPL 1180 PUTO10, INCR I 1190 IF (I.LE.LISTI) GOTO PUTOT9 1200 ; 1210 IF (BIGHS.LE.0) GOTO PUTO11 1220 PRGSTM='XXTOTM=XXTITL(XXLEVL)' 1230 PLSIZ=29 1240 CALL PUTPL 1250 PUTO11, PRGLIN='XXTOTZ,' 1260 PRGSTM=XMIT2(5) 1270 PLSIZ=23 1280 CALL PUTPL 1290 CALL DECLIN 1300 PRGSTM='XXPLIN=' 1310 PLSIZ=15 1320 CALL PUTPL 1330 GOTO PUTRET 1340 ; 1350 ;GENERATE COMMON RESET ROUTINE 1360 ; 1370 PUTRES, IF (ACNUM.LE.0) RETURN 1380 CALL PUTBL 1390 PRGLIN='XXRESX,' 1400 I=1 1410 PTRES1, LISTE=LISTER(I) 1420 IF (LISTAC.LE.0) GOTO PTRES4 1430 PRGSTM='XXAC00(XXLEVL)=' 1440 CALL BLDESB 1450 PRGLIN(13,14)=DESCRP 1460 PLSIZ=23 1470 CALL PUTPL 1480 PTRES4, INCR I 1490 IF (I.LE.LISTI) GOTO PTRES1 1500 GOTO PUTRET 1510 ; 1520 ;GENERATE MASKS FOR DECIMAL ITEMS 1530 ; 1540 PUTMSK, I=1 1550 FINDSW= 1560 PTMSK1, LISTE=LISTER(I) 1570 DATANE=DATANT(LISTID) 1580 IF (DATAM.NE.'D') GOTO PTMSK9 1590 PTMSK6, IF (FINDSW.NE.SPACE) GOTO PTMSK8 1600 FINDSW='X' 1610 CALL PUTBL 1620 PRGLIN=GENREC(7) 1630 PLSIZ=25 1640 CALL PUTPL 1650 PTMSK8, PRGLIN='XXMF00,' 1660 CALL BLDESD 1670 PRGLIN(5,6)=DESCRP 1680 J=LISTIS 1690 CALL BLDESE 1700 PRGLIN(PLSIZ-LISTIS,PLSIZ-1)=LISTPC 1710 PRGLIN(PLSIZ,PLSIZ)=SQUOTE 1720 CALL PUTPL 1730 1740 1750 PTMSK9, INCR I 1760 IF (I.LE.LISTI) GOTO PTMSK1 1770 RETURN 1780 ; 1790 ;GENERATE USER'S HEADER RECORDS 1800 ; 1810 PUTUHD, IF (NUMHDR.EQ.0) RETURN 1820 CALL PUTBL 1830 I=1 1840 PTUHD1, PRGLIN='RECORD XXHD' 1850 CALL BLDESD 1860 PRGLIN(13,14)=DESCRP 1870 PLSIZ=14 1880 CALL PUTPL 1890 OCOL= 1900 HCOL= 1910 K=1 1920 PTUHD2, LISTE=LISTER(K) 1930 OCOL=OCOL+LISTFS 1940 IF (LISTWN.GE.LISTHS) GOTO PTUHD9 1950 J=LISTWN 1960 GOTO PTUHD4 1970 PTUHD3, INCR J 1980 PTUHD4, IF (J.GT.LISTHS) GOTO PTUHD5 1990 IF (LISTIT(J,J).NE.'*') GOTO PTUHD3 2000 PTUHD5, HOLDHS=J-LISTWN 2010 IF (HOLDHS.EQ.0) GOTO PTUHD8 2020 J=LISTIS 2030 DATANE=DATANT(LISTID) 2040 IF (DATAM.NE.'D') GOTO PTUHD6 2050 IF (LISTPC(LISTIS,LISTIS).NE.'-') GOTO PTUH5A 2060 J=J-1 2070 PTUH5A, INCR J 2080 PTUHD6, J=J/2-HOLDHS/2+OCOL-HCOL 2090 IF (J.LE.0) GOTO PTUHD7 2100 HCOL=HCOL+J 2110 CALL PUTFIL 2120 PTUHD7, PRGLIN=',' 2130 J=HOLDHS 2140 CALL BLDESE 2150 PRGLIN(PLSIZ-HOLDHS,PLSIZ-1)=LISTIT(LISTWN,LISTWN+HOLDHS-1) 2160 CALL PUTPL 2170 HCOL=HCOL+HOLDHS 2180 PTUHD8, LISTWN=LISTWN+HOLDHS+1 2190 PTUHD9, OCOL=OCOL+LISTIS 2200 LISTER(K)=LISTE 2210 INCR K 2220 IF (K.LE.LISTI) GOTO PTUHD2 2230 2240 INCR I 2250 IF (I.LE.NUMHDR) GOTO PTUHD1 2260 RETURN 2270 ; 2280 ;ASSIGN ASCENDING VALUES TO THE LEVELS 2290 ; 2300 SETLEV, I=1 2310 J=1 2320 SETLV1, IF (LEVELS(I).EQ.SPACE) GOTO SETLV2 2330 HIBRK=LEVELS(I) 2340 LEVELN(I)=J 2350 INCR J 2360 IF (J.NE.2) GOTO SETLV2 2370 LOBRK=LEVELS(I) 2380 SETLV2, INCR I 2390 IF (I.LE.9) GOTO SETLV1 2400 TOPLEV=J 2410 LEVELS(10)='A' 2420 LEVELN(10)=TOPLEV 2430 TOPFLG=LEVELN(TOPFLG) 2440 RETURN 2450 ; 2460 ;PUT OUT A BLANK LINE 2470 ; 2480 PUTBL, PLSIZ=1 2490 PRGLIN=';' 2500 ; 2510 ;PUT OUT A PROGRAM LINE 2520 ; 2530 PUTPL, XMIT (4,PRGREC(1,PLSIZ+2)) 2540 IF (LPTSW.EQ.SPACE) GOTO PUTPL1 2550 ERRLIN=PRGLIN 2560 IF (LINES.LE.0) CALL LSTOP 2570 ERRLNM=ERRLNM+5 2580 XMIT (2,ERRECD(1,PLSIZ+7)) 2590 LINES=LINES-1 2600 PUTPL1, PRGLIN= 2610 RETURN 2620 ; 2630 ;BUILD DESCRIPTOR - LEFT JUSTIFIED 2640 ; 2650 BLDESA, DESCRP= 2660 IF (J.LE.9) GOTO BLDES2 2670 IF (J.LE.99) GOTO BLDES1 2680 DESCRP=J 2690 RETURN 2700 BLDES1, DESCRP(1,2)=J(2,3) 2710 RETURN 2720 BLDES2, DESCRP(1,1)=J(3,3) 2730 RETURN 2740 ; 2750 ;GET AC NUMBER AS TWO-DIGIT FIELD 2760 ; 2770 BLDESB, DESCRP(1,2)=LISTAC 2780 IF (LISTAC.GE.10) RETURN 2790 DESCRP(1,1)='0' 2800 RETURN 2810 ; 2820 ;CONVERT 'I' TO TWO-DIGIT ALPHA 2830 ; 2840 BLDESD, DESCRP(1,2)=I(2,3) 2850 ; 2860 ;GET A RIGHT-JUSTIFIED 3-DIGIT FIELD INTO ALPHA 2870 ; 2880 BLDESC, IF (DESCRP(1,1).NE.SPACE) RETURN 2890 DESCRP(1,1)='0' 2900 IF (DESCRP(2,2).NE.SPACE) RETURN 2910 DESCRP(2,2)='0' 2920 IF (DESCRP(3,3).NE.SPACE) RETURN 2930 DESCRP(3,3)='0' 2940 RETURN 2950 ; 2960 ;GENERATE 'A' DESCRIPTOR 2970 ; 2980 BLDESE, CALL BLDESA 2990 PLSIZ=12 3000 IF (J.GT.99) GOTO BLESE2 3010 IF (J.GT.9) GOTO BLESE1 3020 INCR PLSIZ 3030 BLESE1, INCR PLSIZ 3040 BLESE2, PRGSTM='A' 3050 PRGLIN(10,PLSIZ-2)=DESCRP(1,PLSIZ-11) 3060 PRGLIN(PLSIZ-1,PLSIZ-1)=',' 3070 PRGLIN(PLSIZ,PLSIZ)=SQUOTE 3080 PLSIZ=PLSIZ+J+1 3090 PRGLIN(PLSIZ,PLSIZ)=SQUOTE 3100 RETURN 3110 ; 3120 ; GENERATE MOVE OF DETAIL ITEM 3130 ; 3140 PUTMOV, PRGSTM='XXPF00=' 3150 PRGLIN(16,21)=DATANM 3160 PUTMV0, CALL BLDESD 3170 PRGLIN(13,14)=DESCRP 3180 PLSIZ=21 3190 PUTMV1, IF(PRGLIN(PLSIZ,PLSIZ).NE.SPACE) GOTO PUTMV2 3200 PLSIZ=PLSIZ-1 3210 GOTO PUTMV1 3220 PUTMV2, IF (DATAM.NE.'D') GOTO PUTMV3 3230 PRGLIN(PLSIZ+1,PLSIZ+5)=',XXMF' 3240 PRGLIN(PLSIZ+6,PLSIZ+7)=PRGLIN(13,14) 3250 PLSIZ=PLSIZ+7 3260 PUTMV3, GOTO PUTPL 3270 ; 3280 ;GENERATE DATA DESCRIPTOR 3290 ; 3300 PUTDAT, PRGLIN=DATANM 3310 J=6 3320 PUTDT2, IF (PRGLIN(J,J).NE.SPACE) GOTO PUTDT3 3330 J=J-1 3340 IF (J.GT.0) GOTO PUTDT2 3350 PUTDT3, INCR J 3360 PRGLIN(J,J)=',' 3370 PRGLIN(9,9)=DATAM 3380 J=DATAS 3390 CALL BLDESA 3400 PRGLIN(10,12)=DESCRP 3410 PLSIZ=12 3420 GOTO PUTPL 3430 ; 3440 ;GENERATE TEST FOR END OF PAGE 3450 ; 3460 CALTOF, PRGSTM='IF (XXLINE.LE.0) CALL XXTOF' 3470 PLSIZ=35 3480 GOTO PUTPL 3490 ; 3500 ;GENERATE 'FORMS(2,1)' 3510 ; 3520 BLANKL, IF (ACNUM.EQ.0) RETURN 3530 PRGSTM=FORM21 3540 PLSIZ=19 3550 CALL PUTPL 3560 ; 3570 ;GENERATE DECREMENT TO XXLINE 3580 ; 3590 DECLIN, PRGSTM='XXLINE=XXLINE-1' 3600 PLSIZ=23 3610 GOTO PUTPL 3620 ; 3630 ;GENERATE 'RETURN' 3640 ; 3650 PUTRET, PRGSTM='RETURN' 3660 PLSIZ=14 3670 GOTO PUTPL 3680 ; 3690 ;GENERATE FILLER 3700 ; 3710 PUTFIL, PRGLIN=PREC01 3720 CALL BLDESA 3730 PRGLIN(10,12)=DESCRP 3740 PLSIZ=12 3750 GOTO PUTPL 3760 ; 3770 ;PUT OUT FIRST TOP-OF-FORM 3780 ; 3790 STARTL, IF (LPTOPN.NE.SPACE) GOTO LSTOP1 3800 ; 3810 ;PUT OUT TOP-OF-FORM 3820 ; 3830 LSTOP, FORMS (2,0) 3840 LSTOP1, INCR PAGES 3850 SHPAGE=PAGES 3860 XMIT (2,SHDR) 3870 FORMS (2,1) 3880 LINES=58 3890 RETURN 3900 END