ENLBL11 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;1/11/2001
;;7.0;ENGINEERING;**12,35,45,68,90**;Aug 17, 1993;Build 25
;
WRKLST ;Print labels for PM worklist
S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
I '$D(DT) S %DT="",X="T" D ^%DT G:Y'>0 EXIT1^ENLBL8 S DT=+Y
S ENPMDT="",Y=$E(DT,1,5)_"00" X ^DD("DD") S %DT("A")="Select MONTH: ",%DT("B")=Y,%DT="AEFMX" D ^%DT K %DT G:Y'>0 EXIT1^ENLBL8 S ENPMDT=$E(Y,2,5)
D SSHOP^ENWO G:ENSHKEY'>0 EXIT1^ENLBL8 S ENPM=""
MORW W !,"MONTHLY worklist" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 I %=0 W !!,"YES for a MONTHLY worklist; NO for a WEEKLY worklist.",*7 G MORW
S:%=1 ENPM="M" D:ENPM="" WEEK G:X="^" EXIT1^ENLBL8
S ENPMWO(0)="PM-"_$P(^DIC(6922,ENSHKEY,0),U,2)_ENPMDT_ENPM,ENPMWO=$O(^ENG(6920,"B",ENPMWO(0))) I ENPMWO'[ENPMWO(0) W !,*7,"Worklist is empty." D HOLD G EXIT1^ENLBL8
S DIR(0)="Y",DIR("A")="New labels only",DIR("B")="YES"
S DIR("?",1)="The system records the printing of equipment bar code labels. If you do not"
S DIR("?",2)="wish to have labels printed again if they have already been printed at least"
S DIR("?")="once, please enter 'YES' at this time."
D ^DIR K DIR Q:$D(DIRUT) ;Suppress reprints?
S ENEQREP=+Y
K IO("Q") S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="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="WRKLST1^ENLBL11",ZTSAVE("EN*")="",ZTDESC="Bar Code Labels for PM Worklist" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EXIT1^ENLBL8
;HD308658
WRKLST1 S ENEQBY="",ENBCIO=IO U ENBCIO D FORMAT^ENLBL7 S ENDA=$O(^ENG(6920,"B",ENPMWO,0)) I ENDA>0 S DA=$S($D(^ENG(6920,ENDA,3)):$P(^(3),U,8),1:"") I DA]"" D STATCK^ENLBL3 I DA]"" D NXPRT^ENLBL7,BCDT^ENLBL7
WRKLST2 S ENPMWO=$O(^ENG(6920,"B",ENPMWO)) I ENPMWO[ENPMWO(0) S ENDA=$O(^ENG(6920,"B",ENPMWO,0)) I ENDA>0,$P($G(^ENG(6920,ENDA,5)),U,2)="" D
. S DA=$P($G(^ENG(6920,ENDA,3)),U,8) I DA]"" D STATCK^ENLBL3 I DA]"" D NXPRT^ENLBL7,BCDT^ENLBL7
D:'(DA#10) DOTS^ENLBL3 G:ENPMWO[ENPMWO(0) WRKLST2
G EXIT1^ENLBL8
;
HOLD W !,"Press <RETURN> to continue..." R X:DTIME
Q
WEEK R !,"Week number (enter an integer from 1 to 5, or '^' to escape): ",X:DTIME Q:X="^"
I X?1N,X>0,X<6 S ENPM="W"_X
E W "??",*7 G WEEK
Q
;ENLBL11
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENLBL11 2370 printed Dec 13, 2024@01:54:13 Page 2
ENLBL11 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;1/11/2001
+1 ;;7.0;ENGINEERING;**12,35,45,68,90**;Aug 17, 1993;Build 25
+2 ;
WRKLST ;Print labels for PM worklist
+1 SET ENERR=0
DO STA^ENLBL3
if ENEQSTA="^"
GOTO QUIT^ENLBL3
+2 IF '$DATA(DT)
SET %DT=""
SET X="T"
DO ^%DT
if Y'>0
GOTO EXIT1^ENLBL8
SET DT=+Y
+3 SET ENPMDT=""
SET Y=$EXTRACT(DT,1,5)_"00"
XECUTE ^DD("DD")
SET %DT("A")="Select MONTH: "
SET %DT("B")=Y
SET %DT="AEFMX"
DO ^%DT
KILL %DT
if Y'>0
GOTO EXIT1^ENLBL8
SET ENPMDT=$EXTRACT(Y,2,5)
+4 DO SSHOP^ENWO
if ENSHKEY'>0
GOTO EXIT1^ENLBL8
SET ENPM=""
MORW WRITE !,"MONTHLY worklist"
SET %=1
DO YN^DICN
if %<0
GOTO EXIT1^ENLBL8
IF %=0
WRITE !!,"YES for a MONTHLY worklist; NO for a WEEKLY worklist.",*7
GOTO MORW
+1 if %=1
SET ENPM="M"
if ENPM=""
DO WEEK
if X="^"
GOTO EXIT1^ENLBL8
+2 SET ENPMWO(0)="PM-"_$PIECE(^DIC(6922,ENSHKEY,0),U,2)_ENPMDT_ENPM
SET ENPMWO=$ORDER(^ENG(6920,"B",ENPMWO(0)))
IF ENPMWO'[ENPMWO(0)
WRITE !,*7,"Worklist is empty."
DO HOLD
GOTO EXIT1^ENLBL8
+3 SET DIR(0)="Y"
SET DIR("A")="New labels only"
SET DIR("B")="YES"
+4 SET DIR("?",1)="The system records the printing of equipment bar code labels. If you do not"
+5 SET DIR("?",2)="wish to have labels printed again if they have already been printed at least"
+6 SET DIR("?")="once, please enter 'YES' at this time."
+7 ;Suppress reprints?
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+8 SET ENEQREP=+Y
+9 KILL IO("Q")
SET %ZIS("A")="Select BAR CODE PRINTER: "
SET %ZIS("B")=""
SET %ZIS="Q"
DO ^%ZIS
KILL %ZIS("A"),%ZIS("B")
if POP
GOTO EXIT1^ENLBL8
+10 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")
+11 IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTIO=ION
SET ZTRTN="WRKLST1^ENLBL11"
SET ZTSAVE("EN*")=""
SET ZTDESC="Bar Code Labels for PM Worklist"
DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
GOTO EXIT1^ENLBL8
+12 ;HD308658
WRKLST1 SET ENEQBY=""
SET ENBCIO=IO
USE ENBCIO
DO FORMAT^ENLBL7
SET ENDA=$ORDER(^ENG(6920,"B",ENPMWO,0))
IF ENDA>0
SET DA=$SELECT($DATA(^ENG(6920,ENDA,3)):$PIECE(^(3),U,8),1:"")
IF DA]""
DO STATCK^ENLBL3
IF DA]""
DO NXPRT^ENLBL7
DO BCDT^ENLBL7
WRKLST2 SET ENPMWO=$ORDER(^ENG(6920,"B",ENPMWO))
IF ENPMWO[ENPMWO(0)
SET ENDA=$ORDER(^ENG(6920,"B",ENPMWO,0))
IF ENDA>0
IF $PIECE($GET(^ENG(6920,ENDA,5)),U,2)=""
Begin DoDot:1
+1 SET DA=$PIECE($GET(^ENG(6920,ENDA,3)),U,8)
IF DA]""
DO STATCK^ENLBL3
IF DA]""
DO NXPRT^ENLBL7
DO BCDT^ENLBL7
End DoDot:1
+2 if '(DA#10)
DO DOTS^ENLBL3
if ENPMWO[ENPMWO(0)
GOTO WRKLST2
+3 GOTO EXIT1^ENLBL8
+4 ;
HOLD WRITE !,"Press <RETURN> to continue..."
READ X:DTIME
+1 QUIT
WEEK READ !,"Week number (enter an integer from 1 to 5, or '^' to escape): ",X:DTIME
if X="^"
QUIT
+1 IF X?1N
IF X>0
IF X<6
SET ENPM="W"_X
+2 IF '$TEST
WRITE "??",*7
GOTO WEEK
+3 QUIT
+4 ;ENLBL11
