ENLBL3 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
;
SD ;Single device
S ENERR=0 D STA G:ENEQSTA="^" QUIT
N DIC,DIE,DR,DA,FR,TO,X,X1,X2,I,J,K,I1
N TAG D EN1^ENLBL9 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
SD1 D GETEQ^ENUTL
I Y'>0 S TAG=$S('$D(ENEQIO):"EXIT1",$D(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8" G @TAG
S DA=+Y
S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")=$S($D(ENBCIO):ENBCION,1:""),%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""
K IO("Q") D ^%ZIS K %ZIS I POP S TAG=$S('$D(ENEQIO):"EXIT1",$D(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8" G @TAG
I $D(ENBCIO),ENBCIO'=IO D
. N IO,IOSL,IOF,ION,IOST S IO=ENBCIO D ^%ZISC Q
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")) D G SD1
. S:$D(ENEQIO) ENEQY(0)=ENEQY,ENEQPG(0)=ENEQPG,(ENEQY,ENEQPG)=0
. S ZTIO=ION,ZTRTN="SD2^ENLBL3",ZTSAVE("DA")="",ZTSAVE("EN*")="",ZTDESC="Single Equipment Bar Code Label" D ^%ZTLOAD K ZTSK,IO("Q") D ^%ZISC
. S:$D(ENEQIO) ENEQY=ENEQY(0),ENEQPG=ENEQPG(0)
;HD308658
SD2 S ENEQBY="Single Label(s)",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
U ENBCIO D FORMAT^ENLBL7
D NXPRT^ENLBL7,BCDT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9
G:$D(ZTQUEUED) EXIT^ENLBL8
D HOME^%ZIS U IO G SD1
;
CAT ;Complete Equip Category
S ENERR=0 D STA G:ENEQSTA="^" QUIT
N DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1
D EN^ENLBL9 G:$D(DIRUT) EXIT1^ENLBL8
I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
K ENEQDA
CAT1 S DIC="^ENG(6911,",DIC(0)="AEMQ" D ^DIC
I Y'>0 G EXIT1^ENLBL8
S ENEQDA=+Y
S ENLOCSRT=1
CAT11 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 I %=0 W !,"Say YES to sort labels by BUILDING, then by ROOM within BUILDING.",!,"If you say NO, labels will be sorted by EQUIPMENT ID#." G CAT11
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="CAT2^ENLBL3",ZTSAVE("EN*")="",ZTDESC="Barcode Labels by CATEGORY" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^ENLBL8
;HD308658
CAT2 G:'$D(^ENG(6911,ENEQDA,0)) EXIT1^ENLBL8 S ENEQBY="Equip Cat: "_$P(^ENG(6911,ENEQDA,0),U,1),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 I1=0 F J1=0:0 S I1=$O(^ENG(6914,"G",ENEQDA,I1)) Q:I1'>0 S DA=I1 D STATCK I DA]"" D SORT D:'(DA#10) DOTS
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 D BCDT^ENLBL7
G EXIT^ENLBL8
;
SORT I 'ENLOCSRT S ^TMP($J,DA,DA)="" Q
S X=$S($D(^ENG(6914,DA,3)):$P(^(3),U,5),1:0) S:X="" X=0
G:X=0 SORT1
I X=+X,$D(^ENG("SP",X,0)) D G SORT1
. I $D(^ENG("SP",X,9)) S X(0)=$P(^(9),U) I X(0)]"" S X=X(0) Q
. S X=$P(^ENG("SP",X,0),U) F I=1,2,3 S X(I)=$P(X,"-",I)
. S X=X(3)_":"_X(2)_":"_X(1)
F I=1,2,3 S X(I)=$P(X,"-",I)
S X=X(3)_":"_X(2)_":"_X(1)
SORT1 S ^TMP($J,X,DA)=""
Q
;
STATCK S:'$D(^ENG(6914,DA,0)) DA="" I DA]"" S ENA=$G(^(3)) D:ENA]"" Q
. I $P(ENA,U)>3,$P(ENA,U)<6 S DA="" Q
. I $G(ENEQREP),$P(ENA,U,10)]"" S DA=""
;
STA I $D(^DIC(6910,1,0)),$P(^(0),U,2)]"" S ENEQSTA=$P(^(0),U,2)
E S ENEQSTA="^"
I ENEQSTA'="^" S ENEQSTAN="DVAMC "_$P(^DIC(6910,1,0),U),ENEQLM=(135+(4*$L(ENEQSTAN)))
Q
;
DOTS ;Act indic
Q:$D(ZTQUEUED)
I '$D(ENEQIO) U IO(0) W "." Q
I ENEQIO'=IO(0) U IO(0) W "."
Q
;
HOLD W !,"Press <RETURN> to continue..." R X:DTIME
Q
;
QUIT I $D(ENEQSTA),ENEQSTA="^" W !!,"Can't seem to find your Station Number. Please check File 6910 (ENG INIT",!,"PARAMETERS).",*7
G EXIT1^ENLBL8
;ENLBL3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL3 4041 printed Oct 16, 2024@17:55:06 Page 2
ENLBL3 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
+1 ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25
+2 ;
SD ;Single device
+1 SET ENERR=0
DO STA
if ENEQSTA="^"
GOTO QUIT
+2 NEW DIC,DIE,DR,DA,FR,TO,X,X1,X2,I,J,K,I1
+3 NEW TAG
DO EN1^ENLBL9
IF '$DATA(ENEQIO)
IF %<0
GOTO EXIT1^ENLBL8
SD1 DO GETEQ^ENUTL
+1 IF Y'>0
SET TAG=$SELECT('$DATA(ENEQIO):"EXIT1",$DATA(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8"
GOTO @TAG
+2 SET DA=+Y
+3 SET %ZIS("A")="Select BAR CODE PRINTER: "
SET %ZIS("B")=$SELECT($DATA(ENBCIO):ENBCION,1:"")
SET %ZIS="Q"
IF $DATA(ENEQIO)
IF ENEQIO=IO
SET %ZIS=""
+4 KILL IO("Q")
DO ^%ZIS
KILL %ZIS
IF POP
SET TAG=$SELECT('$DATA(ENEQIO):"EXIT1",$DATA(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8"
GOTO @TAG
+5 IF $DATA(ENBCIO)
IF ENBCIO'=IO
Begin DoDot:1
+6 NEW IO,IOSL,IOF,ION,IOST
SET IO=ENBCIO
DO ^%ZISC
QUIT
End DoDot:1
+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"))
Begin DoDot:1
+9 if $DATA(ENEQIO)
SET ENEQY(0)=ENEQY
SET ENEQPG(0)=ENEQPG
SET (ENEQY,ENEQPG)=0
+10 SET ZTIO=ION
SET ZTRTN="SD2^ENLBL3"
SET ZTSAVE("DA")=""
SET ZTSAVE("EN*")=""
SET ZTDESC="Single Equipment Bar Code Label"
DO ^%ZTLOAD
KILL ZTSK,IO("Q")
DO ^%ZISC
+11 if $DATA(ENEQIO)
SET ENEQY=ENEQY(0)
SET ENEQPG=ENEQPG(0)
End DoDot:1
GOTO SD1
+12 ;HD308658
SD2 SET ENEQBY="Single Label(s)"
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
+3 DO NXPRT^ENLBL7
DO BCDT^ENLBL7
if $DATA(ENEQIO)
DO CPRNT^ENLBL9
+4 if $DATA(ZTQUEUED)
GOTO EXIT^ENLBL8
+5 DO HOME^%ZIS
USE IO
GOTO SD1
+6 ;
CAT ;Complete Equip Category
+1 SET ENERR=0
DO STA
if ENEQSTA="^"
GOTO QUIT
+2 NEW DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1
+3 DO EN^ENLBL9
if $DATA(DIRUT)
GOTO EXIT1^ENLBL8
+4 IF '$DATA(ENEQIO)
IF %<0
GOTO EXIT1^ENLBL8
+5 KILL ENEQDA
CAT1 SET DIC="^ENG(6911,"
SET DIC(0)="AEMQ"
DO ^DIC
+1 IF Y'>0
GOTO EXIT1^ENLBL8
+2 SET ENEQDA=+Y
+3 SET ENLOCSRT=1
CAT11 WRITE !,"Sort labels by LOCATION"
SET %=1
DO YN^DICN
if %<0
GOTO EXIT1^ENLBL8
IF %=0
WRITE !,"Say YES to sort labels by BUILDING, then by ROOM within BUILDING.",!,"If you say NO, labels will be sorted by EQUIPMENT ID#."
GOTO CAT11
+1 if %=2
SET ENLOCSRT=0
+2 SET %ZIS("A")="Select BARCODE PRINTER: "
SET %ZIS("B")=""
SET %ZIS="Q"
IF $DATA(ENEQIO)
IF ENEQIO=IO
SET %ZIS=""
+3 KILL IO("Q")
DO ^%ZIS
KILL %ZIS
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"))
SET ZTIO=ION
SET ZTRTN="CAT2^ENLBL3"
SET ZTSAVE("EN*")=""
SET ZTDESC="Barcode Labels by CATEGORY"
DO ^%ZTLOAD
KILL ZTSK,IO("Q")
GOTO EXIT1^ENLBL8
+6 ;HD308658
CAT2 if '$DATA(^ENG(6911,ENEQDA,0))
GOTO EXIT1^ENLBL8
SET ENEQBY="Equip Cat: "_$PIECE(^ENG(6911,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)
SET I1=0
FOR J1=0:0
SET I1=$ORDER(^ENG(6914,"G",ENEQDA,I1))
if I1'>0
QUIT
SET DA=I1
DO STATCK
IF DA]""
DO SORT
if '(DA#10)
DO DOTS
+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
DO BCDT^ENLBL7
+4 GOTO EXIT^ENLBL8
+5 ;
SORT IF 'ENLOCSRT
SET ^TMP($JOB,DA,DA)=""
QUIT
+1 SET X=$SELECT($DATA(^ENG(6914,DA,3)):$PIECE(^(3),U,5),1:0)
if X=""
SET X=0
+2 if X=0
GOTO SORT1
+3 IF X=+X
IF $DATA(^ENG("SP",X,0))
Begin DoDot:1
+4 IF $DATA(^ENG("SP",X,9))
SET X(0)=$PIECE(^(9),U)
IF X(0)]""
SET X=X(0)
QUIT
+5 SET X=$PIECE(^ENG("SP",X,0),U)
FOR I=1,2,3
SET X(I)=$PIECE(X,"-",I)
+6 SET X=X(3)_":"_X(2)_":"_X(1)
End DoDot:1
GOTO SORT1
+7 FOR I=1,2,3
SET X(I)=$PIECE(X,"-",I)
+8 SET X=X(3)_":"_X(2)_":"_X(1)
SORT1 SET ^TMP($JOB,X,DA)=""
+1 QUIT
+2 ;
STATCK if '$DATA(^ENG(6914,DA,0))
SET DA=""
IF DA]""
SET ENA=$GET(^(3))
if ENA]""
Begin DoDot:1
+1 IF $PIECE(ENA,U)>3
IF $PIECE(ENA,U)<6
SET DA=""
QUIT
+2 IF $GET(ENEQREP)
IF $PIECE(ENA,U,10)]""
SET DA=""
End DoDot:1
QUIT
+3 ;
STA IF $DATA(^DIC(6910,1,0))
IF $PIECE(^(0),U,2)]""
SET ENEQSTA=$PIECE(^(0),U,2)
+1 IF '$TEST
SET ENEQSTA="^"
+2 IF ENEQSTA'="^"
SET ENEQSTAN="DVAMC "_$PIECE(^DIC(6910,1,0),U)
SET ENEQLM=(135+(4*$LENGTH(ENEQSTAN)))
+3 QUIT
+4 ;
DOTS ;Act indic
+1 if $DATA(ZTQUEUED)
QUIT
+2 IF '$DATA(ENEQIO)
USE IO(0)
WRITE "."
QUIT
+3 IF ENEQIO'=IO(0)
USE IO(0)
WRITE "."
+4 QUIT
+5 ;
HOLD WRITE !,"Press <RETURN> to continue..."
READ X:DTIME
+1 QUIT
+2 ;
QUIT IF $DATA(ENEQSTA)
IF ENEQSTA="^"
WRITE !!,"Can't seem to find your Station Number. Please check File 6910 (ENG INIT",!,"PARAMETERS).",*7
+1 GOTO EXIT1^ENLBL8
+2 ;ENLBL3
