- 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 Jan 18, 2025@02:55:26 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