Routine: ANRVML2

ANRVML2 ;BIRM/LDT - VIST MAILING LABELS BY CITY ; 28 Feb 98 / 2:38 PM

 ;;4.0; Visual Impairment Service Team ;;12 Jun 98

EN1 ;Entry point for City List

 K ANRVLP W @IOF,!!,"MAILING LABELS BY CITY",!!

 D SEL I '$D(ANRVLP),SEL'="A" G QUIT

DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!!" G QUIT

 I $D(IO("Q")) K IO("Q") S ZTDESC="VIST MAILING LABELS BY CITY",ZTRTN="DEQ^ANRVML2" S:$D(ANRVLP) ZTSAVE("ANRVLP(")="" S:$D(SEL) ZTSAVE("SEL")=""

 I  D ^%ZTLOAD K ZTSK G QUIT

 U IO

DEQ ;Entry point when queued.

 S ANRVP=0 F  S ANRVP=$O(^ANRV(2040,ANRVP)) Q:'ANRVP  I $P($G(^ANRV(2040,ANRVP,13)),U,2)'="I" S DFN=$P($G(^ANRV(2040,ANRVP,0)),U) D 4^VADPT,MAILBL

QUIT K %,%H,%I,%T,%Y,ANRVP,ANRV,ANRVLP,DFN,SEL D KVAR^VADPT,KVA^VADPT

 W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"

MAILBL ;

 I $D(ANRVLP),VAPA(4)]"",$D(ANRVLP(VAPA(4))) D ^ANRVML

 I $D(SEL),SEL="A" D ^ANRVML

SEL W !!,"Do you want to print the mailing labels for:",!?3,"(A)ll cities or",!?3,"(S)elect city/cities",!!

 S DIR(0)="SAOBM^A:ALL;S:SELECTED",DIR("A")="Choose A or S: ",DIR("?")="^D HELPSEL^ANRVML2" D ^DIR K DIR

 S SEL=Y I SEL="A" Q

 S:SEL="" SEL="^" G:SEL="^" QUIT2

W !

ASKCTY S DIR(0)="FAO^2:15",DIR("A")="Select CITY NAME: " D ^DIR K DIR

 I Y]"",Y'="^"  D SETLP G ASKCTY

QUIT2 K:SEL="^"!(SEL="") %,DIR,X,Y Q

SETLP I Y?1U.E S ANRVLP($TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))="",ANRVLP($TR($E(Y,1),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")_$E(Y,2,15))=""

 I Y?1L.E S ANRVLP($TR(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))="",ANRVLP($TR($E(Y,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(Y,2,15))=""

 I Y?1U.E S ANRVLP($E(Y)_($TR($E(Y,2,15),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")))="",ANRVLP($TR(Y,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"))=""

 S ANRVLP(Y)=""

HELPSEL ;

 W !!,"Enter:",!?3,"""A"" to print mailing labels for ALL cities.",!?3,"""S"" to select only a specific city or cities.",!?3,"""^"" or <return> to halt." Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HANRVML2   2116     printed  Apr 23, 2025@19:00:19                                                                                                                                                                                                     Page 2

ANRVML2   ;BIRM/LDT - VIST MAILING LABELS BY CITY ; 28 Feb 98 / 2:38 PM

 +1       ;;4.0; Visual Impairment Service Team ;;12 Jun 98

EN1       ;Entry point for City List

 +1        KILL ANRVLP

           WRITE @IOF,!!,"MAILING LABELS BY CITY",!!

 +2        DO SEL

           IF '$DATA(ANRVLP)

               IF SEL'="A"

                   GOTO QUIT

DEV        KILL %ZIS,IOP

           SET %ZIS="QM"

           SET %ZIS("B")=""

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"

               GOTO QUIT

 +1        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTDESC="VIST MAILING LABELS BY CITY"

               SET ZTRTN="DEQ^ANRVML2"

               if $DATA(ANRVLP)

                   SET ZTSAVE("ANRVLP(")=""

               if $DATA(SEL)

                   SET ZTSAVE("SEL")=""

 +2       IF $TEST

               DO ^%ZTLOAD

               KILL ZTSK

               GOTO QUIT

 +3        USE IO

DEQ       ;Entry point when queued.

 +1        SET ANRVP=0

FOR

               SET ANRVP=$ORDER(^ANRV(2040,ANRVP))

               if 'ANRVP

                   QUIT

               IF $PIECE($GET(^ANRV(2040,ANRVP,13)),U,2)'="I"

                   SET DFN=$PIECE($GET(^ANRV(2040,ANRVP,0)),U)

                   DO 4^VADPT

                   DO MAILBL

 +2       ;

QUIT       KILL %,%H,%I,%T,%Y,ANRVP,ANRV,ANRVLP,DFN,SEL

           DO KVAR^VADPT

           DO KVA^VADPT

 +1        if $EXTRACT(IOST)'="C"

               WRITE @IOF

           DO ^%ZISC

           if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        QUIT

 +3       ;

MAILBL    ;

 +1        IF $DATA(ANRVLP)

               IF VAPA(4)]""

                   IF $DATA(ANRVLP(VAPA(4)))

                       DO ^ANRVML

 +2        IF $DATA(SEL)

               IF SEL="A"

                   DO ^ANRVML

 +3        QUIT

 +4       ;

SEL        WRITE !!,"Do you want to print the mailing labels for:",!?3,"(A)ll cities or",!?3,"(S)elect city/cities",!!

 +1        SET DIR(0)="SAOBM^A:ALL;S:SELECTED"

           SET DIR("A")="Choose A or S: "

           SET DIR("?")="^D HELPSEL^ANRVML2"

           DO ^DIR

           KILL DIR

 +2        SET SEL=Y

           IF SEL="A"

               QUIT

 +3        if SEL=""

               SET SEL="^"

           if SEL="^"

               GOTO QUIT2

 +4        WRITE !

ASKCTY     SET DIR(0)="FAO^2:15"

           SET DIR("A")="Select CITY NAME: "

           DO ^DIR

           KILL DIR

 +1        IF Y]""

               IF Y'="^"

                   DO SETLP

                   GOTO ASKCTY

QUIT2      if SEL="^"!(SEL="")

               KILL %,DIR,X,Y

           QUIT

SETLP      IF Y?1U.E

               SET ANRVLP($TRANSLATE(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))=""

               SET ANRVLP($TRANSLATE($EXTRACT(Y,1),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")_$EXTRACT(Y,2,15))=""

 +1        IF Y?1L.E

               SET ANRVLP($TRANSLATE(Y,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ"))=""

               SET ANRVLP($TRANSLATE($EXTRACT(Y,1),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$EXTRACT(Y,2,15))=""

 +2        IF Y?1U.E

               SET ANRVLP($EXTRACT(Y)_($TRANSLATE($EXTRACT(Y,2,15),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")))=""

               SET ANRVLP($TRANSLATE(Y,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz"))=""

 +3        SET ANRVLP(Y)=""

 +4        QUIT

HELPSEL   ;

 +1        WRITE !!,"Enter:",!?3,"""A"" to print mailing labels for ALL cities.",!?3,"""S"" to select only a specific city or cities.",!?3,"""^"" or <return> to halt."

           QUIT

ANRVML2.m