Routine: ENLBL4

ENLBL4 ;(WASH ISC)/DH-Print Bar Coded Location Labels ;10.10.97

 ;;7.0;ENGINEERING;**12,35,42,45,90**;Aug 17, 1993;Build 25

WING ;Print an entire WING from Space File (6928)

 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3

 N DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1

 W @IOF R !!,"Select WING: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 I "?"[X D WHELP1^ENLBL8

 I X["??" D WHELP2^ENLBL8

 I X]"",$D(^ENG("SP","C",X)) D WING1 G EXIT1^ENLBL8

 I X]"" W " ??",!,*7,"Invalid entry. Press <RETURN> to continue, '^' to exit, or ""?"" for help..." R X:DTIME D:X["?" WHELP1^ENLBL8 G:X="^" EXIT1^ENLBL8

 S X="" G WING

WING1 K ENEQC S ENEQC=X W !!,"For all rooms in WING: ",ENEQC S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 G:%<1 WING1 D:%=2 FLOOR^ENLBL8

 K IO("Q") S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8

 S ENBCIO=IO,ENBCIOSL=IOSL,ENBCIOF=IOF,ENBCION=ION,ENBCIOST=IOST,ENBCIOST(0)=IOST(0),ENBCIOS=IOS S:$D(IO("S")) ENBCIO("S")=IO("S")

 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="WING2^ENLBL4",ZTSAVE("EN*")="",ZTDESC="Location Barcode Labels (WING)" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EXIT1^ENLBL8

WING2 K ^TMP($J) S ENBCIO=IO U ENBCIO D FORMAT  ;HD308658

 F DA=0:0 S DA=$O(^ENG("SP","C",ENEQC,DA)) Q:DA=""  S ENEQB=$P(^ENG("SP",DA,0),U,1) I ENEQB]"" D SORT D:'(DA#20) DOTS^ENLBL3

 I $D(^TMP($J)) S J=0 F  S J=$O(^TMP($J,J)) Q:J=""  S DA=$O(^TMP($J,J,0)) I DA>0 S ENEQB=^(DA) U ENBCIO D LOCPRT I ENEQB'["E" D:'(+ENEQB#10) DOTS^ENLBL3

BLDG ;Print labels for all rooms in specified building

 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3

 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1

 S DIC="^ENG(6928.3,",DIC(0)="AEQM" D ^DIC G:Y'>0 EXIT1^ENLBL8 S X=$P(^ENG(6928.3,+Y,0),U),ENBLDG=$P(X,"-",1),ENDIV=$P(X,"-",2)

 S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" K IO("Q") D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8

 S ENBCIO=IO,ENBCIOSL=IOSL,ENBCIOF=IOF,ENBCION=ION,ENBCIOST=IOST,ENBCIOST(0)=IOST(0),ENBCIOS=IOS S:$D(IO("S")) ENBCIO("S")=IO("S")

 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="BLDG1^ENLBL4",ZTSAVE("EN*")="",ZTDESC="Location Barcode Labels (BUILDING)" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EXIT1^ENLBL8

BLDG1 K ^TMP($J) S ENBCIO=IO   ;HD308658

 F DA=0:0 S DA=$O(^ENG("SP","E",ENBLDG,DA)) Q:DA'>0  D CKDIV D:'(+DA#20) DOTS^ENLBL3

 I $D(^TMP($J)) D

 . U ENBCIO D FORMAT

 . S J=0 F  S J=$O(^TMP($J,J)) Q:J=""  S DA=$O(^TMP($J,J,0)) I DA>0 S ENEQB=^(DA) U ENBCIO D LOCPRT D:'(DA#10) DOTS^ENLBL3

 G EXIT1^ENLBL8

CKDIV Q:'$D(^ENG("SP",DA,0))  S ENEQB=$P(^(0),U,1) I $D(ENDIV),$P(ENEQB,"-",3)'=ENDIV Q

 D SORT

RM ;Print a single room label

 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3

 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1

RM0 S DIC="^ENG(""SP"",",DIC(0)="AEQMZ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQB=Y(0,0),DA=+Y

 K IO("Q") S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8

 S ENBCIO=IO,ENBCIOSL=IOSL,ENBCIOF=IOF,ENBCION=ION,ENBCIOST=IOST,ENBCIOST(0)=IOST(0),ENBCIOS=IOS S:$D(IO("S")) ENBCIO("S")=IO("S")

 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="RM1^ENLBL4",ZTSAVE("EN*")="",ZTSAVE("DA")="",ZTDESC="Location Barcode Label (ROOM)" D ^%ZTLOAD K ZTSK D ^%ZISC G RM0

RM1 S ENBCIO=IO U ENBCIO D FORMAT  ;HD308658

 D LOCPRT

 G:$D(ZTQUEUED) EXIT1^ENLBL8

 D ^%ZISC G RM0

ALL ;Print a location label for every record in the SPACE file

 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3

 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1

 K IO("Q") S %ZIS="Q",%ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="" D ^%ZIS K %ZIS("A") G:POP EXIT1^ENLBL8

 S ENBCIO=IO,ENBCIOSL=IOSL,ENBCIOF=IOF,ENBCION=ION,ENBCIOST=IOST,ENBCIOST(0)=IOST(0),ENBCIOS=IOS S:$D(IO("S")) ENBCIO("S")=IO("S")

 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="ALL1^ENLBL4",ZTSAVE("EN*")="",ZTDESC="Location Barcode Labels (ALL)" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EXIT1^ENLBL8

ALL1 K ^TMP($J) S ENBCIO=IO U ENBCIO D FORMAT  ;HD308658

 F DA=0:0 S DA=$O(^ENG("SP",DA)) Q:DA'>0  I $D(^(DA,0)) S ENEQB=$P(^(0),U) I ENEQB]"" D SORT D:'(DA#20) DOTS^ENLBL3

 I $D(^TMP($J)) S J=0 F  S J=$O(^TMP($J,J)) Q:J=""  S DA=$O(^TMP($J,J,0)) I DA>0 S ENEQB=^(DA) U ENBCIO D LOCPRT D:'(DA#10) DOTS^ENLBL3

 G EXIT1^ENLBL8

SORT I $D(ENEQC("FR")) I ENEQC("FR")]ENEQB!(ENEQB]ENEQC("TO")) Q

 I $D(^ENG("SP",DA,9)) S X=$P(^(9),U),^TMP($J,X,DA)=ENEQB Q

 F I=1:1:3 S X(I)=$P(ENEQB,"-",I)

 S X=X(3)_":"_X(2)_":"_X(1),^TMP($J,X,DA)=ENEQB

LOCPRT ;Actual print

 I ENEQB["e" S ENEQB=$TR(ENEQB,"e","E")

 I ENEQB'?.NUP D WARN^ENLBL8 Q

 S ENEQBC="SP"_ENEQB

 I ENBAR("LOCATION DATA")]"" X ENBAR("LOCATION DATA") Q

 W *2,*27,"E3",!,*24

 N ENX S ENX="*  LOCATION   LABEL  *" I $D(^DIC(6910,1,0)),$P(^(0),U,9)=1,$D(^ENG("SP",DA,4)) S X=$P(^(4),U) I X]"",$D(^ENG(6928.1,X,0)) S X1=$P(^(0),U),ENX=$E(X1,1,20)

 W ENX,!,ENEQBC,!,ENEQSTAN

 W *23,*3

FORMAT ;Location labels

 K ENBAR S (ENBAR("LOCATION FORMAT"),ENBAR("LOCATION DATA"))=""

 S ENBCIOS(0)=$O(^DIC(6910.1,"B",ENBCIOS,0)) D:ENBCIOS(0)

 . S ENBAR("LOCATION FORMAT")=$G(^DIC(6910.1,ENBCIOS(0),2))

 . S ENBAR("LOCATION DATA")=$G(^DIC(6910.1,ENBCIOS(0),4))

 I ENBAR("LOCATION FORMAT")]"" X ENBAR("LOCATION FORMAT") Q

 D FORMAT1^ENLBL7

 ;ENLBL4

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL4   5212     printed  Mar 13, 2025@20:58:59                                                                                                                                                                                                      Page 2

ENLBL4    ;(WASH ISC)/DH-Print Bar Coded Location Labels ;10.10.97

 +1       ;;7.0;ENGINEERING;**12,35,42,45,90**;Aug 17, 1993;Build 25

WING      ;Print an entire WING from Space File (6928)

 +1        SET ENERR=0

           DO STA^ENLBL3

           if ENEQSTA="^"

               GOTO QUIT^ENLBL3

 +2        NEW DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1

 +3        WRITE @IOF

           READ !!,"Select WING: ",X:DTIME

           if X="^"!(X="")

               GOTO EXIT1^ENLBL8

           IF "?"[X

               DO WHELP1^ENLBL8

 +4        IF X["??"

               DO WHELP2^ENLBL8

 +5        IF X]""

               IF $DATA(^ENG("SP","C",X))

                   DO WING1

                   GOTO EXIT1^ENLBL8

 +6        IF X]""

               WRITE " ??",!,*7,"Invalid entry. Press <RETURN> to continue, '^' to exit, or ""?"" for help..."

               READ X:DTIME

               if X["?"

                   DO WHELP1^ENLBL8

               if X="^"

                   GOTO EXIT1^ENLBL8

 +7        SET X=""

           GOTO WING

WING1      KILL ENEQC

           SET ENEQC=X

           WRITE !!,"For all rooms in WING: ",ENEQC

           SET %=1

           DO YN^DICN

           if %<0

               GOTO EXIT1^ENLBL8

           if %<1

               GOTO WING1

           if %=2

               DO FLOOR^ENLBL8

 +1        KILL IO("Q")

           SET %ZIS("A")="Select BARCODE PRINTER: "

           SET %ZIS="Q"

           SET %ZIS("B")=""

           DO ^%ZIS

           KILL %ZIS("A"),%ZIS("B")

           if POP

               GOTO EXIT1^ENLBL8

 +2        SET ENBCIO=IO

           SET ENBCIOSL=IOSL

           SET ENBCIOF=IOF

           SET ENBCION=ION

           SET ENBCIOST=IOST

           SET ENBCIOST(0)=IOST(0)

           SET ENBCIOS=IOS

           if $DATA(IO("S"))

               SET ENBCIO("S")=IO("S")

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

               KILL IO("Q")

               SET ZTIO=ION

               SET ZTRTN="WING2^ENLBL4"

               SET ZTSAVE("EN*")=""

               SET ZTDESC="Location Barcode Labels (WING)"

               DO ^%ZTLOAD

               KILL ZTSK

               DO HOME^%ZIS

               GOTO EXIT1^ENLBL8

WING2     ;HD308658

           KILL ^TMP($JOB)

           SET ENBCIO=IO

           USE ENBCIO

           DO FORMAT

 +1        FOR DA=0:0

               SET DA=$ORDER(^ENG("SP","C",ENEQC,DA))

               if DA=""

                   QUIT

               SET ENEQB=$PIECE(^ENG("SP",DA,0),U,1)

               IF ENEQB]""

                   DO SORT

                   if '(DA#20)

                       DO DOTS^ENLBL3

 +2        IF $DATA(^TMP($JOB))

               SET J=0

FOR

                   SET J=$ORDER(^TMP($JOB,J))

                   if J=""

                       QUIT

                   SET DA=$ORDER(^TMP($JOB,J,0))

                   IF DA>0

                       SET ENEQB=^(DA)

                       USE ENBCIO

                       DO LOCPRT

                       IF ENEQB'["E"

                           if '(+ENEQB#10)

                               DO DOTS^ENLBL3

 +3        QUIT

 +4       ;

BLDG      ;Print labels for all rooms in specified building

 +1        SET ENERR=0

           DO STA^ENLBL3

           if ENEQSTA="^"

               GOTO QUIT^ENLBL3

 +2        NEW DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1

 +3        SET DIC="^ENG(6928.3,"

           SET DIC(0)="AEQM"

           DO ^DIC

           if Y'>0

               GOTO EXIT1^ENLBL8

           SET X=$PIECE(^ENG(6928.3,+Y,0),U)

           SET ENBLDG=$PIECE(X,"-",1)

           SET ENDIV=$PIECE(X,"-",2)

 +4        SET %ZIS("A")="Select BARCODE PRINTER: "

           SET %ZIS="Q"

           SET %ZIS("B")=""

           KILL IO("Q")

           DO ^%ZIS

           KILL %ZIS("A"),%ZIS("B")

           if POP

               GOTO EXIT1^ENLBL8

 +5        SET ENBCIO=IO

           SET ENBCIOSL=IOSL

           SET ENBCIOF=IOF

           SET ENBCION=ION

           SET ENBCIOST=IOST

           SET ENBCIOST(0)=IOST(0)

           SET ENBCIOS=IOS

           if $DATA(IO("S"))

               SET ENBCIO("S")=IO("S")

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

               KILL IO("Q")

               SET ZTIO=ION

               SET ZTRTN="BLDG1^ENLBL4"

               SET ZTSAVE("EN*")=""

               SET ZTDESC="Location Barcode Labels (BUILDING)"

               DO ^%ZTLOAD

               KILL ZTSK

               DO HOME^%ZIS

               GOTO EXIT1^ENLBL8

BLDG1     ;HD308658

           KILL ^TMP($JOB)

           SET ENBCIO=IO

 +1        FOR DA=0:0

               SET DA=$ORDER(^ENG("SP","E",ENBLDG,DA))

               if DA'>0

                   QUIT

               DO CKDIV

               if '(+DA#20)

                   DO DOTS^ENLBL3

 +2        IF $DATA(^TMP($JOB))

               Begin DoDot:1

 +3                USE ENBCIO

                   DO FORMAT

 +4                SET J=0

FOR

                       SET J=$ORDER(^TMP($JOB,J))

                       if J=""

                           QUIT

                       SET DA=$ORDER(^TMP($JOB,J,0))

                       IF DA>0

                           SET ENEQB=^(DA)

                           USE ENBCIO

                           DO LOCPRT

                           if '(DA#10)

                               DO DOTS^ENLBL3

               End DoDot:1

 +5        GOTO EXIT1^ENLBL8

CKDIV      if '$DATA(^ENG("SP",DA,0))

               QUIT

           SET ENEQB=$PIECE(^(0),U,1)

           IF $DATA(ENDIV)

               IF $PIECE(ENEQB,"-",3)'=ENDIV

                   QUIT

 +1        DO SORT

 +2        QUIT

 +3       ;

RM        ;Print a single room label

 +1        SET ENERR=0

           DO STA^ENLBL3

           if ENEQSTA="^"

               GOTO QUIT^ENLBL3

 +2        NEW DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1

RM0        SET DIC="^ENG(""SP"","

           SET DIC(0)="AEQMZ"

           DO ^DIC

           if Y'>0

               GOTO EXIT1^ENLBL8

           SET ENEQB=Y(0,0)

           SET DA=+Y

 +1        KILL IO("Q")

           SET %ZIS("A")="Select BARCODE PRINTER: "

           SET %ZIS="Q"

           SET %ZIS("B")=""

           DO ^%ZIS

           KILL %ZIS("A"),%ZIS("B")

           if POP

               GOTO EXIT1^ENLBL8

 +2        SET ENBCIO=IO

           SET ENBCIOSL=IOSL

           SET ENBCIOF=IOF

           SET ENBCION=ION

           SET ENBCIOST=IOST

           SET ENBCIOST(0)=IOST(0)

           SET ENBCIOS=IOS

           if $DATA(IO("S"))

               SET ENBCIO("S")=IO("S")

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

               KILL IO("Q")

               SET ZTIO=ION

               SET ZTRTN="RM1^ENLBL4"

               SET ZTSAVE("EN*")=""

               SET ZTSAVE("DA")=""

               SET ZTDESC="Location Barcode Label (ROOM)"

               DO ^%ZTLOAD

               KILL ZTSK

               DO ^%ZISC

               GOTO RM0

RM1       ;HD308658

           SET ENBCIO=IO

           USE ENBCIO

           DO FORMAT

 +1        DO LOCPRT

 +2        if $DATA(ZTQUEUED)

               GOTO EXIT1^ENLBL8

 +3        DO ^%ZISC

           GOTO RM0

 +4       ;

ALL       ;Print a location label for every record in the SPACE file

 +1        SET ENERR=0

           DO STA^ENLBL3

           if ENEQSTA="^"

               GOTO QUIT^ENLBL3

 +2        NEW DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1

 +3        KILL IO("Q")

           SET %ZIS="Q"

           SET %ZIS("A")="Select BARCODE PRINTER: "

           SET %ZIS("B")=""

           DO ^%ZIS

           KILL %ZIS("A")

           if POP

               GOTO EXIT1^ENLBL8

 +4        SET ENBCIO=IO

           SET ENBCIOSL=IOSL

           SET ENBCIOF=IOF

           SET ENBCION=ION

           SET ENBCIOST=IOST

           SET ENBCIOST(0)=IOST(0)

           SET ENBCIOS=IOS

           if $DATA(IO("S"))

               SET ENBCIO("S")=IO("S")

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

               KILL IO("Q")

               SET ZTIO=ION

               SET ZTRTN="ALL1^ENLBL4"

               SET ZTSAVE("EN*")=""

               SET ZTDESC="Location Barcode Labels (ALL)"

               DO ^%ZTLOAD

               KILL ZTSK

               DO HOME^%ZIS

               GOTO EXIT1^ENLBL8

ALL1      ;HD308658

           KILL ^TMP($JOB)

           SET ENBCIO=IO

           USE ENBCIO

           DO FORMAT

 +1        FOR DA=0:0

               SET DA=$ORDER(^ENG("SP",DA))

               if DA'>0

                   QUIT

               IF $DATA(^(DA,0))

                   SET ENEQB=$PIECE(^(0),U)

                   IF ENEQB]""

                       DO SORT

                       if '(DA#20)

                           DO DOTS^ENLBL3

 +2        IF $DATA(^TMP($JOB))

               SET J=0

FOR

                   SET J=$ORDER(^TMP($JOB,J))

                   if J=""

                       QUIT

                   SET DA=$ORDER(^TMP($JOB,J,0))

                   IF DA>0

                       SET ENEQB=^(DA)

                       USE ENBCIO

                       DO LOCPRT

                       if '(DA#10)

                           DO DOTS^ENLBL3

 +3        GOTO EXIT1^ENLBL8

 +4       ;

SORT       IF $DATA(ENEQC("FR"))

               IF ENEQC("FR")]ENEQB!(ENEQB]ENEQC("TO"))

                   QUIT

 +1        IF $DATA(^ENG("SP",DA,9))

               SET X=$PIECE(^(9),U)

               SET ^TMP($JOB,X,DA)=ENEQB

               QUIT

 +2        FOR I=1:1:3

               SET X(I)=$PIECE(ENEQB,"-",I)

 +3        SET X=X(3)_":"_X(2)_":"_X(1)

           SET ^TMP($JOB,X,DA)=ENEQB

 +4        QUIT

 +5       ;

LOCPRT    ;Actual print

 +1        IF ENEQB["e"

               SET ENEQB=$TRANSLATE(ENEQB,"e","E")

 +2        IF ENEQB'?.NUP

               DO WARN^ENLBL8

               QUIT

 +3        SET ENEQBC="SP"_ENEQB

 +4        IF ENBAR("LOCATION DATA")]""

               XECUTE ENBAR("LOCATION DATA")

               QUIT

 +5        WRITE *2,*27,"E3",!,*24

 +6        NEW ENX

           SET ENX="*  LOCATION   LABEL  *"

           IF $DATA(^DIC(6910,1,0))

               IF $PIECE(^(0),U,9)=1

                   IF $DATA(^ENG("SP",DA,4))

                       SET X=$PIECE(^(4),U)

                       IF X]""

                           IF $DATA(^ENG(6928.1,X,0))

                               SET X1=$PIECE(^(0),U)

                               SET ENX=$EXTRACT(X1,1,20)

 +7        WRITE ENX,!,ENEQBC,!,ENEQSTAN

 +8        WRITE *23,*3

 +9        QUIT

 +10      ;

FORMAT    ;Location labels

 +1        KILL ENBAR

           SET (ENBAR("LOCATION FORMAT"),ENBAR("LOCATION DATA"))=""

 +2        SET ENBCIOS(0)=$ORDER(^DIC(6910.1,"B",ENBCIOS,0))

           if ENBCIOS(0)

               Begin DoDot:1

 +3                SET ENBAR("LOCATION FORMAT")=$GET(^DIC(6910.1,ENBCIOS(0),2))

 +4                SET ENBAR("LOCATION DATA")=$GET(^DIC(6910.1,ENBCIOS(0),4))

               End DoDot:1

 +5        IF ENBAR("LOCATION FORMAT")]""

               XECUTE ENBAR("LOCATION FORMAT")

               QUIT

 +6        DO FORMAT1^ENLBL7

 +7        QUIT

 +8       ;ENLBL4

ENLBL4.m