0001 SETESC 8800; SETERR 8900
0010 REM "gen6temp - TEMPLATE FOR REPORTS
0020 REM "COPYRIGHT (C) 1992 BY ALLEN D. MIGLORE.  ALL RIGHTS RESERVED.
0100 REM ^100 - TEST FOR CALL
0110 CALL "gen6-lan","","gen6temp",GBL$[ALL],MSG$[ALL],EMSG$; IF EMSG$>"" THEN GOTO 8970
0120 LET MEMERR=0,CLRREM=0
0130 ENTER P$
0140 LET CALLED_FLAG=1,LOGONLY=0
0150 LET GEN6MST=NUM(STBL("*GEN6MST"))
0160 PRECISION 9
0170 SETERR 8900; GOTO 0200
0200 REM ^100 - INITIALIZE
0305 REM 305
0310 REM 310
0320 REM 320
0330 REM 330
0340 REM 340
0350 REM 350
0360 REM 360
0370 REM 370
0380 REM 380
0390 REM 390
0400 REM ^100,5 - FIXED INITS
0405 IF PFILE$="" THEN GOTO 9000 ELSE IF STBL("*GENDEBUG",ERR=0415)="Y" THEN ESCAPE
0410 CALL "gen6-rtb",P$,MSG$[ALL],GBL$[ALL],FKEY1$,FKEY2$,PAGEDSC$,STOPMSG$,INTRMSG$
0415 DIM BK$[9]; IF FLDS>=0 THEN DIM FLD$[FLDS+1],FLD[FLDS+1]
0420 LET VDTOFFSET=1,PIDX=0,PIDX$="",SORTED=0,SAVEDUP$="",SAVE_NO_BLANK=NO_BLANK,SKIP=0,ERROR_LIST$="",STARTTIME=JUL(0,0,0)+TIM/24,EXECUTOR$=FID(0),DT1$=DAY,DT2$=DT1$(7,2)+DT1$(1,2)+DT1$(4,2),HEADER_OFF=1,SORTING=0,PFILE=1,LBREAKCNT=1,COMMAND$="",SUBTOTAL_ON=0,GOTO_END=0,DONE=0,GEN_HOST$=STBL("*GEN_HOST"); IF ALTFILE$>"" THEN LET ALTFILE=1 FI; LET DSPMOD=10,DSPMOD=NUM(STBL("*GENDISPMOD",ERR=0425))
0425 IF PRINTER$="" THEN LET PRINTER$="VDT"
0430 LET DOS_CR$=""; IF NUM(STBL("*GEN_DOSWIN")) AND PRINTER$<>"VDT" AND PRINTER$<>"PREVIEW" AND EXPORT$<>"WORDPERFECT" AND STBL("*GEN_HOST")<>"3" THEN LET DOS_CR$=$0D$
0435 LET FILECOUNT=0; IF ALTFILE$>"" THEN FOR I=1 TO LEN(ALTFILE$)/2; CALL "gen6-fst",P$,DEC(ALTFILE$(I*2-1,2)),"",0,0,WREC,""; LET FILECOUNT=FILECOUNT+WREC; NEXT I ELSE FOR I=1 TO LEN(PFILE$)/2; CALL "gen6-fst",P$,DEC(PFILE$(I*2-1,2)),"",0,0,WREC,""; LET FILECOUNT=FILECOUNT+WREC; NEXT I
0440 LET EXTERN=NUM(EXTERN$(1,1)); IF EXTERN=1 THEN LET EXTBLOCK=NUM(EXTERN$(2)) FI; IF EXTERN=2 THEN LET EXTBLOCK=2048,EXTDELIM$=FNTRIM$(EXTERN$(2)) FI; IF EXTERN=2 AND POS("~"=EXTDELIM$)=1 THEN LET EXTDELIM$=CHR(NUM(EXTDELIM$(2))) FI
0445 LET FLDTERM$=$0A$; IF EXTERN=2 THEN LET FLDTERM$=EXTDELIM$; GOTO 0455 ELSE IF STBL("*GEN_HOST")="1" THEN GOTO 0455
0450 FLDTERM$=SEP; REM "NON-BBX
0455 IF DICTTYPE=1 THEN CALL "gen6-fst",P$,DEC(PFILE$(1,2)),"",FLX_KYLEN,0,0,""
0460 IF DICTTYPE=1 THEN IF FIRSTKEY$="" THEN LET FIRSTKEY$=FNRIGHT$("!",FLX_KYLEN)
0465 IF DICTTYPE=1 THEN IF LASTKEY$="" THEN LET LASTKEY$=$80$
0470 LET ACROSS=MAX(ACROSS,1); IF ACROSS>1 THEN DIM LABELBUF$[MAX(MAXROW,HEIGHT)]
0475 CALL "gen6-fst",P$,0,PTYPE$,0,PCOLS,PROWS,""
0480 CALL "gen6-fst",P$,DEC(PFILE$(1,2)),PF_TYPE$,0,PFRSZ,PFRCS,""
0485 IF PF_TYPE$="IND" THEN IF LASTKEY$="" THEN LET LASTKEY$="999999999999"
0490 IF EXTERN=2 THEN IF STBL("*GEN_HOST")="2" THEN LET EXTBLOCK=512; REM "TBRED DEFAULTS TO 512 BLOCK SIZE ON ASCII FILES
0495 GOSUB 19000; REM "GET USER DEFINED VARIABLES
0500 REM ^100 - CREATE SORT FILE, IF REQUIRED
0510 CALL "gen6-rt1",P$,MSG$[ALL],ERRMSG$,SORT_REQUIRED,TWO_PASS,PFILE$,EXTERN,EXTPOS,EXTWKFL,EXTWKFL$,MAXKEY,SORTSIZE,SORTFILE,SORTFILE$,SUMMARY,SUMFILE$,TWOKEY,TWOPASS_FILE,TWOPASS_FILE$,TWOREC
0520 IF ERRMSG$>"" THEN GOTO 9000
0530 IF SORT_REQUIRED OR TWO_PASS OR CROSSTAB THEN CALL "gen6-rte",P$,TWO_PASS,PCOLS,INTRMSG$,MSG$[ALL],SSWINDOW,SSMSK$; IF SSWINDOW=0 THEN GOTO 9000
0540 REM "setup for excel/gui
0550 IF CVS(EXPORT$,7)<>"EXCEL" AND PRINTER$="VDT" AND SSWINDOW=0 AND PFILE<2 THEN GOSUB 8070
0560 LET TOCLIENT=0; IF STBL("$gen60d",ERR=0700)>"" THEN IF POS(" "+PRINTER$+" "=" PC PCPTR PCFILE ")>0 OR CROSSTAB THEN CLOSE (PRINTER); LET PRINTER=NUM(STBL("$genrpt")),TOCLIENT=1,PRINTER_OPEN=1 ELSE GOTO 0700
0570 IF PAGELEN=0 THEN LET PAGELEN=60+6*(WIDTH*ACROSS>=96) FI; LET LINENO=PAGELEN+1
0580 IF CROSSTAB THEN PRINT (PRINTER)"crosstab"; GOTO 0700
0590 IF EXPORT$="EXCEL" THEN PRINT (PRINTER)STBL("*GEN_EXCEL_SETUP")+$09$+TITLE$+$09$+CVS(P$(206,40),3); GOTO 0700
0600 IF PRINTER$<>"PCFILE" THEN PRINT (PRINTER)$14$,ROWHDR$; PRINT (PRINTER)$15$,HTA(ROWFLD$); PRINT (PRINTER)$16$,STR(WIDTH)+$09$+STR(ACROSS)+$09$+STR(PAGELEN)+$09$+TITLE$+$09$+STR(COPIES); PRINT (PRINTER)$17$,ROWAGG$
0700 REM ^100 - POSITION FILE
0710 IF EXTERN THEN LET EXTIND=0,EXTEOF=0,EXTBLOCK$="",EXTLAST$=""; GOTO 0800
0720 IF ALTFILE THEN EXTRACT (DEC(ALTFILE$(ALTFILE*2-1,2)),KEY=FIRSTKEY$,DOM=0800,ERR=0800,TIM=0)
0725 IF ALTKEY THEN LET ALTDSND=0,ALTFIN$=FIN(DEC(PFILE$(PFILE*2-1,2))); IF LEN(ALTFIN$)>86 THEN LET ALTFIN$=ALTFIN$(86),ALTKEYPOS=POS(CHR(ALTKEY-1)=ALTFIN$,8); IF ALTKEYPOS>0 THEN IF AND($01$,ALTFIN$(ALTKEYPOS+5,1))=$01$ THEN LET ALTDSND=1; REM "adm 7/31/15 look for descending alt key
0730 IF ALTKEY THEN READ (DEC(PFILE$(PFILE*2-1,2)),KEY=FIRSTKEY$,KNUM=ALTKEY-1,DOM=0800,ERR=8060)
0740 IF PF_TYPE$="IND" THEN EXTRACT (DEC(PFILE$(PFILE*2-1,2)),IND=NUM(FIRSTKEY$),DOM=0800,ERR=0800,TIM=0)
0750 EXTRACT (DEC(PFILE$(PFILE*2-1,2)),KEY=FIRSTKEY$,DOM=0800,ERR=0800,TIM=0)
0800 REM ^100
1000 REM 1000,5 - READ FILE
1005 IF FLDS>=0 THEN DIM FLD$[FLDS+1],FLD[FLDS+1]
1010 IF GEN_HOST$<>"1" THEN GOTO 1020
1015 IF SORTED THEN IF CVS(SYS,3)="LEVEL 3" THEN IF REV<"REV 2.0" THEN LET TRASH$=KEY(SORTFILE,END=4000); REM "PATCH FOR OLD BBX3 BUG
1020 IF SORTED THEN READ RECORD(SORTFILE,END=4000)KY$; LET PFILE=ASC(KY$(1,1)),KY$=KY$(2-SGN(EXTERN)); IF EXTERN=0 THEN LET KY$=KY$(1,POS($00$<>KY$,-1)) FI; LET GO_UNTIL_FOUND=0; GOTO 1065
1025 IF ALTFILE=0 THEN GOTO 1040 ELSE LET K$=KEY(DEC(ALTFILE$(ALTFILE*2-1,2)),END=4000); IF K$>LASTKEY$+$FF$ THEN GOTO 4000 ELSE READ (DEC(ALTFILE$(ALTFILE*2-1,2)))
1030 REM 1030,5 - ALTFILE KEY SET
1035 LET PFILE=1,GO_UNTIL_FOUND=1; GOTO 1065
1040 IF ALTKEY=0 THEN GOTO 1050 ELSE LET KY$=KEY(DEC(PFILE$(PFILE*2-1,2)),KNUM=0,END=4000),AKY$=KEY(DEC(PFILE$(PFILE*2-1,2)),END=4000)
1044 IF ALTDSND=1 AND AKY$<LASTKEY$ THEN GOTO 4000; REM "adm 7/27/15 
1045 IF ALTDSND=0 AND AKY$>LASTKEY$+$FF$ THEN GOTO 4000
1046 READ RECORD(DEC(PFILE$(PFILE*2-1,2)))DATAREC$; GOTO 1090
1050 IF EXTERN THEN GOSUB 11600; IF EXTEOF THEN GOTO 4000 ELSE GOTO 1090
1055 IF PF_TYPE$="IND" THEN LET KY=IND(DEC(PFILE$(PFILE*2-1,2)),END=4000); IF KY>NUM(LASTKEY$) THEN GOTO 4000 ELSE LET KY$=STR(KY); READ RECORD(DEC(PFILE$(PFILE*2-1,2)),END=4000)DATAREC$; GOTO 1090
1060 LET KY$=KEY(DEC(PFILE$(PFILE*2-1,2)),END=4000); IF KY$>LASTKEY$+$FF$ THEN GOTO 4000 ELSE IF PF_TYPE$<>"SRT" THEN READ RECORD(DEC(PFILE$(PFILE*2-1,2)))DATAREC$; GOTO 1090 ELSE LET DATAREC$=""; READ (DEC(PFILE$(PFILE*2-1,2))); GOTO 1090
1065 REM "LOOK FOR HIT FROM ALTERNATE/SORT FILE
1070 IF EXTERN THEN READ RECORD(EXTWKFL,IND=DEC($00$+KY$(1,4)),SIZ=DEC($00$+KY$(5,2)),ERR=1085)DATAREC$; GOTO 1090
1075 IF PF_TYPE$="IND" THEN READ RECORD(DEC(PFILE$(PFILE*2-1,2)),IND=NUM(KY$),DOM=1085)DATAREC$; GOTO 1090
1080 IF PF_TYPE$<>"SRT" THEN READ RECORD(DEC(PFILE$(PFILE*2-1,2)),KEY=KY$,DOM=1085)DATAREC$; GOTO 1090 ELSE LET DATAREC$=""; GOTO 1090
1085 IF GO_UNTIL_FOUND AND PFILE<LEN(PFILE$)/2 THEN LET PFILE=PFILE+1; GOTO 1065 ELSE GOTO 1000
1090 IF SKIP_KEYS$>"" THEN LET SKIP=POS(SKIP_KEYS$(1,1)+KY$+SKIP_KEYS$(1,1)=SKIP_KEYS$) FI; IF SKIP THEN GOTO 1000 FI; LET RC=RC+1; IF SORTED OR TWO_PASS=3 OR (SELECT_REQUIRED=0 AND TWO_PASS=2) THEN GOTO 1400 ELSE IF TWO_PASS=2 OR TWO_PASS=3 THEN GOTO 1200
1100 REM ^100 - COUNTER
1110 LET PS=PS+1
1200 REM ^100,5 - SELECTION CRITERIA
1205 IF SELECT_REQUIRED OR SORT_REQUIRED THEN LET REQFLD$=REQFLD2$; GOSUB 11000; GOSUB 27000 FI; IF SELECT_REQUIRED=0 THEN GOTO 1240 ELSE GOSUB 20000
1220 REM 1220 - SELECT
1230 IF NOPASS THEN GOTO 1355
1240 LET SL=SL+1
1250 IF SORT_PASS THEN GOTO 1355
1300 REM ^100,5 - SORT FILE
1305 IF SORT_REQUIRED=0 THEN GOTO 1355 ELSE GOSUB 23000
1320 REM 1320,5 - SORT KEY
1325 LET WREC$=CHR(PFILE)+KY$; IF EXTERN THEN LET WREC$=BIN(EXTPOS,4)+BIN(LEN(DATAREC$),2),EXTPOS=EXTPOS+LEN(DATAREC$); WRITE RECORD(EXTWKFL,SIZ=LEN(DATAREC$))DATAREC$
1330 IF LEN(SORTKEY$)>MAXKEY THEN LET SORTKEY$=SORTKEY$(1,MAXKEY)
1335 LET SORTKEY$=SORTKEY$+BIN(1,2); GOTO 1345
1340 LET X=LEN(SORTKEY$),SORTKEY$(X-1,2)=BIN(1+DEC($00$+SORTKEY$(X-1,2)),2)
1345 WRITE RECORD(SORTFILE,KEY=SORTKEY$,DOM=1340)WREC$; LET SORTING=1
1350 IF STBL("$gen60d",ERR=1355)>"" THEN CALL STBL("genstat"),"4",MSG$[15]+" "+STR(RC)+", "+MSG$[16]+" "+STR(SL); GOTO 1360
1355 IF SSWINDOW THEN IF MOD(RC,DSPMOD)=0 THEN PRINT @(1,2+INT(TWO_PASS/2)),RC:SSMSK$,@(15,2+INT(TWO_PASS/2)),SL:SSMSK$,
1360 IF NOPASS=0 THEN IF TWO_PASS=1 OR SORT_REQUIRED=0 THEN GOTO 1400
1365 GOTO 1000
1400 REM ^100,5 - BUILD DATA FOR OUTPUT
1405 LET REQFLD$=REQFLD1$; GOSUB 11000; GOSUB 25000; GOSUB 50000
1410 IF TWO_PASS<>1 AND TWO_PASS<>3 THEN LET PRINTED=PRINTED+1
1415 IF STBL("$gen60d",ERR=1420)>"" THEN IF TWO_PASS<>1 AND TWO_PASS<>3 THEN IF MOD(PRINTED,DSPMOD)=0 THEN CALL STBL("genstat"),"4",MSG$[22]+" "+STR(PRINTED)+" "+MSG$[23]+" "+STR(SL*(SORTED>0)+FILECOUNT*(SORTED=0))+" "+FNLEFT$(MSG$[24],LEN(MSG$[24])*(SORTED=0)); GOTO 1430
1420 IF TWO_PASS<>1 AND TWO_PASS<>3 THEN IF PTRWINDOW THEN IF MOD(PRINTED,DSPMOD)=0 THEN PRINT @(0,2),PRINTED:SSMSK$,
1430 REM 1430 - STOP LINES TEST
1500 REM ^100 - CHECK FOR BREAK POINTS - SAVE OUTPUT
1600 REM ^100 - SET BREAKS / SUPPRESS DUPLICATES
1610 IF TWO_PASS=1 THEN GOSUB 2110; GOTO 1000 ELSE IF TWO_PASS=3 THEN GOTO 1100
1620 REM 1620,5
1625 IF WIDTH>0 AND NOPAGE=0 THEN LET WX=LEN(OUTLINE$)/WIDTH; IF WX>0 THEN IF PAGELEN/WX>4 THEN IF LINENO+WX>=PAGELEN THEN LET LINENO=PAGELEN+1; REM "BLOCK TOGETHER, IF NOT TOO LARGE
1630 IF OUTLINE$="" THEN GOTO 2070 ELSE IF (NO_DUP$="" OR MREF_PASS) THEN GOTO 1700 ELSE LET XXNDP=1
1635 LET NEWPAGE$="",PRINTITS=0; FOR X=1 TO LEN(OUTLINE$)/WIDTH; IF NO_BLANK=0 OR FNTRIM$(OUTLINE$((X-1)*WIDTH+1,WIDTH))>"" THEN LET PRINTIT=1 ELSE LET PRINTIT=0 FI; LET PRINTITS=PRINTITS+PRINTIT; IF PRINTITS+LINENO-1>PAGELEN THEN LET NEWPAGE$=NEWPAGE$+"Y" ELSE LET NEWPAGE$=NEWPAGE$+"N" FI; NEXT X
1640 FOR X=1 TO LEN(NO_DUP$) STEP 8
1645 LET WPOS=NUM(NO_DUP$(X,4)),WLEN=NUM(NO_DUP$(X+4,4)),CLEARDUP=0; IF XXNDP<LEN(SAVEDUP$) THEN IF OUTLINE$(WPOS,WLEN)=SAVEDUP$(XXNDP,WLEN) THEN LET CLEARDUP=1
1650 IF XXNDP<LEN(SAVEDUP$) THEN LET SAVEDUP$(XXNDP,WLEN)=OUTLINE$(WPOS,WLEN) ELSE LET SAVEDUP$=SAVEDUP$+OUTLINE$(WPOS,WLEN)
1655 LET XXNDP=XXNDP+WLEN; IF CLEARDUP AND (NEWPAGE$(1+INT((WPOS-1)/WIDTH),1)="N" OR NOPAGE=1) THEN LET OUTLINE$(WPOS,WLEN)=""
1660 NEXT X
1700 REM ^100
1710 IF NO_DETAIL THEN GOTO 2070
1800 REM ^100 - HEIGHT FORCE
1810 IF HEIGHT THEN LET OUTLINE$=FNLEFT$(OUTLINE$,HEIGHT*WIDTH)
1820 IF MREF_PASS THEN IF LITPOS$>"" THEN FOR X=1 TO LEN(LITPOS$)/4; LET OUTLINE$(DEC(LITPOS$(X*4-3,2)),DEC(LITPOS$(X*4-1,2)))=""; NEXT X
2000 REM 2000,5 - PRINT LINE
2005 IF EXPORT$>"" THEN LET LINE$=PREFX$+OUTLINE$+SUFFIX$; GOSUB 3000; GOTO 2070
2010 IF TESTPRINT=0 THEN GOTO 2020 ELSE LET TESTREC=1,TESTSAVE$=OUTLINE$
2015 FOR X=1 TO LEN(OUTLINE$); IF OUTLINE$(X,1)<>" " THEN LET OUTLINE$(X,1)="*" FI; NEXT X
2020 IF ACROSS>1 THEN GOSUB 15000; GOTO 2050
2025 LET SKIPPED=0
2030 FOR LN=1 TO LEN(OUTLINE$)/WIDTH
2035 LET MAPLN=LN,LINE$=OUTLINE$(LN*WIDTH-WIDTH+1,WIDTH); IF NO_BLANK=0 THEN GOSUB 3000 ELSE IF FNTRIM$(LINE$)>"" THEN GOSUB 3000 ELSE LET SKIPPED=SKIPPED+1
2040 NEXT LN
2045 IF SKIPPED AND HEIGHT THEN FOR XXSLN=1 TO SKIPPED; LET LINE$=""; GOSUB 3000; NEXT XXSLN
2050 IF TESTPRINT=-1 AND ACROSS>1 AND ACROSS_P=0 THEN GOTO 2020 FI; IF TESTPRINT=-1 THEN CLOSE (PRINTER); OPEN (PRINTER)FID(0); LET PRINTER_OPEN=0; GOSUB 8120
2055 IF TESTPRINT=-1 THEN IF DOTEST=1 THEN GOTO 2020 ELSE LET OUTLINE$=TESTSAVE$,TESTSAVE$="",TESTPRINT=0; IF ACROSS>1 THEN GOTO 2020
2060 IF TESTPRINT THEN IF TESTREC<TESTPRINT THEN LET TESTREC=TESTREC+1; GOTO 2020 ELSE LET OUTLINE$=TESTSAVE$,TESTSAVE$="",TESTPRINT=0; IF ACROSS>1 THEN GOTO 2020
2065 LET SAVE_OUTLINE$=OUTLINE$; IF LBREAK THEN IF LBREAKCNT>0 AND MOD(LBREAKCNT,LBREAK)=0 THEN LET LINE$="",LBREAKCNT=1; GOSUB 3000 ELSE LET LBREAKCNT=LBREAKCNT+1
2070 GOSUB 2120
2075 IF MORE_MREF THEN LET MREF_PASS=1; GOSUB 25000
2080 IF MORE_MREF THEN LET MREF_PASS=1,NO_BLANK=1; GOSUB 50000; GOTO 1620 ELSE LET MREF_PASS=0,NO_BLANK=SAVE_NO_BLANK
2085 IF DOUBLE_SPACE AND NO_DETAIL=0 AND ACROSS<2 THEN LET LINE$=""; GOSUB 3000
2090 LET KY$=STBL("*GEN_LK",KY$),DATAREC$=STBL("*GEN_LD",DATAREC$)
2095 GOTO 1000
2100 REM ^100 - SUB-TOTAL ACCUMULATORS
2110 REM 2110
2120 REM 2120
2130 RETURN 
2200 REM ^100
2300 REM 2300,3 - SUB-TOTAL BREAK POINTS (GOSUB TARGET)
2303 IF ACROSS>1 THEN IF LABELBUF$[1]>"" THEN GOSUB 15100
2306 LET SUBTOTAL_ON=1,LBREAKCNT=1; FOR LEVEL=MAXBREAK TO BRKLEVEL STEP -1
2309 IF LEVEL AND BK$[LEVEL]="" OR TWO_PASS=3 THEN GOTO 2349
2315 REM 2315,5
2320 REM 2320,5
2325 REM 2325,3 - RENUMBER @3
2328 IF FNTRIM$(FOOTER$)="" THEN GOTO 2349
2331 IF NO_DETAIL THEN IF LEVEL=0 OR (CFT$(LEVEL+1,1)<>"1" AND VERT_TOTAL>0) THEN LET LINE$=""; GOSUB 3000
2334 FOR XXFLN=1 TO LEN(FOOTER$) STEP WIDTH*ACROSS
2337 LET MAPLN=1+INT(XXFLN/WIDTH*ACROSS),LINE$=FOOTER$(XXFLN); IF LEN(LINE$)>WIDTH*ACROSS THEN LET LINE$=LINE$(1,WIDTH*ACROSS)
2340 IF CFT$(LEVEL+1,1)<>"1" AND NO_DETAIL=1 AND LEVEL=MAXBREAK AND FNTRIM$(LINE$)>"" AND VERT_TOTAL=0 THEN LET X$=FNTRIM$(LINE$); FOR X=1 TO LEN(X$); IF POS(X$(X,1)="- ")=0 THEN EXITTO 2343 FI; NEXT X; GOTO 2346; REM "SKIP OF UNDERLINES
2343 IF NO_DETAIL=0 OR CFT$(LEVEL+1,1)="1" OR (NO_DETAIL=1 AND (LEVEL<MAXBREAK OR MAXBREAK=0)) OR (NO_DETAIL=1 AND FNTRIM$(LINE$)<>"" AND FNTRIM$(LINE$)<>"." AND FNTRIM$(LINE$)<>"@LINE") THEN GOSUB 3000
2346 NEXT XXFLN
2349 IF RESTORE_REC THEN GOSUB 10950 FI; IF LEVEL>0 THEN ON LEVEL-1 GOSUB 2510,2520,2530,2540,2550,2560,2570,2580,2590
2352 IF TWO_PASS AND LEVEL THEN ON LEVEL-1 GOSUB 2710,2720,2730,2740,2750,2760,2770,2780,2790
2355 IF TWO_PASS THEN GOSUB 50000
2358 NEXT LEVEL
2361 IF STBL("*GENNDPBRK",ERR=2400)="Y" THEN LET SAVEDUP$=""
2400 REM 2400,3 - HEADER
2403 IF BRKLEVEL=0 OR DONE OR TWO_PASS=3 THEN GOTO 2465
2406 FOR LEVEL=BRKLEVEL TO MAXBREAK
2410 REM 2410 - HEADER DATA ASSIGNMENT
2420 REM 2420,5
2425 IF HDR$="" THEN GOTO 2455
2430 FOR XXHLN=1 TO LEN(HDR$) STEP WIDTH*ACROSS
2435 LET MAPLN=1+INT(XXHLN/WIDTH*ACROSS),LINE$=HDR$(XXHLN); IF LEN(LINE$)>WIDTH*ACROSS THEN LET LINE$=LINE$(1,WIDTH*ACROSS)
2440 IF NO_DETAIL=1 AND FNTRIM$(LINE$)>"" AND LEVEL<>0 THEN LET X$=FNTRIM$(LINE$); FOR X=1 TO LEN(X$); IF POS(X$(X,1)="- ")=0 THEN EXITTO 2445 FI; NEXT X; GOTO 2450; REM "SKIP OF UNDERLINES
2445 IF NO_DETAIL=0 OR LEVEL=BRKLEVEL OR LEVEL=0 OR (NO_DETAIL=1 AND FNTRIM$(LINE$)<>"" AND FNTRIM$(LINE$)<>"." AND FNTRIM$(LINE$)<>"@LINE") THEN GOSUB 3000
2450 NEXT XXHLN
2455 IF LEVEL=0 THEN RETURN 
2460 NEXT LEVEL
2465 LET SUBTOTAL_ON=0; RETURN 
2500 REM 2500 - INITIALIZE ACCUMULATORS, BREAK POINT VALUES
2510 REM 2510
2520 REM 2520
2530 REM 2530
2540 REM 2540
2550 REM 2550
2560 REM 2560
2570 REM 2570
2580 REM 2580
2590 REM 2590
2600 REM 2600 - WRITE ACCUMULATORS TO WORK FILE (ON FIRST OF TWO PASSES)
2610 REM 2610
2620 REM 2620
2630 REM 2630
2640 REM 2640
2650 REM 2650
2660 REM 2660
2670 REM 2670
2680 REM 2680
2690 REM 2690
2700 REM 2700 - READ ACCUMULATORS FROM WORK FILE
2710 REM 2710
2720 REM 2720
2730 REM 2730
2740 REM 2740
2750 REM 2750
2760 REM 2760
2770 REM 2770
2780 REM 2780
2790 REM 2790
2800 REM 2800 - DOM FROM READ (RETURN)
2810 RETURN 
3000 REM ^1000,5 - PRINT LINE
3005 IF PRINTER_OPEN THEN GOTO 3200
3010 CLOSE (PRINTER)
3015 IF PRINTER$="VDT" THEN OPEN (PRINTER)FID(0); GOTO 3055
3020 IF PRINTER$<>"PREVIEW" THEN GOTO 3045
3021 IF CVS(EXPORT$,7)="EXCEL" THEN LET PRINTER$="VDT"; GOTO 3015; REM "adm 6/14/07 disable preview/excel combo as incompatible
3025 ERASE STBL("*GENDIR")+STBL("*GENTMP")+"GENPV"+STBL("*GENUNIQ"),ERR=3030
3030 LET IRECS=0; IF STBL("*GEN_HOST")="2" THEN LET IRECS=8000000 FI; INDEXED STBL("*GENDIR")+STBL("*GENTMP")+"GENPV"+STBL("*GENUNIQ"),IRECS,WIDTH*ACROSS+1
3035 OPEN (PRINTER)STBL("*GENDIR")+STBL("*GENTMP")+"GENPV"+STBL("*GENUNIQ"); LOCK (PRINTER)
3040 LET PCOLS=WIDTH*ACROSS,PROWS=66; GOTO 3085
3045 LET X$="OPEN_AUTO"; IF EXPORT$="EXCEL" THEN LET X$="OPEN_TEST" FI; CALL "gen6-ptr",P$,X$,WIDTH*ACROSS,PRINTER,PRINTER$,DESC$,DEV$,DEVHEX$
3050 IF PRINTER$="ERROR" THEN CALL "gen6-ptr",P$,"SELECT",WIDTH*ACROSS,PRINTER,PRINTER$,DESC$,DEV$,DEVHEX$; IF PRINTER$="ERROR" THEN GOTO 9000 ELSE GOTO 3045
3055 IF CVS(EXPORT$,7)="EXCEL" AND TOCLIENT=0 THEN LET EXCEL_CHAN1=PRINTER; CALL "gen6-rtx",P$,MSG$[ALL],ERRMSG$,"INIT",DEV$,TITLE$,EXCEL_CHAN1,EXCEL_CHAN2,EXCEL_ROW,SDOFFICE; IF ERRMSG$>"" THEN GOTO 9000
3060 IF CVS(EXPORT$,7)="EXCEL" AND TOCLIENT=0 THEN CALL "gen6-rtx",P$,MSG$[ALL],ERRMSG$,"HDR",DEV$,HEADER$,EXCEL_CHAN1,EXCEL_CHAN2,EXCEL_ROW,SDOFFICE; IF ERRMSG$>"" THEN GOTO 9000 FI; LET PRINTER_OPEN=1; GOTO 3200
3065 CALL "gen6-fst",P$,PRINTER,PTYPE$,0,PCOLS,PROWS,""; IF PROWS=0 THEN LET PROWS=66 FI; FIND (GEN6MST,KEY="D"+FNLEFT$(PRINTER$,6),ERR=3070); LET PCOLS=NUM(DEVHEX$(1,3)),PROWS=NUM(DEVHEX$(4,3))
3070 IF PTYPE$<>"PTR" AND PTYPE$<>"TXT" THEN GOSUB 8010; LET PRINTER$="ERROR"; GOTO 3050
3075 IF COPIES>1 THEN CALL "gen6-rta",P$,COPYBUF,COPYBUF$
3080 IF WIDTH*ACROSS>PCOLS AND COMPRESSED=0 AND PRINTER$="VDT" AND STBL("*GEN_HOST")="1" THEN LET PVAL$='CP'; GOSUB 10500; LET COMPRESSED=1; GOTO 3065
3085 IF PAGELEN=0 THEN LET PAGELEN=PROWS-6+2*SGN(POS("VDT"=FNLEFT$(PRINTER$,3))) FI; IF COMPRESSED AND PRINTER$="VDT" THEN CALL "gen6-wdw",P$,"OPEN",0,0,PCOLS,PROWS,"",PWINDOW,"",0
3090 IF PRINTER$<>"VDT" OR NOPAGE OR NOWKFL THEN GOTO 3130
3100 REM ^100 - SETUP VDT HISTORY FILE
3110 LET PBUFFER$=STBL("*GENDIR")+STBL("*GENTMP")+"GENPF"+STBL("*GENUNIQ")
3120 CALL "gen6-rt9",P$,PBUFFER$,PBUFFER
3130 SETERR 8900; LET PRINTER_OPEN=1,LINENO=PAGELEN+1
3140 IF PRINTER$="VDT" THEN GOTO 3200
3150 IF PTRWINDOW=0 THEN CALL "gen6-rtf",P$,PTRWINDOW,MSG$[ALL],PRINTER$,SSMSK$; IF PTRWINDOW=0 THEN EXITTO 9000
3160 IF SORTED THEN LET MAXRECORDS$=FNTRIM$(STR(SL:SSMSK$)) ELSE LET MAXRECORDS$=FNTRIM$(STR(FILECOUNT:SSMSK$))+" "+MSG$[24]
3170 PRINT @(15,2),MAXRECORDS$,
3200 REM ^100,5 -  PRINT LINE
3205 IF CVS(EXPORT$,7)="EXCEL" AND TOCLIENT=0 THEN CALL "gen6-rtx",P$,MSG$[ALL],ERRMSG$,"DET",DEV$,LINE$,EXCEL_CHAN1,EXCEL_CHAN2,EXCEL_ROW,SDOFFICE; IF ERRMSG$>"" THEN GOTO 9000 FI; GOTO 3270
3210 LET PRINTING=1; IF (FNTRIM$(LINE$)="." OR FNTRIM$(LINE$)="@LINE") THEN LET LINE$=""
3215 IF HEADER_OFF THEN IF DATALNS=0 AND NO_DETAIL=0 AND CVS(LINE$,2)="" THEN GOTO 3270
3220 IF TOCLIENT AND PRINTER$="PC" THEN LET NOPAGE=0 FI; IF NOPAGE=0 THEN IF LINENO>PAGELEN THEN GOSUB 3300; IF CVS(EXPORT$,7)="DELIMITED-H" THEN LET NOPAGE=1
3225 IF POS("@"=LINE$)>0 AND RECAP=0 THEN GOSUB 11200
3230 LET X=POS($80$=LINE$); IF X>0 THEN LET LINE$(X,1)=$22$; GOTO 3230
3235 IF HEADER_OFF THEN LET DATALNS=1
3240 IF SUMMARY=0 OR SUBTOTAL_ON=0 OR HEADER_OFF=0 THEN GOTO 3255
3245 IF LEVEL=MAXBREAK AND FNTRIM$(LINE$)>"" AND VERT_TOTAL=0 THEN LET X$=FNTRIM$(LINE$); FOR X=1 TO LEN(X$); IF POS(X$(X,1)="- ")=0 THEN EXITTO 3250 FI; NEXT X; GOTO 3255; REM "SKIP OF UNDERLINES
3250 IF LEVEL<MAXBREAK OR (FNTRIM$(LINE$)<>"" AND FNTRIM$(LINE$)<>"." AND FNTRIM$(LINE$)<>"@LINE") THEN WRITE (SUMMARY,ERR=3255)CVS(LINE$,2),ROWLVL$
3255 IF NOPAGE=0 AND PRINTER$="VDT" THEN LET VDTPAGE$=VDTPAGE$+FNLEFT$(LINE$,WIDTH*ACROSS),LINENO=LINENO+1; RETURN 
3260 IF TOCLIENT AND MAPLN>0 THEN GOSUB MAP_PCDATA
3265 LET PVAL$=CVS(LINE$,2)+DOS_CR$; GOSUB 10500; LET LINENO=LINENO+1
3270 RETURN 
3300 REM ^100 - HEADER
3310 LET LINENO=0,PAGENO=PAGENO+1,PAGES=PAGES+1,HEADER_OFF=0,DATALNS=0,LBREAKCNT=1; IF ORIGHEADER$="" THEN LET ORIGHEADER$=HEADER$ FI; IF RECAP=0 THEN LET HEADER$=ORIGHEADER$
3320 IF PRINTER$<>"VDT" THEN GOTO 3600 ELSE IF PAGES=1 THEN GOTO 3550
3330 IF PBUFFER THEN WRITE RECORD(PBUFFER,IND=PIDX,SIZ=LEN(VDTPAGE$),ERR=3340)VDTPAGE$; LET PIDX$=PIDX$+BIN(PIDX,5)+BIN(LEN(VDTPAGE$),2),PIDX=PIDX+LEN(VDTPAGE$),PPTR=LEN(PIDX$)/7
3340 IF GOTO_END THEN IF XXEOF=0 THEN LET C=0; GOTO 3460 ELSE LET GOTO_END=0,C=3; GOTO 3510
3350 IF SEARCH_FOR$>"" THEN IF XXEOF AND PPTR>=LEN(PIDX$)/7 THEN GOSUB 8020; LET SEARCH_FOR$="",C=3; GOTO 3510 ELSE IF POS(CVS(SEARCH_FOR$,4)=CVS(VDTPAGE$,4))=0 THEN LET C=0; GOTO 3460
3360 LET FRG$='CS'; IF NOPAGE THEN GOTO 3450 ELSE IF VDTPAGE$="" THEN GOTO 3440
3370 FOR X=1 TO LEN(VDTPAGE$)/(WIDTH*ACROSS)
3380 LET Y$=VDTPAGE$((X-1)*(WIDTH*ACROSS)+1,WIDTH*ACROSS),Y$=Y$(VDTOFFSET); IF LEN(Y$)>PCOLS THEN LET Y$=Y$(1,PCOLS)
3390 LET SRCH=0; IF SEARCH_FOR$>"" THEN LET SRCH=POS(CVS(SEARCH_FOR$,4)=CVS(Y$,4))
3400 IF SRCH THEN LET Y$=Y$+" ",Y$=Y$(1,SRCH-1)+'SF'+'BR'+Y$(SRCH,LEN(SEARCH_FOR$))+'ER'+'SB'+Y$(SRCH+LEN(SEARCH_FOR$))
3410 IF SEARCH_FOR$>"" THEN LET Y$='SB'+CVS(Y$,2)+'SF'
3420 LET FRG$=FRG$+@(0,X-1)+CVS(Y$,2)
3430 NEXT X
3440 PRINT FRG$,; LET FRG$="",SEARCH_FOR$=""
3450 IF CVS(EXPORT$,7)<>"EXCEL" THEN CALL "gen6-rtc",P$,GBL$[ALL],PCOLS,PROWS,WIDTH,ACROSS,FKEY1$,FKEY2$,X$,C,PBUFFER; IF C=10 OR X$=GBL$[35] THEN GOTO 9000 ELSE IF POS(X$=GBL$[34]+GBL$[35]+" ")=0 THEN GOTO 3450
3460 IF C=0 OR C=24 OR C=28 THEN IF PPTR<LEN(PIDX$)/7 THEN LET PPTR=PPTR+1; GOTO 3540 ELSE GOTO 3550
3470 IF C=21 OR C=31 THEN IF VDTOFFSET>1 THEN LET VDTOFFSET=MAX(VDTOFFSET-60,1); GOTO 3360 ELSE GOTO 3450
3480 IF C=22 OR C=32 THEN IF VDTOFFSET<WIDTH*ACROSS-PCOLS+1 THEN LET VDTOFFSET=MIN(VDTOFFSET+60,WIDTH*ACROSS-PCOLS+1); GOTO 3360 ELSE GOTO 3450
3490 IF PBUFFER THEN IF C=23 OR C=27 THEN IF PPTR=1 THEN GOTO 3450 ELSE LET PPTR=PPTR-1; GOTO 3540
3500 IF C=2 THEN IF PPTR>1 THEN LET PPTR=1; GOTO 3540
3510 IF C=3 THEN IF XXEOF=0 THEN LET GOTO_END=1; PRINT IOL=8030,; GOTO 3550 ELSE LET PPTR=LEN(PIDX$)/7-1+NO_RECAP; GOTO 3540
3520 IF C=4 THEN CALL "gen6-rtd",P$,MSG$[ALL],SEARCH_FOR$,LAST_SEARCH$,SRCHMSG$; IF SEARCH_FOR$>"" THEN PRINT IOL=8040,; LET C=0; GOTO 3460
3530 GOTO 3450
3540 LET X=DEC(PIDX$(PPTR*7-6,5)),Y=DEC(PIDX$(PPTR*7-1,2)); READ RECORD(PBUFFER,IND=X,SIZ=Y)VDTPAGE$; GOTO 3350
3550 LET VDTPAGE$=""
3560 IF XXEOF THEN GOTO 3800
3570 IF NO_DETAIL AND PAGES>1 THEN PRINT IOL=8050,
3600 REM ^100 - COLUMN HEADINGS
3610 IF PRINTER$<>"VDT" AND PRINTER$<>"BROWSER" AND PAGES>1 THEN LET PVAL$=CHR(12); GOSUB 10500
3620 IF HEADER$="" THEN GOTO 3800
3630 LET SAVELINE$=LINE$,SAVELEVEL=LEVEL,SAVEXXHLN=XXHLN,SAVEHDR$=HDR$,SAVEROWPLC$=ROWPLC$,SAVEROWLVL$=ROWLVL$,SAVEROWTYP$=ROWTYP$,SAVEMAPLN=MAPLN
3640 IF HEADER$=$11$ THEN LET LEVEL=0; GOSUB 2410; GOTO 3710 ELSE LET ROWPLC$=HDRPLC$,ROWLVL$="10",ROWTYP$=HDRTYP$
3650 LET LINE$=HEADER$; GOSUB 11200; LET HEADER$=LINE$; REM "@var subs
3660 IF RECAP THEN LET ROWLVL$="RC"
3665 IF EXPORT$>"" THEN LET MAPLN=1,LINE$=HEADER$; IF POS("@"=LINE$)>0 THEN GOSUB 11200 FI; GOSUB 3230; GOTO 3710
3670 FOR XXG4H=1 TO LEN(HEADER$) STEP WIDTH*ACROSS
3680 LET MAPLN=1+INT(XXG4H/WIDTH*ACROSS),LINE$=HEADER$(XXG4H); IF LEN(LINE$)>WIDTH*ACROSS THEN LET LINE$=LINE$(1,WIDTH*ACROSS)
3690 IF POS("@"=LINE$)>0 THEN GOSUB 11200 FI; GOSUB 3230
3700 NEXT XXG4H
3710 LET LINE$=SAVELINE$,LEVEL=SAVELEVEL,XXHLN=SAVEXXHLN,HDR$=SAVEHDR$,ROWPLC$=SAVEROWPLC$,ROWLVL$=SAVEROWLVL$,ROWTYP$=SAVEROWTYP$,MAPLN=SAVEMAPLN
3800 REM ^100 - DONE WITH HEADING
3810 LET HEADER_OFF=1; RETURN 
4000 REM ^1000 - END OF FILE
4010 IF SORT_PASS THEN GOTO 4080 ELSE IF SORTED THEN GOTO 4050
4020 IF ALTFILE THEN IF ALTFILE<LEN(ALTFILE$)/2 THEN LET ALTFILE=ALTFILE+1; GOTO 0700
4030 IF PFILE<LEN(PFILE$)/2 AND ALTKEY AND EXTERN=0 THEN READ (DEC(PFILE$(PFILE*2-1,2)),KEY="",KNUM=0,ERR=4040)
4040 IF PFILE<LEN(PFILE$)/2 THEN LET PFILE=PFILE+1; GOTO 0700
4050 IF SSWINDOW THEN CALL "gen6-wdw",P$,"CLOSE",0,0,0,0,"",SSWINDOW,"",0; PRINT @(0,15),'CL',
4060 IF SORT_REQUIRED THEN IF ALTKEY AND EXTERN=0 THEN READ (DEC(PFILE$(PFILE*2-1,2)),KEY="",KNUM=0,ERR=4110); REM "RESET KEY NUMBER IF 2ND PASS REQUIRED
4070 IF TWO_PASS<>1 OR MAXBREAK=0 THEN GOTO 4110
4080 FOR I=1 TO MAXBREAK
4090 IF BK$[I]>"" THEN ON I-1 GOSUB 2610,2620,2630,2640,2650,2660,2670,2680,2690
4100 NEXT I
4110 IF TWO_PASS=2 THEN LET TWO_PASS=0 ELSE IF TWO_PASS=3 THEN DIM BK$[MAXBREAK]; LET TWO_PASS=0 ELSE IF TWO_PASS=1 AND SORT_PASS=0 THEN LET TWO_PASS=2,RC=0,SL=0; DIM BK$[MAXBREAK] ELSE IF TWO_PASS=1 AND SORT_PASS THEN LET TWO_PASS=3,SORT_PASS=0,RC=0,SL=0; DIM BK$[MAXBREAK]; GOTO 0700
4120 IF SORT_REQUIRED=0 OR EXTERN=0 OR STBL("*GEN_HOST")<>"2" THEN GOTO 4170; REM "ON TBRED, REOPEN ASCII FILES FOR IND,SIZ ACCESS
4130 FOR X=1 TO LEN(PFILE$)/2
4140 CALL "gen6-cnv",P$,101,STR(DEC(PFILE$(X*2-1,2))),XXNAME$,""
4150 CLOSE(DEC(PFILE$(X*2-1,2))); OPEN(DEC(PFILE$(X*2-1,2)),OPT="TEXT")XXNAME$
4160 NEXT X
4170 IF SORT_REQUIRED THEN LET SORT_REQUIRED=0,SORTED=1,SORTING=0; READ (SORTFILE,KEY="",DOM=1000)
4180 IF TWO_PASS THEN IF ALTFILE THEN LET ALTFILE=1; EXTRACT (DEC(ALTFILE$(1,2)),KEY=FIRSTKEY$,DOM=1000,ERR=1000,TIM=0); GOTO 1000
4190 IF TWO_PASS THEN LET PFILE=1; EXTRACT (DEC(PFILE$(PFILE*2-1,2)),KEY=FIRSTKEY$,DOM=1000,ERR=1000); GOTO 1000
4200 IF CROSSTAB THEN IF XWKFL>0 THEN GOSUB 14100; GOTO 9000 ELSE GOTO 9000
4210 LET BRKLEVEL=0,DONE=1; GOSUB 2300
4220 IF SUMMARY THEN GOSUB 5100
4230 LET GEN_LOGFILE=0,GEN_LOGFILE=NUM(STBL("*GEN_LOGFILE#"),ERR=4240)
4240 LET PRINTING=0; IF GEN_LOGFILE OR (NO_RECAP=0 AND NOPAGE=0) THEN GOSUB 5000
4250 IF PRINTER$="VDT" THEN IF PRINTER_OPEN=0 THEN LET LINE$=""; GOSUB 3000
4260 IF PRINTER$="VDT" THEN LET XXEOF=1; GOSUB 3330
4270 IF EXPORT$="DIF" THEN GOSUB 10400
4280 IF CVS(EXPORT$,7)="EXCEL" AND TOCLIENT=0 THEN CALL "gen6-rtx",P$,MSG$[ALL],ERRMSG$,"DONE",DEV$,"",EXCEL_CHAN1,EXCEL_CHAN2,EXCEL_ROW,SDOFFICE; IF ERRMSG$>"" THEN GOTO 9000 FI
4290 IF PRINTER$<>"VDT" AND PRINTER$<>"PREVIEW" AND COPIES>1 THEN CALL "gen6-rt8",P$,COPYBUF,COPYBUF$,COPIES,PRINTER,GBL$[ALL],NOPAGE,DOS_CR$
4300 IF PRINTER$<>"VDT" AND PRINTER$<>"PREVIEW" THEN CALL "gen6-ptr",P$,"CLOSE",WIDTH,PRINTER,PRINTER$,"",DEV$,DEVHEX$
4310 GOTO 9000
5000 REM ^1000 - RECAP PAGE
5010 LET LINENO=PAGELEN+1,DISPWIDTH=MIN(80,WIDTH*ACROSS),ENDTIME=JUL(0,0,0)+TIM/24,SAVEHEADER$=HEADER$,HDRPLC$="",HDRTYP$=""
5020 IF LOGONLY=0 THEN CALL "gen6-hdr",P$,HEADER$,WIDTH*ACROSS,MSG$[32]+"",LEN(MSG$[32]),"",HDRPLC$,HDRTYP$; LET HDRPLC$=HDRPLC$+BIN(LEN(HEADER$)+1,2)+BIN(WIDTH*MAX(1,ACROSS),2),HEADER$=HEADER$+FILL(WIDTH*MAX(1,ACROSS),"-"),HDRTYP$=HDRTYP$+"H   "
5030 CALL "gen6-rtr",P$,MSG$[ALL],ERRMSG$,NO_RECAP,RECAP$,CMPCMD$,DISPWIDTH,STARTTIME,ENDTIME,PS,SSMSK$,PRINTED,REPL$,ERROR_LIST$,WIDTH,ACROSS,DATEMASK$
5040 IF LOGONLY OR NO_RECAP THEN GOTO 5090 ELSE LET RECAP=1
5050 WHILE POS($11$=RECAP$)>0
5060 LET LINE$=RECAP$(1,POS($11$=RECAP$)-1),RECAP$=RECAP$(POS($11$=RECAP$)+1)
5070 GOSUB 3000
5080 WEND
5090 LET RECAP=0,HEADER$=SAVEHEADER$,SAVEHEADER$=""; RETURN 
5100 REM ^100 - SUMMARY PRINT
5110 IF SUMMARY=0 THEN RETURN 
5120 LET LINENO=PAGELEN+1,DISPWIDTH=MIN(80,WIDTH),SAVEHEADER$=HEADER$; GOSUB 8100
5130 CALL "gen6-cnv",P$,101,STR(SUMMARY),X$,""; CLOSE (SUMMARY)
5140 ON NUM(STBL("*GEN_HOST"))-1 GOTO 5150,5160,5180
5150 OPEN (SUMMARY)X$; GOTO 5190; REM "RE-OPEN TO FIX POINTER
5160 OPEN (SUMMARY,OPT="TEXT")X$;REM "TBRED
5170 GOTO 5190
5180 OPEN (SUMMARY)X$; GOTO 5190
5190 READ (SUMMARY,END=5300)LINE$,ROWLVL$
5200 GOSUB 3000
5210 GOTO 5190
5300 REM ^100 - END OF SUMMARY
5310 LET HEADER$=SAVEHEADER$,SAVEHEADER$=""
5320 RETURN 
8000 REM 8000 - MESSAGES/MENUS
8010 CALL "gen6-cnv",P$,25,MSG$[5]+$FF80$+"@PRINTER"+$FF81$+PRINTER$,EMSG$,""; CALL "gen6-msg",P$,PGM(-2)+$11$+"NOT PRINTER",0,EMSG$,0; RETURN 
8020 CALL "gen6-msg",P$,PGM(-2)+$11$+"NOT FOUND",0,MSG$[8],0; RETURN 
8030 IOLIST @(0,PROWS-1),'CL','SB',STOPMSG$,@(0,PROWS-2),'CL','BB',MSG$[10],'EB'
8040 IOLIST @(0,PROWS-1),'CL','SB',STOPMSG$,@(0,PROWS-2),'CL','BB',SRCHMSG$,'EB'
8050 IOLIST @(0,PROWS-2),'CL',MSG$[12]
8060 CALL "gen6-cnv",P$,25,MSG$[20]+$FF80$+"@KEY"+$FF81$+STR(ALTKEY-1),EMSG$,""; CALL "gen6-msg",P$,PGM(-2)+$11$+"ALTKEY ERROR",0,EMSG$,0; GOTO 9000
8070 LET MSG1$=MSG$[21],MSG2$=INTRMSG$; PRINT @(INT(PCOLS/2)-INT(LEN(MSG1$)/2),INT(PROWS/2)),MSG1$,@(INT(PCOLS/2)-INT(LEN(MSG2$)/2),INT(PROWS/2)+1),MSG2$,; RETURN 
8080 LET MSG1$=MSG$[33],MSG2$=MSG$[34],MSG3$=MSG$[35],MSGLEN=MAX(LEN(MSG1$),LEN(MSG2$),LEN(MSG3$)),MSG$=FNLEFT$(MSG1$,MSGLEN)+FNLEFT$(MSG2$,MSGLEN)+FNLEFT$(MSG3$,MSGLEN),MSG4$=MSG$[36],X=MSGLEN; CALL "gen6-msg",P$,PGM(-2)+$11$+"SORT ESCAPE",4,MSG4$+$11$+MSG$,X; RETURN 
8090 LET MSG1$=MSG$[33],MSG2$=MSG$[35],MSGLEN=MAX(LEN(MSG1$),LEN(MSG2$)),MSG$=FNLEFT$(MSG1$,MSGLEN)+FNLEFT$(MSG2$,MSGLEN),MSG4$=MSG$[36],X=MSGLEN; CALL "gen6-msg",P$,PGM(-2)+$11$+"PRINT ESCAPE",4,MSG4$+$11$+MSG$,X; RETURN 
8100 LET SUMTITLE$=MSG$[38]; CALL "gen6-hdr",P$,HEADER$,WIDTH,SUMTITLE$,LEN(SUMTITLE$),"",HDRPLC$,HDRTYP$; LET HDRPLC$=HDRPLC$+BIN(LEN(HEADER$)+1,2)+BIN(WIDTH*MAX(1,ACROSS),2),HEADER$=HEADER$+FILL(WIDTH*MAX(1,ACROSS),"-"),HDRTYP$=HDRTYP$+"H   "; RETURN 
8110 CALL "gen6-msg",P$,PGM(-2)+$11$+"NULL BREAK",0,MSG$[39],0; GOTO 9000
8120 CALL "gen6-msg",P$,PGM(-2)+$11$+"ANOTHER TEST",1,MSG$[45],DOTEST; RETURN 
8700 REM 8700 - PRINTER ERROR
8710 CALL "gen6-cnv",P$,25,MSG$[40]+$FF80$+"@ERROR"+$FF81$+STR(ERR),EMSG$,""; CALL "gen6-msg",P$,"gen6temp"+$11$+"PRINTER ERROR",1,EMSG$,X
8720 IF X=0 OR X=1 THEN RETRY ELSE GOTO 9000
8800 REM 8800 - SETESC TRAP
8810 IF SORTING THEN GOSUB 8080; IF X=0 THEN GOTO 8810 ELSE IF X=1 THEN RETURN ELSE IF X=2 THEN EXITTO 4000 ELSE EXITTO 9000
8820 IF GOTO_END THEN LET GOTO_END=0; PRINT @(0,PROWS-2),'RB','CL',; RETURN 
8830 IF SEARCH_FOR$>"" THEN LET SEARCH_FOR$=""; PRINT @(0,PROWS-2),'RB','CL',; RETURN 
8840 GOSUB 8090; IF X=0 THEN GOTO 8840 ELSE IF X=1 THEN RETURN ELSE EXITTO 9000
8850 RETURN 
8860 GOTO 9000
8900 REM 8900 - ERROR TRAP
8910 IF ERR=31 OR ERR=33 THEN LET VDTPAGE$="",MEMERR=ERR; GOTO 9000
8920 LET E0$=PGM(-2),E1$=STR(ERR),E2$=STR(TCB(5)),E3$=""; IF KY$<>"" THEN LET E1$=E1$+$12$+KY$ FI; IF TCB(13)=0 THEN LET E3$=LST(PGM(TCB(5)),ERR=8940)
8930 IF TCB(5)>1000 AND (TCB(5)<8000 OR TCB(5)>10000) AND DONE=0 THEN LET E0$=E0$+$11$
8940 CALL "gen6-err",P$,E0$,E1$,E2$,E3$,C
8950 IF C=0 THEN RETRY ELSE IF C=98 THEN ESCAPE
8960 IF C=97 THEN RESET; SETESC 8800; SETERR 8900; PRECISION 9; GOTO 1000
8970 LET LOGONLY=1; GOSUB 5000; GOTO 9000
9000 REM 9000 - EXIT
9010 IF PBUFFER THEN CLOSE (PBUFFER); ERASE PBUFFER$,ERR=9020
9020 IF EXTWKFL THEN CLOSE (EXTWKFL); ERASE EXTWKFL$,ERR=9030
9030 IF SORTFILE THEN IF RETAIN=0 THEN CLOSE (SORTFILE); ERASE SORTFILE$,ERR=9040
9040 IF TWOPASS_FILE THEN CLOSE (TWOPASS_FILE); ERASE TWOPASS_FILE$,ERR=9050
9050 IF SUMMARY THEN CLOSE (SUMMARY); ERASE SUMFILE$,ERR=9060
9060 IF SSWINDOW THEN CALL "gen6-wdw",P$,"CLOSE",0,0,0,0,"",SSWINDOW,"",0; PRINT @(0,15),'CL',
9070 IF PTRWINDOW THEN CALL "gen6-wdw",P$,"CLOSE",0,0,0,0,"",PTRWINDOW,"",0
9080 IF COMPRESSED AND PRINTER$="VDT" THEN PRINT 'CS','SP',; WAIT 1
9090 IF PWINDOW THEN CALL "gen6-wdw",P$,"CLOSE",0,0,0,0,"",PWINDOW,"",0
9100 IF STBL("$gen60d",ERR=9110)>"" THEN IF MEMERR=31 THEN CALL STBL("generr"),MSG$[42]
9110 IF STBL("$gen60d",ERR=9120)>"" THEN IF MEMERR=33 THEN CALL STBL("generr"),MSG$[43]
9120 IF MEMERR=31 THEN PRINT @(0,PROWS-2),'CL','RB',MSG$[42]," ",; INPUT *; GOTO 9160
9130 IF MEMERR=33 THEN PRINT @(0,PROWS-2),'CL','RB',MSG$[43]," ",; INPUT *; GOTO 9160
9140 IF PRINTER$="PREVIEW" AND CROSSTAB=0 THEN CALL "gen6-pvw",P$,PRINTER,WIDTH*ACROSS
9150 IF CROSSTAB THEN IF XWKFL=0 THEN GOTO 9160 ELSE IF NUM(FNMID$(XHDR$,14,4))=0 THEN CLOSE (XTABFL); ERASE XTABFL$,ERR=9160 ELSE CLOSE (XTABFL); CALL "gen6cdsp",P$,XTABFL$,GBL$[ALL]
9160 FOR I=0 TO 9
9170 LET X$=STBL("!CLEAR","*GEN_FTR"+STR(I),ERR=9180)
9180 LET X$=STBL("!CLEAR","*GEN_HDR"+STR(I),ERR=9190)
9190 NEXT I
9200 LET X$=STBL("!CLEAR","*GEN_HDRC",ERR=9210)
9210 IF NUM(STBL("$debuglevel",ERR=9280),ERR=9280)<1 THEN GOTO 9280
9220 CALL "gen6-cnv",P$,102,PGM(-2),STBL("*GENDIR")+STBL("*GENTMP")+STBL("*GENUNIQ")+".dbg",""
9230 IF NUM(STBL("$debuglevel"))=1 THEN GOTO 9280
9240 LET DUMPFILE$=STBL("*GENDIR")+STBL("*GENTMP")+STBL("*GENUNIQ")+".dmp"; ERASE DUMPFILE$,ERR=9250
9250 STRING DUMPFILE$,ERR=9280
9260 LET DMP=UNT; OPEN (DMP)DUMPFILE$
9270 DUMP (DMP); CLOSE (DMP)
9280 IF CALLED_FLAG THEN EXIT 
9290 RUN "gen6main"
10300 REM 10300 - ADD FIELD/ERROR TO ERROR LIST
10310 IF ERR=26 OR ERR=47 THEN IF TCB(5)<50000 THEN RETURN ; REM "select/sort phrase errors on non-normalized data
10320 DIM Z$(25); LET Z$(1)=ERRN$,Z$(21)="!"+STR(ERR); IF POS(Z$=ERROR_LIST$,LEN(Z$))=0 THEN LET ERROR_LIST$=ERROR_LIST$+Z$
10330 DIM Z$(ERRL); LET Z$(1)="!"+STR(ERR),FLD$[ERRF]=Z$,FLD[ERRF]=0
10340 RETURN 
10400 REM ^100 - DIF HEADER (BUILT AT END & APPENDED)
10410 IF PRINTER$="VDT" THEN RETURN 
10420 LET LINE$="-1,0"+TERM$+"EOD"+TERM$; GOSUB 3000; REM "EOD MARKER AT END OF FILE
10430 CALL "gen6-rt2",P$,ERRMSG$,FLDCOUNT,PRINTED,PRINTER,TERM$,TITLE$,NO_DETAIL,FTRCNT
10440 RETURN 
10500 REM ^100 - PRINTER
10510 IF PVAL$>"" THEN IF PVAL$(LEN(PVAL$),1)=DOS_CR$ THEN LET PVAL$=PVAL$(1,LEN(PVAL$)-1)
10520 IF PVAL$=CHR(12) THEN LET PTVAL$=$0C$ ELSE LET PTVAL$=PVAL$+$0A$
10530 IF PRINTER$="PREVIEW" THEN PRINT (PRINTER)PVAL$; GOTO 10550
10540 PRINT (PRINTER,ERR=8700)PVAL$+DOS_CR$,; IF PVAL$<>$0C$ THEN PRINT (PRINTER,ERR=8700)""
10550 IF COPIES>1 AND PVAL$=CHR(12) THEN LET PVAL$=$FFFF$ FI; IF COPIES>1 THEN PRINT (COPYBUF)PVAL$
10560 RETURN 
10600 REM ^100 - BROWSER WORK FILE
10610 LET X$=CVS(LINE$,2),BRSEQ=1; IF PAGENO<1 THEN LET PAGENO=1
10620 WHILE X$>""
10630 IF LEN(X$)>80 THEN LET BRW$=X$(1,80),X$=X$(81) ELSE LET BRW$=X$,X$=""
10640 IF LEN(ROWLVL$)<>2 THEN LET ROWLVL$="  " FI; LET BRKY$=BIN(PAGENO,3)+BIN(LINENO,3)+ROWLVL$+BIN(BRSEQ,2),BRSEQ=BRSEQ+1
10650 WRITE RECORD(PRINTER,KEY=BRKY$)BRW$
10660 WEND
10670 IF BRLVL$="" THEN WRITE (PRINTER,KEY="")WIDTH,HEIGHT,ACROSS,EXPORT$
10680 LET X=POS(ROWLVL$=BRLVL$,2); IF X>0 THEN GOTO 10710
10690 LET X$=ROWPLC$,BRSEQ=1,BRLVL$=BRLVL$+ROWLVL$
10700 WHILE X$>""; IF LEN(X$)>80 THEN LET BRW$=X$(1,80),X$=X$(81) ELSE LET BRW$=X$,X$="" FI; WRITE RECORD(PRINTER,KEY=BIN(0,3)+BIN(0,3)+ROWLVL$+BIN(BRSEQ,2))BRW$; LET BRSEQ=BRSEQ+1; WEND
10710 LET ROWLVL$="",ROWPLC$=""; RETURN 
10800 MAP_PCDATA: REM ^100,5 - gui pc data line
10805 IF PRINTER$="PCFILE" OR (EXPORT$>"" AND EXPORT$<>"EXCEL") THEN RETURN ; REM "plain text reqd
10810 IF ROWPLC$="" OR MAPLN=0 THEN RETURN 
10815 IF POS(ROWLVL$=ROWLVLS$,2)>0 THEN GOTO 10830
10820 PRINT (PRINTER)$02$+ROWLVL$+$09$+HTA(ROWPLC$)+$09$+ROWTYP$
10825 LET ROWLVLS$=ROWLVLS$+ROWLVL$
10830 LET MAPPOS1=(MAPLN-1)*WIDTH*ACROSS+1,MAPPOS2=MAPPOS1+WIDTH*ACROSS-1,MAPWORK$=""
10835 FOR ROWPLC=1 TO LEN(ROWPLC$)/4
10840 LET THISPLC$=ROWPLC$(ROWPLC*4-3,4),THISPOS=DEC(THISPLC$(1,2)),THISLEN=DEC(THISPLC$(3,2)),THISTYP$=ROWTYP$(ROWPLC*4-3,4)
10845 IF THISPOS<MAPPOS1 OR THISPOS>MAPPOS2 THEN GOTO 10860
10850 LET THISCOL=THISPOS-((MAPLN-1)*WIDTH*ACROSS),THISVAL$=FNMID$(LINE$,THISCOL,THISLEN); IF THISTYP$(2,1)="R" THEN LET THISVAL$=CVS(THISVAL$,1) ELSE IF THISTYP$(2,1)="L" THEN LET THISVAL$=CVS(THISVAL$,2); REM else let THISVAL$=cvs(THISVAL$,3)
10852 LET X=POS($20$>THISVAL$); IF X>0 THEN LET THISVAL$(X,1)=" "; GOTO 10852; REM "don't allow control chars to client
10855 LET MAPWORK$=MAPWORK$+STR(ROWPLC)+$09$+THISVAL$+$09$
10860 NEXT ROWPLC
10865 LET BRKINFO$=""; IF MAPLN=1 AND ROWLVL$="00" THEN IF MAXBREAK>0 THEN LET BRKINFO$=$03$; FOR ROWBRK=1 TO MAXBREAK; LET BRKINFO$=BRKINFO$+BK$[ROWBRK]+$09$; NEXT ROWBRK; LET BRKINFO$=BRKINFO$+$0A$
10870 LET LINE$=BRKINFO$+$01$+ROWLVL$+CHR(MAPLN+(MAPLN>9))+$09$+MAPWORK$,MAPLN=0; RETURN 
10900 REM 10900 - RESTORE LAST RECORD
10910 LET SAVE_KEY$=KY$,SAVE_REC$=DATAREC$
10920 LET RESTORE_REC=0,KY$=STBL("*GEN_LK",ERR=10945),DATAREC$=STBL("*GEN_LD",ERR=10945),RESTORE_REC=1
10925 REM 10925
10935 LET REQFLD$=REQFLD1$; GOSUB 11000; GOSUB 25000; GOSUB 50000
10945 RETURN 
10950 REM 10950 - RESTORE CURRENT RECORD
10960 LET KY$=SAVE_KEY$,DATAREC$=SAVE_REC$,RESTORE_REC=0; GOTO 10925
11000 REM 11000,5 - LOAD REC$[]
11005 IF REQFLD$="" THEN RETURN 
11010 IF EXTERN=2 THEN GOSUB 11700
11015 LET MAXFLD=NUM(REQFLD$(LEN(REQFLD$)-2,3)),CURFLD=1,WORK$=DATAREC$(1,POS($00$<>DATAREC$,-1))+FILL(MAXFLD,FLDTERM$)+" "; DIM REC$[MAXFLD]
11020 FOR X=1 TO LEN(REQFLD$) STEP 3
11025 LET RQDFLD=NUM(REQFLD$(X,3))
11030 IF RQDFLD>CURFLD THEN LET XPOS=POS(FLDTERM$=WORK$,1,RQDFLD-CURFLD),CURFLD=RQDFLD,WORK$=WORK$(XPOS+1)
11035 LET REC$[RQDFLD]=WORK$(1,POS(FLDTERM$=WORK$)-1)
11040 NEXT X
11045 IF EXTERN=2 THEN GOSUB 11800
11050 RETURN 
11100 REM 11100 - LOAD XRC$[]
11110 LET BBTERM$=$0A$; IF STBL("*GEN_HOST")="1" THEN GOTO 11130
11120 BBTERM$=SEP
11130 IF REQFLD$="" THEN RETURN ELSE LET MAXFLD=NUM(REQFLD$(LEN(REQFLD$)-2,3)),CURFLD=1,WORK$=XDATREC$(1,POS($00$<>XDATREC$,-1))+FILL(MAXFLD,BBTERM$)+" "; DIM XRC$[MAXFLD]; IF REF_EOF THEN RETURN 
11140 FOR X=1 TO LEN(REQFLD$) STEP 3
11150 LET RQDFLD=NUM(REQFLD$(X,3))
11160 IF RQDFLD>CURFLD THEN LET XPOS=POS(BBTERM$=WORK$,1,RQDFLD-CURFLD),CURFLD=RQDFLD,WORK$=WORK$(XPOS+1)
11170 LET XRC$[RQDFLD]=WORK$(1,POS(BBTERM$=WORK$)-1)
11180 NEXT X
11190 RETURN 
11200 REM 11200 - REPLACE SPECIAL VALUES IN LINE$
11210 IF TOCLIENT AND PRINTER$<>"PCFILE" THEN RETURN 
11220 CALL "gen6-rt4",P$,ERRMSG$,BK$[ALL],DATEMASK$,EXECUTOR$,HEADER_OFF,HEADSUB$,KY$,LINE$,MAXBREAK,PAGEDSC$,PAGENO,TIMEMASK$,WIDTH,ROWPLC$,ROWTYP$; IF ERRMSG$="ERROR" THEN EXITTO 9000
11225 IF TOCLIENT=0 THEN LET ROWPLC$="",ROWTYP$=""
11230 RETURN 
11400 REM 11400 - LOOP THROUGH REFKEY_PART$, REPLACING IN REFKEY$
11410 LET WX=POS("{"=REFKEY$); IF WX=0 THEN RETURN 
11420 LET WY=POS("}"=REFKEY$(WX)); IF WY=0 THEN LET REFKEY_PART$=""; RETURN 
11430 LET REFKEY_PART$=REFKEY$(WX+1,WY-2),REFKEY$=REFKEY$+" ",REFKEY$=REFKEY$(1,WX-1)+REFKEY$(WX+WY),REFKEY$=REFKEY$(1,LEN(REFKEY$)-1),REFKEY_POS=WX; REM IF REFKEY_PART$="" THEN LET REFKEY_PART$=REFKEY_WORK$
11440 LET WHICHSEG=0
11450 REM ^50 - ADD NEXT REFKEY_PART$ TO REFKEY$ AT REFKEY_POS
11460 LET WX=POS(","=REFKEY_PART$); IF WX=0 THEN LET REFKEY_SEG$=REFKEY_PART$,REFKEY_PART$="" ELSE LET REFKEY_SEG$=REFKEY_PART$(1,WX-1),REFKEY_PART$=REFKEY_PART$+" ",REFKEY_PART$=REFKEY_PART$(WX+1),REFKEY_PART$=REFKEY_PART$(1,LEN(REFKEY_PART$)-1),WHICHSEG=WHICHSEG+1; IF WHICHSEG<NEXT_SEG+1 THEN GOTO 11460; REM "LOOP FOR CURRENT SEG
11470 LET WX=POS(".."=REFKEY_SEG$); IF WX>1 AND REFKEY_POS=LEN(REFKEY$)+1 THEN LET REFKEY_SEG$=REFKEY_SEG$+" ",REFKEY_SUFA$=REFKEY_SEG$(1,WX-1),REFKEY_SUFB$=REFKEY_SEG$(WX+2),REFKEY_SUFB$=REFKEY_SUFB$(1,LEN(REFKEY_SUFB$)-1),REFKEY_PART$=""; RETURN ; REM "IF SEGMENT IS AT END & RANGE, MAKE SUFFIX RANGE
11480 IF REFKEY_POS<=LEN(REFKEY$) THEN LET REFKEY$=REFKEY$(1,REFKEY_POS-1)+REFKEY_SEG$+REFKEY$(REFKEY_POS) ELSE LET REFKEY$=REFKEY$+REFKEY_SEG$
11490 IF FIRST_READ=0 THEN IF LASTREFID=REFID THEN IF LAST_SEG<>NEXT_SEG THEN LET FIRST_READ=-1
11500 LET LASTREFID=REFID,LAST_SEG=NEXT_SEG
11510 RETURN 
11600 REM ^100 - NEXT EXTERNAL RECORD
11610 IF EXTERN=1 THEN READ RECORD(DEC(PFILE$(PFILE*2-1,2)),IND=EXTIND,SIZ=EXTBLOCK,END=11680)DATAREC$; LET EXTIND=EXTIND+LEN(DATAREC$); RETURN 
11620 IF EXTERN<>2 THEN GOTO 11670
11630 LET X=POS($0A$=EXTBLOCK$); IF X=0 THEN IF EXTBLOCK$="" THEN LET EXTLAST$=""; GOTO 11660 ELSE LET EXTLAST$=EXTBLOCK$(1,LEN(EXTBLOCK$)-1); GOTO 11660
11640 LET DATAREC$=EXTBLOCK$(1,X-1),EXTBLOCK$=EXTBLOCK$(X+1); IF DATAREC$>"" THEN IF DATAREC$(LEN(DATAREC$),1)=$0D$ THEN LET DATAREC$=DATAREC$(1,LEN(DATAREC$)-1)
11650 RETURN 
11660 READ RECORD(DEC(PFILE$(PFILE*2-1,2)),IND=EXTIND,SIZ=EXTBLOCK,END=11680)EXTBLOCK$; LET EXTIND=EXTIND+LEN(EXTBLOCK$),EXTBLOCK$=EXTLAST$+EXTBLOCK$+" "; GOTO 11630
11670 LET EXTEOF=1; RETURN ; REM "OTHER TYPES IN FUTURE
11680 LET EXTEOF=1; RETURN 
11700 REM ^100 - FIX QUOTES ON ASCII FILES
11710 CALL "gen6-rt5",P$,1,ERRMSG$,DATAREC$,MAXFLD,FLDTERM$,REC$[ALL]; IF ERRMSG$="ERROR" THEN EXITTO 9000
11720 RETURN 
11800 REM ^100 - REPLACE QUOTED ITEMS IN DATAREC$ & REC$[]
11810 CALL "gen6-rt5",P$,2,ERRMSG$,DATAREC$,MAXFLD,FLDTERM$,REC$[ALL]; IF ERRMSG$="ERROR" THEN EXITTO 9000
11820 RETURN 
12000 REM ^1000 - SUBSTITUTE NEW$ FOR OLD$ IN X$
13000 REM ^1000 - SORT FILE READ
14000 REM 14000 - BUILD XTAB WORKFILE
14010 CALL "gen6-rt6",P$,MSG$[ALL],ERRMSG$,BK$[ALL],CDATA$,CHD2$,GLST$,GTAB,OUTLINE$,TITLE$,XBRK1$,XBRK2$,XHDR$,XLST$,XREC$,XTAB,XTAB$[ALL],XTAB1$,XTABFL,XTABFL$,XTABS,XWKFL; IF ERRMSG$="ERROR" THEN EXITTO 9000
14020 RETURN 
14100 REM ^100 - CLOSE OUT XTAB
14110 CALL "gen6-rt7",P$,ERRMSG$,CDATA$,CHD2$,GLST$,GTAB,TITLE$,XHDR$,XLST$,XTAB,XTABFL,XWKFL
14120 IF ERRMSG$="ERROR" THEN LET XWKFL=0
14130 RETURN 
15000 REM ^1000 - ACROSS LOADER
15010 LET SKIPPED=0,LNCNT=0,ACROSS_P=0
15020 FOR LN=1 TO LEN(OUTLINE$)/WIDTH
15030 LET LINE$=OUTLINE$(LN*WIDTH-WIDTH+1,WIDTH); IF NO_BLANK THEN IF FNTRIM$(LINE$)="" THEN LET SKIPPED=SKIPPED+1; GOTO 15050
15040 LET LNCNT=LNCNT+1,LABELBUF$[LNCNT]=LABELBUF$[LNCNT]+LINE$
15050 NEXT LN
15060 IF SKIPPED THEN FOR X=1 TO SKIPPED; LET LABELBUF$[LNCNT+X]=LABELBUF$[LNCNT+X]+FILL(WIDTH); NEXT X
15070 IF LEN(LABELBUF$[1])/WIDTH=ACROSS THEN GOTO 15100
15080 RETURN 
15100 REM ^100 - PRINT LABEL BUFFER ACROSS
15110 FOR LN=1 TO MAX(MAXROW,HEIGHT)
15120 LET LINE$=LABELBUF$[LN]; GOSUB 3000
15130 NEXT LN
15140 DIM LABELBUF$[MAX(MAXROW,HEIGHT)]; LET ACROSS_P=1
15150 IF DOUBLE_SPACE THEN LET LINE$=""; GOSUB 3000
15160 RETURN 
16000 REM 16000 - ext dict functions
16010 DEF FNDTF(WDAT$,WFMT$)
16020 IF WFMT$<>"aon" THEN GOTO 16100
16030 IF LEN(WDAT$)=3 THEN IF WDAT$(2,1)=" " THEN RETURN 0
16040 IF LEN(WDAT$)=3 THEN LET YX=1900+ASC(WDAT$(1,1))-32,MX=ASC(WDAT$(2,1))-32,DX=ASC(WDAT$(3,1))-32; RETURN JUL(YX,MX,DX)
16050 IF LEN(WDAT$)<>6 THEN GOTO 16300
16060 LET WX=POS(WDAT$(1,1)="ABCDEFGHIJ"); IF WX THEN LET YX=2000+10*(WX-1)+NUM(WDAT$(2,1)) ELSE LET YX=NUM(WDAT$(1,2))
16070 LET MX=NUM(WDAT$(3,2)),DX=NUM(WDAT$(5,2))
16080 IF MX=0 THEN RETURN 0 ELSE RETURN JUL(YX,MX,DX)
16100 REM ^100 next named format
16110 IF WFMT$<>"ssi" THEN GOTO 16200
16120 RETURN DEC(ATH(WDAT$))
16200 REM ^100 - next named format
16300 REM ^100 - mmddyy[yy] styles
16310 IF POS("yy"=WFMT$)=0 OR POS("mm"=WFMT$)=0 OR POS("dd"=WFMT$)=0 THEN GOTO 16400
16320 LET WX$=WFMT$,YX=0,YM=0,YD=0
16330 LET WX=POS("yyyy"=WX$); IF WX THEN LET YX=NUM(WDAT$(WX,4)),WX$(WX,4)=""
16340 LET WX=POS("yy"=WX$); IF WX THEN LET YX=NUM(WDAT$(WX,2))
16350 LET WX=POS("mm"=WX$); IF WX THEN LET MX=NUM(WDAT$(WX,2))
16360 LET WX=POS("dd"=WX$); IF WX THEN LET DX=NUM(WDAT$(WX,2))
16370 IF YX<100 THEN LET YX=YX+DATECENTURY
16380 RETURN JUL(YX,MX,DX)
16400 REM ^100 - default is the num(wdat$) - presumed to be a julian number
16410 RETURN INT(NUM(WDAT$,ERR=16420))
16420 RETURN 0
16430 FNEND
17000 REM 17000 - FUNCTIONS
17010 DEF FNFUTVAL(WPMT,WINT,WPER)=SGN(WPER)*WPMT*((1+WINT)^WPER-1)/(WINT+.00000000000001)
17020 DEF FNPREVAL(WPMT,WINT,WPER)=SGN(WPER)*WPMT*(1-(1+WINT)^(-1*WPER))/(WINT+.00000000000001)
17030 DEF FNPMT(WAMT,WINT,WPER)=SGN(WPER)*WAMT*(WINT/(1-(1+WINT)^(-1*WPER)+.00000000000001))
17040 DEF FNRATE(XXWFV,XXWPF,WPER)=(XXWFV/XXWPF)^(1/WPER)-1
17050 DEF FNTERM(WRATE,XXWFV,WPV)=LOG(XXWFV/WPV)/LOG(1+WRATE)
17060 DEF FNROUND(WAMT,WDEC)=INT(WAMT*(10^WDEC)+(.5*SGN(WAMT)))/(10^WDEC)
17070 DEF FNLENGTH(WX$)=LEN(CVS(WX$,3))
17080 DEF FNWIDTH(WX$)=LEN(WX$)
17090 DEF FNDELSTR$(WX$,WSTART,WNCHARS)=FNWK1$(WX$+FILL(WSTART+WNCHARS),WSTART,WNCHARS)
17100 DEF FNLEFT$(WX$,WLEN)=FNWK3$(WX$+FILL(WLEN),1,WLEN)
17110 DEF FNMID$(WX$,WSTART,WLEN)=FNWK3$(WX$+FILL(WSTART+WLEN),WSTART,WLEN)
17120 DEF FNRIGHT$(WX$,WLEN)=FNWK4$(FILL(WLEN)+WX$,WLEN)
17130 DEF FNTRIM$(WX$)=CVS(WX$,3)
17140 DEF FNUCASE$(WX$)=CVS(WX$,4)
17150 DEF FNLCASE$(WX$)=CVS(WX$,8)
17160 REM def fnDAT$(WDAT)=date(WDAT:cvs(DATEMASK$(1,len(DATEMASK$)*(WDAT>99)),3))
17161 DEF FNDAT$(WDAT)
17162 IF WDAT>99 THEN RETURN DATE(WDAT:DATEMASK$) ELSE RETURN ""
17163 FNEND
17170 DEF FNDTM$(WDAT)=DATE(INT(WDAT*FNWK5(WDAT)),FPT(WDAT*FNWK5(WDAT))*24:CVS(DATEMASK$(1,LEN(DATEMASK$)*FNWK5(WDAT)),3)+" "+CVS(TIMEMASK$(1,LEN(TIMEMASK$)*FNWK5(WDAT)),3))
17180 DEF FNDD$(WDAT)=DATE(WDAT*FNWK5(WDAT):FNLEFT$(FILL(3*(1-FNWK5(WDAT)))+"%Dz",3))
17190 DEF FNDDD$(WDAT)=DATE(WDAT*FNWK5(WDAT):FNLEFT$(FILL(3*(1-FNWK5(WDAT)))+"%Ds",3))
17200 DEF FNMM$(WDAT)=DATE(WDAT*FNWK5(WDAT):FNLEFT$(FILL(3*(1-FNWK5(WDAT)))+"%Mz",3))
17210 DEF FNMMM$(WDAT)=DATE(WDAT*FNWK5(WDAT):FNLEFT$(FILL(3*(1-FNWK5(WDAT)))+"%Ms",3))
17220 DEF FNYY$(WDAT)=DATE(WDAT*FNWK5(WDAT):FNLEFT$(FILL(3*(1-FNWK5(WDAT)))+"%Yz",3))
17230 DEF FNYYYY$(WDAT)=DATE(WDAT*FNWK5(WDAT):FNLEFT$(FILL(3*(1-FNWK5(WDAT)))+"%Yd",3))
17240 DEF FNNUMSORT$(WNUM)=BIN(INT(WNUM)+999999999999,6)+BIN(INT((1+FPT(WNUM))*1000000000),4)
17250 DEF FNDEFLTDAT$(WFLD$)=STR(NUM(WFLD$)+JUL(0,0,0)*ABS(SGN(POS(" "<>WFLD$))-1))
17260 DEF FNSORTNUM(WNUM$)=(DEC(WNUM$(1,6))-999999999999)+(DEC(WNUM$(7,4))/1000000000)-1
17270 DEF FNDIVIDE(WNUM,WDIV)=ABS(SGN(WDIV))*WNUM/(WDIV+1-ABS(SGN(WDIV)))
17280 DEF FNTIM$(WDAT)=DATE(INT(WDAT*FNWK5(WDAT)),FPT(WDAT*FNWK5(WDAT))*24:CVS(TIMEMASK$(1,LEN(TIMEMASK$)*FNWK5(WDAT)),3))
17290 DEF FNMMYY$(WDAT)=FNMM$(WDAT)+"/"+FNYY$(WDAT)
17300 DEF FNMMMYY$(WDAT)=FNMMM$(WDAT)+"/"+FNYY$(WDAT)
17310 DEF FNMMYYYY$(WDAT)=FNMM$(WDAT)+"/"+FNYYYY$(WDAT)
17320 DEF FNMMMYYYY$(WDAT)=FNMMM$(WDAT)+"/"+FNYYYY$(WDAT)
17330 DEF FNYYMM$(WDAT)=FNYY$(WDAT)+"/"+FNMM$(WDAT)
17340 DEF FNYYYYMM$(WDAT)=FNYYYY$(WDAT)+"/"+FNMM$(WDAT)
17500 REM ^500 - WORK FUNCTIONS
17510 DEF FNWK1$(W1X$,W1START,W1NCHARS)=FNWK2$(W1X$(1,W1START-1)+W1X$(W1START+W1NCHARS))
17520 DEF FNWK2$(W2X$)=W2X$(1,LEN(W2X$)-1*SGN(LEN(W2X$)))
17530 DEF FNWK3$(W3X$,W3START,W3LEN)=W3X$(W3START,W3LEN)
17540 DEF FNWK4$(W4X$,W4LEN)=W4X$(LEN(W4X$)-W4LEN+1)
17550 DEF FNWK5(WNUM)=SGN(INT(WNUM/99))
17560 DEF FNSTRIP$(WX$)=CVS(WX$,3)
17570 DEF FNGETITEM$(WITEM$,WITEMLIST$)=WITEMLIST$(POS(WITEM$+$11$=WITEMLIST$)+LEN(WITEM$)+5,NUM(WITEMLIST$(POS(WITEM$+$11$=WITEMLIST$)+LEN(WITEM$)+1,4)))
17580 DEF FNFILL$(WX$,WX)=WX$+FILL((WX-LEN(WX$))*(LEN(WX$)<WX))
17590 DEF FNRTRIM$(WX$)=CVS(WX$,2)
17600 DEF FNPARSE$(WLIST$,WFLD,WDLM$)
17605 IF WLIST$="" THEN RETURN "" ELSE IF WLIST$(LEN(WLIST$),1)<>WDLM$ THEN LET WLIST$=WLIST$+WDLM$
17610 LET WX1=POS(WDLM$=WLIST$,1,WFLD-1)*SGN(WFLD-1)+1,WX2=POS(WDLM$=WLIST$,1,WFLD)
17620 IF WX2>WX1 THEN RETURN WLIST$(WX1,WX2-WX1) ELSE RETURN ""
17630 FNEND
18000 REM 18000 - USER DEFINE FUNCTIONS
19000 REM 19000 - USER DEFINED VARIABLES
19990 REM 19990,2
19992 SETERR 8900; RETURN 
20000 REM 20000 - SELECT ASSIGNMENTS
22990 REM 22990,2
22992 SETERR 8900; RETURN 
23000 REM 23000 - SORT ASSIGNMENTS
23990 REM 23990,2
23992 RETURN 
24000 REM 24000 - LITERAL ASSIGNMENTS
24990 REM 24990,2
24992 RETURN 
25000 REM 25000 - SELECT/FIELD PHRASE REFS
25010 LET REF_EOF=0,SAVEKY$=KY$; GOSUB 45010
26990 REM 26990,2
26992 LET KY$=SAVEKY$; RETURN 
27000 REM 27000 - SORT/SELECT PHRASE REFS
27010 LET SAVEKY$=KY$; GOSUB 46010
28990 REM 28990,2
28992 LET KY$=SAVEKY$; RETURN 
30000 REM 30000 - CROSS REFERENCE
40000 REM 40000 - HEADER/FOOTER LOADING
43990 REM 43990,2
43992 RETURN 
44000 REM 44000 - FILIX MEMO LOADER
44010 REM "TEMP_FLXMMO=CHAN, TEMP_FLXLBL$=LABEL, TEMP_FLXBLK=BLOCK SIZE; RETURNS TEMP_FLXMMO$
44020 LET TEMP_FLXMMO$=""; READ (TEMP_FLXMMO,KEY=$11$+KY$+TEMP_FLXLBL$,DOM=44030)
44030 LET MMOKY$=KEY(TEMP_FLXMMO,END=44100); IF MMOKY$>$FF$+KY$+TEMP_FLXLBL$+$FF$ THEN GOTO 44100
44040 READ RECORD(TEMP_FLXMMO)WTEXT$; LET WTEXT$=WTEXT$(LEN(KY$)+6),WTEXT$=WTEXT$(1,POS($0A$=WTEXT$,-1)-1)
44050 FOR X=1 TO LEN(WTEXT$) STEP TEMP_FLXBLK
44060 LET X$=FNLEFT$(WTEXT$(X),TEMP_FLXBLK),TEMP_FLXMMO$=TEMP_FLXMMO$+X$
44070 NEXT X
44080 GOTO 44030
44100 REM ^100 - DONE
44992 REM 44992,2
44994 RETURN 
45000 REM 45000
45010 REM 45010
45900 REM 45900
45910 RETURN 
46000 REM 46000
46010 REM 46010
46900 REM 46900
46910 RETURN 
50000 REM 50000 - FIELD ASSIGNMENTS
59990 REM 59990,2
59992 RETURN 
60000 REM 60000 - HEADER/FOOTER CUSTOM ASSIGNMENTS
64990 REM 64990,2
64992 RETURN 
