ENLBL12 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
;;7.0;ENGINEERING;**12,16,35,45,90**;Aug 17, 1993;Build 25
PO ;All items on one specific Purchase Order
S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8
I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
S DIC="^ENG(6914,",ENDX="M",ENLOCSRT=1
PO1 S ENPO="" R !,"Purchase Order #: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S:X=" " X="?" G:$E(X)="?" PO15
S X2=$L(X) I $D(^ENG(6914,"M",X)) S ENPO=X G PO2
I $E($O(^ENG(6914,"M",X)),1,X2)=X D IX^ENLIB1 G:X="" PO1 G:X="^" EXIT1^ENLBL8 S ENPO=X W " ",ENPO G PO2
S ENX=X,ENIX=0 I X?.N D IX^ENLIB1 G:X="^" EXIT1^ENLBL8 I $E(X,1,X2)=ENX S ENPO=X W " ",ENPO G PO2
I 'ENIX W !,"There is no PURCHASE ORDER # in the Equipment File that begins with:",!,?5,ENX
K ENIX
PO15 W !,"Would you like a list of all PURCHASE ORDERS" S %=1 D YN^DICN S:%<0 X="^" G:%<0 EXIT1^ENLBL8 G:%'=1 PO1
S X="" D IX^ENLIB1 G:X="" PO1 G:X="^" EXIT1^ENLBL8 S ENPO=X W " ",ENPO
PO2 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 PO2
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="PO3^ENLBL12",ZTSAVE("EN*")="",ZTDESC="Barcode Labels by PO#" D ^%ZTLOAD K IO("Q"),ZTSK G EXIT1^ENLBL8
PO3 S ENEQBY="PO# "_ENPO,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 I1=0 F S I1=$O(^ENG(6914,"M",ENPO,I1)) Q:I1'>0 S DA=I1 D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3
I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F S I1=$O(^TMP($J,I1)) Q:I1="" 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
;
SRVC ;By OWNING SERVICE
S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8
I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
S ENLOCSRT=1
SRVC1 S DIC="^DIC(49,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQDA=+Y
SRVC2 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 SRVC2
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")) S ZTIO=ION,ZTRTN="SRVC3^ENLBL12",ZTDESC="Bar Code Labels by SERVICE",ZTSAVE("EN*")="" D ^%ZTLOAD K IO("Q"),ZTSK G EXIT1^ENLBL8
;HD308658
SRVC3 G:'$D(^DIC(49,ENEQDA)) EXIT1^ENLBL8 S ENEQBY="Owning Service: "_$P(^DIC(49,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) F I1=0:0 S I1=$O(^ENG(6914,"AC",ENEQDA,I1)) Q:I1'>0 S DA=I1 D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3
I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F S I1=$O(^TMP($J,I1)) Q:I1="" 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
;
HOLD W !,"Press <RETURN> to continue..." R X:DTIME
Q
;ENLBL12
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL12 3821 printed Dec 13, 2024@01:54:14 Page 2
ENLBL12 ;(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
PO ;All items on one specific Purchase Order
+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 DO EN^ENLBL9
IF $DATA(DIRUT)
GOTO EXIT1^ENLBL8
+4 IF '$DATA(ENEQIO)
IF %<0
GOTO EXIT1^ENLBL8
+5 SET DIC="^ENG(6914,"
SET ENDX="M"
SET ENLOCSRT=1
PO1 SET ENPO=""
READ !,"Purchase Order #: ",X:DTIME
if X="^"!(X="")
GOTO EXIT1^ENLBL8
if X=" "
SET X="?"
if $EXTRACT(X)="?"
GOTO PO15
+1 SET X2=$LENGTH(X)
IF $DATA(^ENG(6914,"M",X))
SET ENPO=X
GOTO PO2
+2 IF $EXTRACT($ORDER(^ENG(6914,"M",X)),1,X2)=X
DO IX^ENLIB1
if X=""
GOTO PO1
if X="^"
GOTO EXIT1^ENLBL8
SET ENPO=X
WRITE " ",ENPO
GOTO PO2
+3 SET ENX=X
SET ENIX=0
IF X?.N
DO IX^ENLIB1
if X="^"
GOTO EXIT1^ENLBL8
IF $EXTRACT(X,1,X2)=ENX
SET ENPO=X
WRITE " ",ENPO
GOTO PO2
+4 IF 'ENIX
WRITE !,"There is no PURCHASE ORDER # in the Equipment File that begins with:",!,?5,ENX
+5 KILL ENIX
PO15 WRITE !,"Would you like a list of all PURCHASE ORDERS"
SET %=1
DO YN^DICN
if %<0
SET X="^"
if %<0
GOTO EXIT1^ENLBL8
if %'=1
GOTO PO1
+1 SET X=""
DO IX^ENLIB1
if X=""
GOTO PO1
if X="^"
GOTO EXIT1^ENLBL8
SET ENPO=X
WRITE " ",ENPO
PO2 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 PO2
+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="PO3^ENLBL12"
SET ZTSAVE("EN*")=""
SET ZTDESC="Barcode Labels by PO#"
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
GOTO EXIT1^ENLBL8
PO3 ;HD308658
SET ENEQBY="PO# "_ENPO
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
SET I1=$ORDER(^ENG(6914,"M",ENPO,I1))
if I1'>0
QUIT
SET DA=I1
DO STATCK^ENLBL3
IF DA]""
DO SORT^ENLBL3
if '(DA#10)
DO DOTS^ENLBL3
+3 IF $DATA(^TMP($JOB))
USE ENBCIO
DO FORMAT^ENLBL7
SET I1=""
FOR
SET I1=$ORDER(^TMP($JOB,I1))
if I1=""
QUIT
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
+4 GOTO EXIT^ENLBL8
+5 ;
SRVC ;By OWNING SERVICE
+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 DO EN^ENLBL9
IF $DATA(DIRUT)
GOTO EXIT1^ENLBL8
+4 IF '$DATA(ENEQIO)
IF %<0
GOTO EXIT1^ENLBL8
+5 SET ENLOCSRT=1
SRVC1 SET DIC="^DIC(49,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y'>0
GOTO EXIT1^ENLBL8
SET ENEQDA=+Y
SRVC2 WRITE !,"Sort labels by LOCATION"
SET %=1
DO YN^DICN
if %<0
GOTO EXIT1^ENLBL8
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 SRVC2
+1 if %=2
SET ENLOCSRT=0
+2 SET %ZIS("A")="Select BAR CODE 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="SRVC3^ENLBL12"
SET ZTDESC="Bar Code Labels by SERVICE"
SET ZTSAVE("EN*")=""
DO ^%ZTLOAD
KILL IO("Q"),ZTSK
GOTO EXIT1^ENLBL8
+6 ;HD308658
SRVC3 if '$DATA(^DIC(49,ENEQDA))
GOTO EXIT1^ENLBL8
SET ENEQBY="Owning Service: "_$PIECE(^DIC(49,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,"AC",ENEQDA,I1))
if I1'>0
QUIT
SET DA=I1
DO STATCK^ENLBL3
IF DA]""
DO SORT^ENLBL3
if '(DA#10)
DO DOTS^ENLBL3
+3 IF $DATA(^TMP($JOB))
USE ENBCIO
DO FORMAT^ENLBL7
SET I1=""
FOR
SET I1=$ORDER(^TMP($JOB,I1))
if I1=""
QUIT
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
+4 GOTO EXIT^ENLBL8
+5 ;
HOLD WRITE !,"Press <RETURN> to continue..."
READ X:DTIME
+1 QUIT
+2 ;ENLBL12
