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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;ENLBL4
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL4 5212 printed Apr 09, 2024@20:58:16 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
