source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENLBL11.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1ENLBL11 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;1/11/2001
2 ;;7.0;ENGINEERING;**12,35,45,68**;Aug 17, 1993
3 ;
4WRKLST ;Print labels for PM worklist
5 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
6 I '$D(DT) S %DT="",X="T" D ^%DT G:Y'>0 EXIT1^ENLBL8 S DT=+Y
7 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)
8 D SSHOP^ENWO G:ENSHKEY'>0 EXIT1^ENLBL8 S ENPM=""
9MORW 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
10 S:%=1 ENPM="M" D:ENPM="" WEEK G:X="^" EXIT1^ENLBL8
11 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
12 S DIR(0)="Y",DIR("A")="New labels only",DIR("B")="YES"
13 S DIR("?",1)="The system records the printing of equipment bar code labels. If you do not"
14 S DIR("?",2)="wish to have labels printed again if they have already been printed at least"
15 S DIR("?")="once, please enter 'YES' at this time."
16 D ^DIR K DIR Q:$D(DIRUT) ;Suppress reprints?
17 S ENEQREP=+Y
18 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
19 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")
20 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
21WRKLST1 S ENEQBY="" 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
22WRKLST2 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
23 . S DA=$P($G(^ENG(6920,ENDA,3)),U,8) I DA]"" D STATCK^ENLBL3 I DA]"" D NXPRT^ENLBL7,BCDT^ENLBL7
24 D:'(DA#10) DOTS^ENLBL3 G:ENPMWO[ENPMWO(0) WRKLST2
25 G EXIT1^ENLBL8
26 ;
27HOLD W !,"Press <RETURN> to continue..." R X:DTIME
28 Q
29WEEK R !,"Week number (enter an integer from 1 to 5, or '^' to escape): ",X:DTIME Q:X="^"
30 I X?1N,X>0,X<6 S ENPM="W"_X
31 E W "??",*7 G WEEK
32 Q
33 ;ENLBL11
Note: See TracBrowser for help on using the repository browser.