ENLBL5.m

ENLBL5 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97

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

CMR ;Complete CMR

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

 D EN^ENLBL9 G:$D(DIRUT) EXIT1^ENLBL8

 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8

 S ENLOCSRT=1

CMR1 S DIC="^ENG(6914.1,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQDA=+Y

CMR11 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8

 I %=0 W !,"Say YES to sort labels by DIVISION, BUILDING, and then by ROOM.",!,"If you say NO, labels will be sorted by Category Stock Number." G CMR11

 S:%=2 ENLOCSRT=0

 S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""

 K IO("Q") D ^%ZIS K %ZIS 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")) S ZTIO=ION,ZTRTN="CMR2^ENLBL5",ZTSAVE("EN*")="",ZTDESC="Barcode Labels by CMR" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^ENLBL8

CMR2 S ENEQBY="CMR "_$P(^ENG(6914.1,ENEQDA,0),U,1),ENBCIO=IO  ;HD308658

 I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8

 K ^TMP($J) F I1=0:0 S I1=$O(^ENG(6914,"AD",ENEQDA,I1)) Q:I1'>0  S DA=I1 D STATCK^ENLBL3 I DA]"" D CMRSRT D:'(DA#10) DOTS^ENLBL3

 I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F J1=0:0 S I1=$O(^TMP($J,I1)) Q:I1=""  F DA=0:0 S DA=$O(^TMP($J,I1,DA)) Q:DA'>0  U ENBCIO D NXPRT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9 D:'(DA#10) DOTS^ENLBL3 D BCDT^ENLBL7

 G EXIT^ENLBL8

 ;

CMRSRT I ENLOCSRT=1 D SORT^ENLBL3 Q

 S X=$$GET1^DIQ(6914,DA,18) S:X="" X=0

 S ^TMP($J,X,DA)=""

 Q

 ;

ALL ;By Equipment ID

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

 D EN^ENLBL9 G:$D(DIRUT) EXIT1^ENLBL8

 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8

ALL1 K ENFR,ENTO W !!,"Would you like to specify a range of entries" S %=1 D YN^DICN G:%=2 ALL2 G:%<0 EXIT1^ENLBL8 I %<1 W *7 G ALL1

 S DIC="^ENG(6914,",DIC(0)="AEQN",D="B",DIC("A")="Starting with: " D IX^DIC G:Y'>0 EXIT1^ENLBL8 S ENFR=+Y

 S D="B",DIC("A")="And ending with: ",DIC("S")="I +Y>ENFR" D IX^DIC K DIC("S") G:Y'>0 EXIT1^ENLBL8 S ENTO=+Y

ALL2 I '$D(ENFR) W !,"You have chosen to print labels for the ENTIRE Equipment File.",!,"(All "_$P(^ENG(6914,0),U,3)_" entries.)"

 S ENLOCSRT=1

ALL21 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8

 I %=0 W !,"Say YES to sort labels by DIVISION, BUILDING, then by ROOM.",!,"If you say NO, labels will be sorted by EQUIPMENT ID#." G ALL21

 S:%=2 ENLOCSRT=0

 S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""

 K IO("Q") D ^%ZIS K %ZIS 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="ALL3^ENLBL5",ZTSAVE("EN*")="",ZTDESC="All Equipment Labels (Bar Code)" D ^%ZTLOAD K ZTSK G EXIT1^ENLBL8

 ;HD308658

ALL3 S ENEQBY=$S($D(ENFR):"Equipment ID#: "_ENFR_" to "_ENTO,1:"ENTIRE EQUIPMENT FILE"),ENBCIO=IO

 I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8

 K ^TMP($J) S ENDA=$S($D(ENFR):ENFR,1:$O(^ENG(6914,0)))

ALL4 S DA=ENDA D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3

 S ENDA=$O(^ENG(6914,ENDA)) I $D(ENTO),ENDA=+ENDA,ENDA'>ENTO G ALL4

 I ENDA=+ENDA,'$D(ENTO) G ALL4

 I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F J1=0:0 S I1=$O(^TMP($J,I1)) Q:I1=""  F DA=0:0 S DA=$O(^TMP($J,I1,DA)) Q:DA'>0  U ENBCIO D NXPRT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9 D:'(DA#10) DOTS^ENLBL3 D BCDT^ENLBL7

 G EXIT^ENLBL8

 ;

HOLD W !,"Press <RETURN> to continue..." R X:DTIME

 Q

 ;ENLBL5

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ENLBL5   3762     printed  Feb 18, 2025@23:20:44                                                                                                                                                                                                      Page 2

ENLBL5    ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97

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

CMR       ;Complete CMR

 +1        SET ENERR=0

           DO STA^ENLBL3

           if ENEQSTA="^"

               GOTO QUIT^ENLBL3

 +2        DO EN^ENLBL9

           if $DATA(DIRUT)

               GOTO EXIT1^ENLBL8

 +3        IF '$DATA(ENEQIO)

               IF %<0

                   GOTO EXIT1^ENLBL8

 +4        SET ENLOCSRT=1

CMR1       SET DIC="^ENG(6914.1,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           if Y'>0

               GOTO EXIT1^ENLBL8

           SET ENEQDA=+Y

CMR11      WRITE !,"Sort labels by LOCATION"

           SET %=1

           DO YN^DICN

           if %<0

               GOTO EXIT1^ENLBL8

 +1        IF %=0

               WRITE !,"Say YES to sort labels by DIVISION, BUILDING, and then by ROOM.",!,"If you say NO, labels will be sorted by Category Stock Number."

               GOTO CMR11

 +2        if %=2

               SET ENLOCSRT=0

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

           SET %ZIS("B")=""

           SET %ZIS="Q"

           IF $DATA(ENEQIO)

               IF ENEQIO=IO

                   SET %ZIS=""

 +4        KILL IO("Q")

           DO ^%ZIS

           KILL %ZIS

           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"))

               SET ZTIO=ION

               SET ZTRTN="CMR2^ENLBL5"

               SET ZTSAVE("EN*")=""

               SET ZTDESC="Barcode Labels by CMR"

               DO ^%ZTLOAD

               KILL ZTSK,IO("Q")

               GOTO EXIT1^ENLBL8

CMR2      ;HD308658

           SET ENEQBY="CMR "_$PIECE(^ENG(6914.1,ENEQDA,0),U,1)

           SET ENBCIO=IO

 +1        IF $DATA(ENEQIO)

               DO OPEN^ENLBL9

               IF POP

                   if $DATA(ZTQUEUED)

                       GOTO REQ^ENLBL8

                   WRITE !,*7,"Companion Printer UNAVAILABLE."

                   DO HOLD

                   GOTO EXIT1^ENLBL8

 +2        KILL ^TMP($JOB)

           FOR I1=0:0

               SET I1=$ORDER(^ENG(6914,"AD",ENEQDA,I1))

               if I1'>0

                   QUIT 

               SET DA=I1

               DO STATCK^ENLBL3

               IF DA]""

                   DO CMRSRT

                   if '(DA#10)

                       DO DOTS^ENLBL3

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

               USE ENBCIO

               DO FORMAT^ENLBL7

               SET I1=""

               FOR J1=0:0

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

                   if I1=""

                       QUIT 

                   FOR DA=0:0

                       SET DA=$ORDER(^TMP($JOB,I1,DA))

                       if DA'>0

                           QUIT 

                       USE ENBCIO

                       DO NXPRT^ENLBL7

                       if $DATA(ENEQIO)

                           DO CPRNT^ENLBL9

                       if '(DA#10)

                           DO DOTS^ENLBL3

                       DO BCDT^ENLBL7

 +4        GOTO EXIT^ENLBL8

 +5       ;

CMRSRT     IF ENLOCSRT=1

               DO SORT^ENLBL3

               QUIT 

 +1        SET X=$$GET1^DIQ(6914,DA,18)

           if X=""

               SET X=0

 +2        SET ^TMP($JOB,X,DA)=""

 +3        QUIT 

 +4       ;

ALL       ;By Equipment ID

 +1        SET ENERR=0

           DO STA^ENLBL3

           if ENEQSTA="^"

               GOTO QUIT^ENLBL3

 +2        DO EN^ENLBL9

           if $DATA(DIRUT)

               GOTO EXIT1^ENLBL8

 +3        IF '$DATA(ENEQIO)

               IF %<0

                   GOTO EXIT1^ENLBL8

ALL1       KILL ENFR,ENTO

           WRITE !!,"Would you like to specify a range of entries"

           SET %=1

           DO YN^DICN

           if %=2

               GOTO ALL2

           if %<0

               GOTO EXIT1^ENLBL8

           IF %<1

               WRITE *7

               GOTO ALL1

 +1        SET DIC="^ENG(6914,"

           SET DIC(0)="AEQN"

           SET D="B"

           SET DIC("A")="Starting with: "

           DO IX^DIC

           if Y'>0

               GOTO EXIT1^ENLBL8

           SET ENFR=+Y

 +2        SET D="B"

           SET DIC("A")="And ending with: "

           SET DIC("S")="I +Y>ENFR"

           DO IX^DIC

           KILL DIC("S")

           if Y'>0

               GOTO EXIT1^ENLBL8

           SET ENTO=+Y

ALL2       IF '$DATA(ENFR)

               WRITE !,"You have chosen to print labels for the ENTIRE Equipment File.",!,"(All "_$PIECE(^ENG(6914,0),U,3)_" entries.)"

 +1        SET ENLOCSRT=1

ALL21      WRITE !,"Sort labels by LOCATION"

           SET %=1

           DO YN^DICN

           if %<0

               GOTO EXIT1^ENLBL8

 +1        IF %=0

               WRITE !,"Say YES to sort labels by DIVISION, BUILDING, then by ROOM.",!,"If you say NO, labels will be sorted by EQUIPMENT ID#."

               GOTO ALL21

 +2        if %=2

               SET ENLOCSRT=0

 +3        SET %ZIS("A")="Select BAR CODE PRINTER: "

           SET %ZIS("B")=""

           SET %ZIS="Q"

           IF $DATA(ENEQIO)

               IF ENEQIO=IO

                   SET %ZIS=""

 +4        KILL IO("Q")

           DO ^%ZIS

           KILL %ZIS

           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="ALL3^ENLBL5"

               SET ZTSAVE("EN*")=""

               SET ZTDESC="All Equipment Labels (Bar Code)"

               DO ^%ZTLOAD

               KILL ZTSK

               GOTO EXIT1^ENLBL8

 +7       ;HD308658

ALL3       SET ENEQBY=$SELECT($DATA(ENFR):"Equipment ID#: "_ENFR_" to "_ENTO,1:"ENTIRE EQUIPMENT FILE")

           SET ENBCIO=IO

 +1        IF $DATA(ENEQIO)

               DO OPEN^ENLBL9

               IF POP

                   if $DATA(ZTQUEUED)

                       GOTO REQ^ENLBL8

                   WRITE !,*7,"Companion Printer UNAVAILABLE."

                   DO HOLD

                   GOTO EXIT1^ENLBL8

 +2        KILL ^TMP($JOB)

           SET ENDA=$SELECT($DATA(ENFR):ENFR,1:$ORDER(^ENG(6914,0)))

ALL4       SET DA=ENDA

           DO STATCK^ENLBL3

           IF DA]""

               DO SORT^ENLBL3

               if '(DA#10)

                   DO DOTS^ENLBL3

 +1        SET ENDA=$ORDER(^ENG(6914,ENDA))

           IF $DATA(ENTO)

               IF ENDA=+ENDA

                   IF ENDA'>ENTO

                       GOTO ALL4

 +2        IF ENDA=+ENDA

               IF '$DATA(ENTO)

                   GOTO ALL4

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

               USE ENBCIO

               DO FORMAT^ENLBL7

               SET I1=""

               FOR J1=0:0

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

                   if I1=""

                       QUIT 

                   FOR DA=0:0

                       SET DA=$ORDER(^TMP($JOB,I1,DA))

                       if DA'>0

                           QUIT 

                       USE ENBCIO

                       DO NXPRT^ENLBL7

                       if $DATA(ENEQIO)

                           DO CPRNT^ENLBL9

                       if '(DA#10)

                           DO DOTS^ENLBL3

                       DO BCDT^ENLBL7

 +4        GOTO EXIT^ENLBL8

 +5       ;

HOLD       WRITE !,"Press <RETURN> to continue..."

           READ X:DTIME

 +1        QUIT 

 +2       ;ENLBL5