source: FOIAVistA/tag/r/ENGINEERING-EN/ENLBL6.m@ 1569

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1ENLBL6 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
2 ;;7.0;ENGINEERING;**12,35,45**;Aug 17, 1993
3WING ;General location (Space File WING)
4 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
5WING1 S X="" R !,"Enter WING: ",X:DTIME G:X=""!(X="^") EXIT1^ENLBL8 I $E(X)="?" D HWING G WING1
6 I $D(^ENG("SP","C",X)) G WB
7 S X1=$O(^ENG("SP","C",X)),X2=$L(X) I $E(X1,1,X2)'=X S X=""
8 I X]"" D
9 . I $E($O(^ENG("SP","C",X1)),1,X2)'=X S X=X1 Q
10 . S DIC="^ENG(""SP"",",ENDX="C" D IX^ENLIB1
11 I X="" W !!,*7,"Sorry, no such WING. Please try again or enter '^' to exit.",! G WING1
12WB ; More than 1 BUILDING?
13 S ENWNG=X K X S X=0 F S X=$O(^ENG("SP","C",ENWNG,X)) Q:X'>0 S X($P($G(^ENG("SP",X,0)),U,2))=""
14WB1 S X=$O(X(0)) I $O(X(X))="" S ENBLDG="ALL"
15 E D G:X="^" EXIT1^ENLBL8 I ENBLDG'="ALL",'$D(X(ENBLDG)) G WB1
16 . W !,"Please select a BUILDING."
17 . W !,?5,"Choices are: " S X=0 F S X=$O(X(X)) Q:X']"" W X_", " W:(IOM-$X)'>15 !,?5
18 . W "or ALL."
19 . R !,?5,"BUILDING: ALL// ",X:DTIME I '$T!(X="^") S X="^" Q
20 . I X=""!(X="ALL") S ENBLDG="ALL" Q
21 . S ENBLDG=X
22WING11 S (ENFLG,ENROOM)=0 F S ENROOM=$O(^ENG("SP","C",ENWNG,ENROOM)) Q:ENFLG!(ENROOM="") D
23 . I ENBLDG="ALL",$D(^ENG(6914,"D",ENROOM)) S ENFLG=1 Q
24 . I $P($G(^ENG("SP",ENROOM,0)),U,2)=ENBLDG,$D(^ENG(6914,"D",ENROOM)) S ENFLG=1
25 I 'ENFLG W !!,*7,"There does not appear to be any equipment located on this WING",!,"(",ENWNG,"). Nothing to print.",!! G WING1
26 D EN^ENLBL9 G:$D(DIRUT) EXIT^ENLBL8
27 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
28 S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""
29 K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8
30 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")
31 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="WING2^ENLBL6",ZTSAVE("D*")="",ZTSAVE("EN*")="",ZTDESC="Equipment Bar Code Labels by WING" D ^%ZTLOAD K ZTSK G EXIT1^ENLBL8
32WING2 S ENEQBY="WING "_ENWNG,ENLOCSRT=1
33 I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8
34 K ^TMP($J) S ENROOM=0 F S ENROOM=$O(^ENG("SP","C",ENWNG,ENROOM)) Q:ENROOM="" I ENBLDG="ALL"!($$GET1^DIQ(6928,ENROOM,.5)=ENBLDG) D
35 . S K=0 F S K=$O(^ENG(6914,"D",ENROOM,K)) Q:K'>0 S DA=K D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3
36 I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1=0 F S I1=$O(^TMP($J,I1)) Q:I1="" D
37 . 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
38 G EXIT^ENLBL8
39 ;
40HWING S X="" W !,"Enter WING as defined in Space File. Would you like a list" S %=2 D YN^DICN Q:%'=1
41 S (I,ENY)=0 F K=0:0 S I=$O(^ENG("SP","C",I)) Q:I="" D:ENY>(IOSL-6) HWING2 Q:I="^" W !,?5,I S ENY=ENY+1
42 S X="" Q
43HWING2 S ENY=0 W !,"Press <RETURN> to continue or ""^"" to escape..." R X:DTIME S:X="^" I="^"
44 Q
45RM ;Single room (from Space File)
46 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
47RM1 S DIC="^ENG(""SP"",",DIC(0)="AEQM" D ^DIC
48 I Y'>0 G EXIT1^ENLBL8
49 S ENROOM=+Y,ENROOM("TXT")=$P(^ENG("SP",ENROOM,0),U)
50 I '$D(^ENG(6914,"D",ENROOM)) W !!,*7,"There does not appear to be any equipment in ",ENROOM("TXT"),".",!! K ENROOM G RM1
51 D EN^ENLBL9 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
52 S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""
53 K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8
54 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")
55 I $D(IO("Q")) S ZTIO=ION,ZTDESC="Bar Code Labels for Room "_ENROOM("TXT"),ZTRTN="RM2^ENLBL6",ZTSAVE("EN*")="",ZTSAVE("D*")="" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^ENLBL8
56RM2 S ENEQBY="Room "_ENROOM("TXT")
57 I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8
58 U ENBCIO D FORMAT^ENLBL7 F I1=0:0 S I1=$O(^ENG(6914,"D",ENROOM,I1)) Q:I1'>0 S DA=I1 D STATCK^ENLBL3 I DA]"" U ENBCIO D NXPRT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9 D:'(DA#10) DOTS^ENLBL3 D BCDT^ENLBL7
59 G EXIT^ENLBL8
60 ;
61HOLD W !,"Press <RETURN> to continue..." R X:DTIME
62 Q
63 ;
64 ;ENLBL6
Note: See TracBrowser for help on using the repository browser.