CP/M/CPM_CDROM.iso/lambda/soundpot/p/reliance.lbr/MPRTPROC.BZS/MPRTPROC.BAS

BASIC Source File | 1993-10-25 | 11.1 KB | 448 lines

REM --- MPRTPROC.BAS
COMMENT
    ***********************************************************
    *    This Include module contains procedures for       *
    *    the Reliance Mailing List program, PGM=MAIL      *
    *    Contains procedures to print the labels          *
    ***********************************************************
END

PROCEDURE BUILD.ZIP.INDEX
REM ---    Builds index of zip code + name in core, then sorts it

    REM --- The following are used to build the index
    VAR    N = INTEGER    ; Subscript to index arrays
    VAR    ZX.END = INTEGER ; Last element used in zip index array

    REM --- The following are used to sort the index
    VAR    D = INTEGER    ; Distance separating elements compared
    VAR    SORTED = BYTE    ; Boolean -- whether intermediate sort is done
    VAR    ZX.KEY.SWAP = STRING:14 ; Used to swap array elements
    VAR    ZX.PTR.SWAP = INTEGER   ; Used to swap array elements

REM ---    Build index in array in core

    WRITESTR "BUILDING INDEX", 19, 8
    OPEN #2; MLIST
    FOR N = 0 TO MAXREC
        IF MX.PTR.ARRAY (N) = MAXINT THEN
            N = MAXREC
        ELSE
            BEGIN
            MX.PTR.WORK = MX.PTR.ARRAY (N)
            READ #2,MX.PTR.WORK
            ZX.KEY.ARRAY (N) = ZIP + SPC(9-LEN(ZIP)) + MX.KEY.ARRAY (N)
            ZX.PTR.ARRAY (N) = MX.PTR.WORK
            ZX.END = N
            END
    NEXT N
    CLOSE #2

    IF ZX.END < MAXREC THEN
        BEGIN
        REM --- Flag end of zip array
        ZX.KEY.ARRAY (ZX.END + 1) = STRING (14, 0FFH)
        ZX.PTR.ARRAY (ZX.END + 1) = MAXINT
        END

COMMENT
    The following sorts the zip index.  The sort is a version of
    the "Shell" sort translated from Grillo & Robertson, Data
    Management Techniques, (Dubuque: Wm. C. Brown, 1981), page 35.
END

    WRITESTR "SORTING INDEX ", 19, 8
    VAR    X = INTEGER
    D = ZX.END / 2
    WHILE D > 0 DO
        BEGIN
        REM --- Print stuff to indicate something happening
        PRINT "+";
        REPEAT
            BEGIN
            SORTED = 'Y'
            FOR N = 0 TO ZX.END - D
                X = N + D
                IF ZX.KEY.ARRAY (N) > ZX.KEY.ARRAY (X) THEN
                    BEGIN
                    ZX.KEY.SWAP = ZX.KEY.ARRAY (X)
                    ZX.KEY.ARRAY (X) = ZX.KEY.ARRAY (N)
                    ZX.KEY.ARRAY (N) = ZX.KEY.SWAP
                    ZX.PTR.SWAP = ZX.PTR.ARRAY (X)
                    ZX.PTR.ARRAY (X) = ZX.PTR.ARRAY (N)
                    ZX.PTR.ARRAY (N) = ZX.PTR.SWAP
                    SORTED = 'N'
                    END ; END IF
            NEXT N
            END \    ; END REPEAT
        UNTIL SORTED
        D = D / 2
        END    ; END WHILE
END    ; END PROC = BUILD.ZIP.INDEX

REM ------------------------------------------------------------

PROCEDURE PRINT.LIST (SORT.TYPE = STRING:8; SELECT.TYPE,U.CODE = BYTE;
             Z.CODE = STRING:5)
    REM --- Assumes 80-column width and 66-line page length
    VAR    LINE, PAGE, N = INTEGER
    VAR    FORM.FEED = BYTE
    FORM.FEED = 0CH
    VAR    SOME.PRINTED = BYTE    ; Boolean -- Whether we found any

    WRITESTR "PUT PLAIN PAPER IN THE PRINTER, THEN PRESS <RETURN>", 19, 8
    WRITESTR "TO START PRINTING, OR PRESS <ESC> TO CANCEL", 20, 8
    ECHO OFF
    REPEAT
        INPUT3 ANS
    UNTIL ANS = CARR.RTN OR ANS = ESCAPE
    ECHO ON
    IF ANS = ESCAPE THEN
        0PRINT.LIST.END

REM --- Initialize
    LINE = 99
    PAGE = 0
    SOME.PRINTED = 'N'
    OPEN #2; MLIST

REM --- Print the list
    LPRINTER
    FOR N = 0 TO MAXREC
        BEGIN
        IF SORT.TYPE = "NAME" THEN
            MX.PTR.WORK = MX.PTR.ARRAY (N)
        ELSE
            MX.PTR.WORK = ZX.PTR.ARRAY (N)
        IF MX.PTR.WORK = MAXINT THEN
            N = MAXREC
        ELSE
            BEGIN
            READ #2,MX.PTR.WORK
            IF SELECT.TYPE = '1' \
            OR (SELECT.TYPE = '2' AND LEFT$(ZIP,5) = Z.CODE) \
            OR (SELECT.TYPE = '3' AND USER.CODE = U.CODE) THEN
                BEGIN
                SOME.PRINTED = 'Y'
                IF LINE > 54 THEN
                    BEGIN
                    REM --- Print page header
                    PRINT FORM.FEED
                    PRINT "MAILING LIST SORTED BY ";SORT.TYPE;
                    PRINT TAB(35);
                    CASE SELECT.TYPE OF
                    "1" : PRINT "-- ALL --";
                    "2" : PRINT "ZIP CODE "; Z.CODE;
                    "3" : PRINT "USER CODE "; U.CODE;
                    END    ; END CASE
                    PRINT TAB(65);
                    PAGE = PAGE + 1
                    PRINT "PAGE";PAGE
                    LINE = 0
                    END
                PRINT
                PRINT LAST.NAME; ", "; FRST.NAME; TAB(33);
                PRINT "Home: ";
                IF LEN(HOME.PHON) <> 0 THEN
                    BEGIN
                    IF LEN(HOME.PHON) = 7 THEN
                        BEGIN
                        PRINT MID$(HOME.PHON,1,3);
                        PRINT "-"; MID$(HOME.PHON,4,4)
                        END
                    ELSE
                        BEGIN
                        PRINT "("; MID$(HOME.PHON,1,3); ")";
                        PRINT MID$(HOME.PHON,4,3);
                        PRINT "-"; MID$(HOME.PHON,7,4)
                        END
                    END
                ELSE
                    PRINT
                PRINT TAB(4); ADDR1; TAB(33);
                PRINT "Work: ";
                IF LEN(WORK.PHON) <> 0 THEN
                    BEGIN
                    IF LEN(WORK.PHON) = 7 THEN
                        BEGIN
                        PRINT MID$(WORK.PHON,1,3);
                        PRINT "-"; MID$(WORK.PHON,4,4)
                        END
                    ELSE
                        BEGIN
                        PRINT "("; MID$(WORK.PHON,1,3); ")";
                        PRINT MID$(WORK.PHON,4,3);
                        PRINT "-"; MID$(WORK.PHON,7,4)
                        END
                    END
                ELSE
                    PRINT
                PRINT TAB(4); ADDR2; TAB(33);
                PRINT "Code: "; USER.CODE
                PRINT TAB(4); CITY; TAB(21); STATE; " "; ZIP
                LINE = LINE + 5
                END
            END
        END
    NEXT N
    CONSOLE

    IF NOT SOME.PRINTED THEN
        BEGIN
        WRITESTR SPC(55), 19, 8
        WRITESTR SPC(55), 20, 8
        PRINT BEL
        WRITESTR "NO RECORDS FOUND", 19, 8
        PAUSE
        END

    CLOSE #2

0PRINT.LIST.END
END    ; END PROC=PRINT.LIST

REM ------------------------------------------------------------

PROCEDURE PRINT.LABELS (SORT.TYPE = STRING:5; SELECT.TYPE,U.CODE = BYTE;
            Z.CODE = STRING:5)
COMMENT
    Print the mailing list on 2-up continuous labels.
    Assumes labels 4" X 15/16" and printer doing
    10 cpi horizontally and 6 lpi vertically.
END

    VAR    N = INTEGER        ; Loop control
    VAR    SOME.PRINTED = BYTE ; Boolean -- whether we found any
    VAR    L.IS.EMPTY   = BYTE ; Boolean -- whether right buffer is empty

    REM --- The following is for the left label print buffer
    VAR    L.LAST.NAME = STRING:15
    VAR    L.FRST.NAME = STRING:10
    VAR    L.ADDR1     = STRING:25
    VAR    L.ADDR2     = STRING:25
    VAR    L.CITY      = STRING:12
    VAR    L.STATE     = STRING:2
    VAR    L.ZIP       = STRING:9
    VAR    L.USER.CODE = BYTE

    REM --- The following is for the right label print buffer
    VAR    R.LAST.NAME = STRING:15
    VAR    R.FRST.NAME = STRING:10
    VAR    R.ADDR1     = STRING:25
    VAR    R.ADDR2     = STRING:25
    VAR    R.CITY      = STRING:12
    VAR    R.STATE     = STRING:2
    VAR    R.ZIP       = STRING:9
    VAR    R.USER.CODE = BYTE

    PROCEDURE PRT.LBLS
        LPRINTER
        PRINT
        PRINT TAB(3); L.LAST.NAME; ", "; L.FRST.NAME;
        PRINT TAB(31); L.USER.CODE;
        PRINT TAB(43); R.LAST.NAME; ", "; R.FRST.NAME;
        PRINT TAB(71); R.USER.CODE
        PRINT TAB(3); L.ADDR1; TAB(43); R.ADDR1
        PRINT TAB(3); L.ADDR2; TAB(43); R.ADDR2
        PRINT TAB(3); L.CITY; TAB(20); L.STATE; TAB(23); L.ZIP;
        PRINT TAB(43); R.CITY; TAB(60); R.STATE; TAB(63); R.ZIP
        PRINT
        CONSOLE
    END    ; END PROC = PRT.LBLS

REM --- Begin main line of PROC = PRINT.LABELS

    WRITESTR "PUT 2-UP CONTINUOUS LABELS IN THE PRINTER, THEN PRESS",19,8
    WRITESTR "<RETURN> TO START PRINTING, OR PRESS <ESC> TO CANCEL",20,8
    ECHO OFF
    REPEAT
        INPUT3 ANS
    UNTIL ANS = CARR.RTN OR ANS = ESCAPE
    ECHO ON
    IF ANS = ESCAPE THEN
        0PRINT.LABELS.END

REM --- Print dummy lines until forms are aligned
    WRITESTR "PRINTING DUMMY LINES TILL FORMS ARE ALIGNED          ",19,8
    WRITESTR SPC(53), 20, 8
    R.LAST.NAME = STRING (15,'X')
    R.FRST.NAME = STRING (10,'X')
    R.ADDR1        = STRING (25,'X')
    R.ADDR2        = STRING (25,'X')
    R.CITY        = STRING (12,'X')
    R.STATE        = "XX"
    R.ZIP        = STRING (9,'9')
    R.USER.CODE = 'X'
    L.LAST.NAME = STRING (15,'X')
    L.FRST.NAME = STRING (10,'X')
    L.ADDR1     = STRING (25,'X')
    L.ADDR2     = STRING (25,'X')
    L.CITY      = STRING (12,'X')
    L.STATE     = "XX"
    L.ZIP       = STRING (9,'9')
    L.USER.CODE = 'X'
    REPEAT
        BEGIN
        PRT.LBLS
        WRITESTR "IS THIS OK?",20,8
        READ.BOOL 20, 20
        END
    UNTIL ANS

REM --- Fill label buffers and print

    OPEN #2; MLIST
    L.IS.EMPTY = 'Y'
    SOME.PRINTED = 'N'
    FOR N = 0 TO MAXREC
        IF SORT.TYPE = "NAME" THEN
            MX.PTR.WORK = MX.PTR.ARRAY (N)
        ELSE
            MX.PTR.WORK = ZX.PTR.ARRAY (N)
        IF MX.PTR.WORK = MAXINT THEN
            N = MAXREC    ; Don't read any more
        ELSE
            BEGIN
            READ #2, MX.PTR.WORK
            IF SELECT.TYPE = '1' \
            OR (SELECT.TYPE = '2' AND LEFT$(ZIP,5) = Z.CODE) \
            OR (SELECT.TYPE = '3' AND USER.CODE = U.CODE) THEN
                BEGIN
                SOME.PRINTED = 'Y'
                IF L.IS.EMPTY THEN
                    BEGIN
                    L.LAST.NAME = LAST.NAME
                    L.FRST.NAME = FRST.NAME
                    L.ADDR1     = ADDR1
                    L.ADDR2     = ADDR2
                    L.CITY      = CITY
                    L.STATE     = STATE
                    L.ZIP       = ZIP
                    L.USER.CODE = USER.CODE
                    L.IS.EMPTY = 'N'
                    END
                ELSE
                    BEGIN
                    R.LAST.NAME = LAST.NAME
                    R.FRST.NAME = FRST.NAME
                    R.ADDR1     = ADDR1
                    R.ADDR2     = ADDR2
                    R.CITY      = CITY
                    R.STATE     = STATE
                    R.ZIP       = ZIP
                    R.USER.CODE = USER.CODE
                    PRT.LBLS
                    L.IS.EMPTY = 'Y'
                    END
                END
            END
    NEXT N

REM --- If there is anything left to print, print it
    IF NOT L.IS.EMPTY THEN
        BEGIN
        SOME.PRINTED = 'Y'
        R.LAST.NAME = SPC(15)
        R.FRST.NAME = SPC(10)
        R.ADDR1     = SPC(25)
        R.ADDR2     = "   *** END OF LABELS ***"
        R.CITY      = SPC(12)
        R.STATE     = "  "
        R.ZIP       = SPC(9)
        R.USER.CODE = ' '
        PRT.LBLS
        END

    IF NOT SOME.PRINTED THEN
        BEGIN
        WRITESTR SPC(55), 19, 8
        WRITESTR SPC(55), 20, 8
        PRINT BEL
        WRITESTR "NO RECORDS FOUND", 19, 8
        PAUSE
        END

    CLOSE #2

0PRINT.LABELS.END
END    ; END PROC = PRINT.LABELS

REM ------------------------------------------------------------

PROCEDURE PRINT.NAMES (PRT.TYPE = INTEGER)
    REM --- PRT.TYPE 1 = Print mailing list, 2 = labels

    VAR    SORT.TYPE = STRING:8    ; "NAME" or "ZIP CODE"
    VAR    SELECT.TYPE = BYTE    ; 1 = all, 2 = zip code, 3 = user code
    VAR    U.CODE    = BYTE    ; User code to select on
    VAR    Z.CODE    = STRING:5    ; Zip code to select on

    IF PRT.TYPE = 1 THEN
        PAINT.SCREEN 8
    ELSE
        PAINT.SCREEN 9
    REM --- Ask if sort is by name or zip code
0PL0    REPEAT
        GET.STRING 8,43,1,'N',""
    UNTIL Q$ = "1" OR Q$ = "2" OR QESC
    IF QESC THEN 0PRINT.NAMES.END
    IF Q$ = "1" THEN
        SORT.TYPE = "NAME"
    ELSE
        SORT.TYPE = "ZIP CODE"

    REM ---- Ask for selection criterion
0PL1    REPEAT
        GET.STRING 14,43,1,'N',""
    UNTIL Q$="1" OR Q$="2" OR Q$="3" OR QPREV OR QESC
    IF QESC THEN 0PRINT.NAMES.END
    IF QPREV THEN 0PL0
    SELECT.TYPE = Q$

    IF SELECT.TYPE = "1" THEN
        BEGIN
        U.CODE = 00H
        Z.CODE = STRING (5,00H)
        END
    ELSE IF SELECT.TYPE = "2" THEN
        BEGIN
        WRITESTR "ENTER THE ZIP CODE ==>",16,8
        GET.STRING 16,31,5,'N',""
        IF QESC THEN 0PRINT.NAMES.END
        IF QPREV THEN
            BEGIN
            WRITESTR SPC(28),16,8
            GOTO 0PL1
            END
        U.CODE = 00H
        Z.CODE = Q$
        END
    ELSE IF SELECT.TYPE = "3" THEN
        BEGIN
        WRITESTR "ENTER THE USER CODE ==>",16,8
        GET.STRING 16,32,1,'S',""
        IF QESC THEN 0PRINT.NAMES.END
        IF QPREV THEN
            BEGIN
            WRITESTR SPC(25),16,8
            GOTO 0PL1
            END
        U.CODE = Q$
        Z.CODE = STRING (5,00H)
        END

    IF SORT.TYPE = "ZIP CODE" THEN
        BUILD.ZIP.INDEX

    IF PRT.TYPE = 1 THEN
        PRINT.LIST SORT.TYPE, SELECT.TYPE, U.CODE, Z.CODE
    ELSE
        PRINT.LABELS SORT.TYPE, SELECT.TYPE, U.CODE, Z.CODE

0PRINT.NAMES.END
END    ; END PROC=PRINT.NAMES
'N',""
    UNTIL Q$="1" OR Q$="2" OR Q$="3" OR QPREV OR QESC
    IF QESC THEN 0PRINT.NAMES.END
    IF QPREV THEN 0PL0