ENLBL6 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
WING ;General location (Space File WING)
S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
WING1 S X="" R !,"Enter WING: ",X:DTIME G:X=""!(X="^") EXIT1^ENLBL8 I $E(X)="?" D HWING G WING1
I $D(^ENG("SP","C",X)) G WB
S X1=$O(^ENG("SP","C",X)),X2=$L(X) I $E(X1,1,X2)'=X S X=""
I X]"" D
. I $E($O(^ENG("SP","C",X1)),1,X2)'=X S X=X1 Q
. S DIC="^ENG(""SP"",",ENDX="C" D IX^ENLIB1
I X="" W !!,*7,"Sorry, no such WING. Please try again or enter '^' to exit.",! G WING1
WB ; More than 1 BUILDING?
S ENWNG=X K X S X=0 F S X=$O(^ENG("SP","C",ENWNG,X)) Q:X'>0 S X($P($G(^ENG("SP",X,0)),U,2))=""
WB1 S X=$O(X(0)) I $O(X(X))="" S ENBLDG="ALL"
E D G:X="^" EXIT1^ENLBL8 I ENBLDG'="ALL",'$D(X(ENBLDG)) G WB1
. W !,"Please select a BUILDING."
. W !,?5,"Choices are: " S X=0 F S X=$O(X(X)) Q:X']"" W X_", " W:(IOM-$X)'>15 !,?5
. W "or ALL."
. R !,?5,"BUILDING: ALL// ",X:DTIME I '$T!(X="^") S X="^" Q
. I X=""!(X="ALL") S ENBLDG="ALL" Q
. S ENBLDG=X
WING11 S (ENFLG,ENROOM)=0 F S ENROOM=$O(^ENG("SP","C",ENWNG,ENROOM)) Q:ENFLG!(ENROOM="") D
. I ENBLDG="ALL",$D(^ENG(6914,"D",ENROOM)) S ENFLG=1 Q
. I $P($G(^ENG("SP",ENROOM,0)),U,2)=ENBLDG,$D(^ENG(6914,"D",ENROOM)) S ENFLG=1
I 'ENFLG W !!,*7,"There does not appear to be any equipment located on this WING",!,"(",ENWNG,"). Nothing to print.",!! G WING1
D EN^ENLBL9 G:$D(DIRUT) EXIT^ENLBL8
I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
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="WING2^ENLBL6",ZTSAVE("D*")="",ZTSAVE("EN*")="",ZTDESC="Equipment Bar Code Labels by WING" D ^%ZTLOAD K ZTSK G EXIT1^ENLBL8
WING2 S ENEQBY="WING "_ENWNG,ENLOCSRT=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) S ENROOM=0 F S ENROOM=$O(^ENG("SP","C",ENWNG,ENROOM)) Q:ENROOM="" I ENBLDG="ALL"!($$GET1^DIQ(6928,ENROOM,.5)=ENBLDG) D
. S K=0 F S K=$O(^ENG(6914,"D",ENROOM,K)) Q:K'>0 S DA=K D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3
I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1=0 F S I1=$O(^TMP($J,I1)) Q:I1="" D
. S DA=0 F 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
;
HWING S X="" W !,"Enter WING as defined in Space File. Would you like a list" S %=2 D YN^DICN Q:%'=1
S (I,ENY)=0 F K=0:0 S I=$O(^ENG("SP","C",I)) Q:I="" D:ENY>(IOSL-6) HWING2 Q:I="^" W !,?5,I S ENY=ENY+1
S X="" Q
HWING2 S ENY=0 W !,"Press <RETURN> to continue or ""^"" to escape..." R X:DTIME S:X="^" I="^"
Q
RM ;Single room (from Space File)
S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
RM1 S DIC="^ENG(""SP"",",DIC(0)="AEQM" D ^DIC
I Y'>0 G EXIT1^ENLBL8
S ENROOM=+Y,ENROOM("TXT")=$P(^ENG("SP",ENROOM,0),U)
I '$D(^ENG(6914,"D",ENROOM)) W !!,*7,"There does not appear to be any equipment in ",ENROOM("TXT"),".",!! K ENROOM G RM1
D EN^ENLBL9 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
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")) S ZTIO=ION,ZTDESC="Bar Code Labels for Room "_ENROOM("TXT"),ZTRTN="RM2^ENLBL6",ZTSAVE("EN*")="",ZTSAVE("D*")="" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^ENLBL8
RM2 S ENEQBY="Room "_ENROOM("TXT"),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
U ENBCIO D FORMAT^ENLBL7 F I1=0:0 S I1=$O(^ENG(6914,"D",ENROOM,I1)) Q:I1'>0 S DA=I1 D STATCK^ENLBL3 I DA]"" 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
;
;ENLBL6
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL6 4263 printed Apr 09, 2024@21:01:39 Page 2
ENLBL6 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
+1 ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
WING ;General location (Space File WING)
+1 SET ENERR=0
DO STA^ENLBL3
if ENEQSTA="^"
GOTO QUIT^ENLBL3
WING1 SET X=""
READ !,"Enter WING: ",X:DTIME
if X=""!(X="^")
GOTO EXIT1^ENLBL8
IF $EXTRACT(X)="?"
DO HWING
GOTO WING1
+1 IF $DATA(^ENG("SP","C",X))
GOTO WB
+2 SET X1=$ORDER(^ENG("SP","C",X))
SET X2=$LENGTH(X)
IF $EXTRACT(X1,1,X2)'=X
SET X=""
+3 IF X]""
Begin DoDot:1
+4 IF $EXTRACT($ORDER(^ENG("SP","C",X1)),1,X2)'=X
SET X=X1
QUIT
+5 SET DIC="^ENG(""SP"","
SET ENDX="C"
DO IX^ENLIB1
End DoDot:1
+6 IF X=""
WRITE !!,*7,"Sorry, no such WING. Please try again or enter '^' to exit.",!
GOTO WING1
WB ; More than 1 BUILDING?
+1 SET ENWNG=X
KILL X
SET X=0
FOR
SET X=$ORDER(^ENG("SP","C",ENWNG,X))
if X'>0
QUIT
SET X($PIECE($GET(^ENG("SP",X,0)),U,2))=""
WB1 SET X=$ORDER(X(0))
IF $ORDER(X(X))=""
SET ENBLDG="ALL"
+1 IF '$TEST
Begin DoDot:1
+2 WRITE !,"Please select a BUILDING."
+3 WRITE !,?5,"Choices are: "
SET X=0
FOR
SET X=$ORDER(X(X))
if X']""
QUIT
WRITE X_", "
if (IOM-$X)'>15
WRITE !,?5
+4 WRITE "or ALL."
+5 READ !,?5,"BUILDING: ALL// ",X:DTIME
IF '$TEST!(X="^")
SET X="^"
QUIT
+6 IF X=""!(X="ALL")
SET ENBLDG="ALL"
QUIT
+7 SET ENBLDG=X
End DoDot:1
if X="^"
GOTO EXIT1^ENLBL8
IF ENBLDG'="ALL"
IF '$DATA(X(ENBLDG))
GOTO WB1
WING11 SET (ENFLG,ENROOM)=0
FOR
SET ENROOM=$ORDER(^ENG("SP","C",ENWNG,ENROOM))
if ENFLG!(ENROOM="")
QUIT
Begin DoDot:1
+1 IF ENBLDG="ALL"
IF $DATA(^ENG(6914,"D",ENROOM))
SET ENFLG=1
QUIT
+2 IF $PIECE($GET(^ENG("SP",ENROOM,0)),U,2)=ENBLDG
IF $DATA(^ENG(6914,"D",ENROOM))
SET ENFLG=1
End DoDot:1
+3 IF 'ENFLG
WRITE !!,*7,"There does not appear to be any equipment located on this WING",!,"(",ENWNG,"). Nothing to print.",!!
GOTO WING1
+4 DO EN^ENLBL9
if $DATA(DIRUT)
GOTO EXIT^ENLBL8
+5 IF '$DATA(ENEQIO)
IF %<0
GOTO EXIT1^ENLBL8
+6 SET %ZIS("A")="Select BAR CODE PRINTER: "
SET %ZIS("B")=""
SET %ZIS="Q"
IF $DATA(ENEQIO)
IF ENEQIO=IO
SET %ZIS=""
+7 KILL IO("Q")
DO ^%ZIS
KILL %ZIS
if POP
GOTO EXIT1^ENLBL8
+8 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")
+9 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTIO=ION
SET ZTRTN="WING2^ENLBL6"
SET ZTSAVE("D*")=""
SET ZTSAVE("EN*")=""
SET ZTDESC="Equipment Bar Code Labels by WING"
DO ^%ZTLOAD
KILL ZTSK
GOTO EXIT1^ENLBL8
WING2 ;HD308658
SET ENEQBY="WING "_ENWNG
SET ENLOCSRT=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)
SET ENROOM=0
FOR
SET ENROOM=$ORDER(^ENG("SP","C",ENWNG,ENROOM))
if ENROOM=""
QUIT
IF ENBLDG="ALL"!($$GET1^DIQ(6928,ENROOM,.5)=ENBLDG)
Begin DoDot:1
+3 SET K=0
FOR
SET K=$ORDER(^ENG(6914,"D",ENROOM,K))
if K'>0
QUIT
SET DA=K
DO STATCK^ENLBL3
IF DA]""
DO SORT^ENLBL3
if '(DA#10)
DO DOTS^ENLBL3
End DoDot:1
+4 IF $DATA(^TMP($JOB))
USE ENBCIO
DO FORMAT^ENLBL7
SET I1=0
FOR
SET I1=$ORDER(^TMP($JOB,I1))
if I1=""
QUIT
Begin DoDot:1
+5 SET DA=0
FOR
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
End DoDot:1
+6 GOTO EXIT^ENLBL8
+7 ;
HWING SET X=""
WRITE !,"Enter WING as defined in Space File. Would you like a list"
SET %=2
DO YN^DICN
if %'=1
QUIT
+1 SET (I,ENY)=0
FOR K=0:0
SET I=$ORDER(^ENG("SP","C",I))
if I=""
QUIT
if ENY>(IOSL-6)
DO HWING2
if I="^"
QUIT
WRITE !,?5,I
SET ENY=ENY+1
+2 SET X=""
QUIT
HWING2 SET ENY=0
WRITE !,"Press <RETURN> to continue or ""^"" to escape..."
READ X:DTIME
if X="^"
SET I="^"
+1 QUIT
RM ;Single room (from Space File)
+1 SET ENERR=0
DO STA^ENLBL3
if ENEQSTA="^"
GOTO QUIT^ENLBL3
RM1 SET DIC="^ENG(""SP"","
SET DIC(0)="AEQM"
DO ^DIC
+1 IF Y'>0
GOTO EXIT1^ENLBL8
+2 SET ENROOM=+Y
SET ENROOM("TXT")=$PIECE(^ENG("SP",ENROOM,0),U)
+3 IF '$DATA(^ENG(6914,"D",ENROOM))
WRITE !!,*7,"There does not appear to be any equipment in ",ENROOM("TXT"),".",!!
KILL ENROOM
GOTO RM1
+4 DO EN^ENLBL9
IF '$DATA(ENEQIO)
IF %<0
GOTO EXIT1^ENLBL8
+5 SET %ZIS("A")="Select BAR CODE PRINTER: "
SET %ZIS("B")=""
SET %ZIS="Q"
IF $DATA(ENEQIO)
IF ENEQIO=IO
SET %ZIS=""
+6 KILL IO("Q")
DO ^%ZIS
KILL %ZIS
if POP
GOTO EXIT1^ENLBL8
+7 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")
+8 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTDESC="Bar Code Labels for Room "_ENROOM("TXT")
SET ZTRTN="RM2^ENLBL6"
SET ZTSAVE("EN*")=""
SET ZTSAVE("D*")=""
DO ^%ZTLOAD
KILL ZTSK,IO("Q")
GOTO EXIT1^ENLBL8
RM2 ;HD308658
SET ENEQBY="Room "_ENROOM("TXT")
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 USE ENBCIO
DO FORMAT^ENLBL7
FOR I1=0:0
SET I1=$ORDER(^ENG(6914,"D",ENROOM,I1))
if I1'>0
QUIT
SET DA=I1
DO STATCK^ENLBL3
IF DA]""
USE ENBCIO
DO NXPRT^ENLBL7
if $DATA(ENEQIO)
DO CPRNT^ENLBL9
if '(DA#10)
DO DOTS^ENLBL3
DO BCDT^ENLBL7
+3 GOTO EXIT^ENLBL8
+4 ;
HOLD WRITE !,"Press <RETURN> to continue..."
READ X:DTIME
+1 QUIT
+2 ;
+3 ;ENLBL6
