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 ---[H[J[2J[HENLBL5 3762 printed Oct 16, 2024@17:55:08 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
