source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENLBL4.m@ 701

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1ENLBL4 ;(WASH ISC)/DH-Print Bar Coded Location Labels ;10.10.97
2 ;;7.0;ENGINEERING;**12,35,42,45**;Aug 17, 1993
3WING ;Print an entire WING from Space File (6928)
4 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
5 N DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1
6 W @IOF R !!,"Select WING: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 I "?"[X D WHELP1^ENLBL8
7 I X["??" D WHELP2^ENLBL8
8 I X]"",$D(^ENG("SP","C",X)) D WING1 G EXIT1^ENLBL8
9 I X]"" W " ??",!,*7,"Invalid entry. Press <RETURN> to continue, '^' to exit, or ""?"" for help..." R X:DTIME D:X["?" WHELP1^ENLBL8 G:X="^" EXIT1^ENLBL8
10 S X="" G WING
11WING1 K ENEQC S ENEQC=X W !!,"For all rooms in WING: ",ENEQC S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 G:%<1 WING1 D:%=2 FLOOR^ENLBL8
12 K IO("Q") S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8
13 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")
14 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="WING2^ENLBL4",ZTSAVE("EN*")="",ZTDESC="Location Barcode Labels (WING)" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EXIT1^ENLBL8
15WING2 K ^TMP($J) U ENBCIO D FORMAT
16 F DA=0:0 S DA=$O(^ENG("SP","C",ENEQC,DA)) Q:DA="" S ENEQB=$P(^ENG("SP",DA,0),U,1) I ENEQB]"" D SORT D:'(DA#20) DOTS^ENLBL3
17 I $D(^TMP($J)) S J=0 F S J=$O(^TMP($J,J)) Q:J="" S DA=$O(^TMP($J,J,0)) I DA>0 S ENEQB=^(DA) U ENBCIO D LOCPRT I ENEQB'["E" D:'(+ENEQB#10) DOTS^ENLBL3
18 Q
19 ;
20BLDG ;Print labels for all rooms in specified building
21 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
22 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
23 S DIC="^ENG(6928.3,",DIC(0)="AEQM" D ^DIC G:Y'>0 EXIT1^ENLBL8 S X=$P(^ENG(6928.3,+Y,0),U),ENBLDG=$P(X,"-",1),ENDIV=$P(X,"-",2)
24 S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" K IO("Q") D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8
25 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")
26 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="BLDG1^ENLBL4",ZTSAVE("EN*")="",ZTDESC="Location Barcode Labels (BUILDING)" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EXIT1^ENLBL8
27BLDG1 K ^TMP($J)
28 F DA=0:0 S DA=$O(^ENG("SP","E",ENBLDG,DA)) Q:DA'>0 D CKDIV D:'(+DA#20) DOTS^ENLBL3
29 I $D(^TMP($J)) D
30 . U ENBCIO D FORMAT
31 . S J=0 F S J=$O(^TMP($J,J)) Q:J="" S DA=$O(^TMP($J,J,0)) I DA>0 S ENEQB=^(DA) U ENBCIO D LOCPRT D:'(DA#10) DOTS^ENLBL3
32 G EXIT1^ENLBL8
33CKDIV Q:'$D(^ENG("SP",DA,0)) S ENEQB=$P(^(0),U,1) I $D(ENDIV),$P(ENEQB,"-",3)'=ENDIV Q
34 D SORT
35 Q
36 ;
37RM ;Print a single room label
38 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
39 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
40RM0 S DIC="^ENG(""SP"",",DIC(0)="AEQMZ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQB=Y(0,0),DA=+Y
41 K IO("Q") S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8
42 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")
43 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="RM1^ENLBL4",ZTSAVE("EN*")="",ZTSAVE("DA")="",ZTDESC="Location Barcode Label (ROOM)" D ^%ZTLOAD K ZTSK D ^%ZISC G RM0
44RM1 U ENBCIO D FORMAT
45 D LOCPRT
46 G:$D(ZTQUEUED) EXIT1^ENLBL8
47 D ^%ZISC G RM0
48 ;
49ALL ;Print a location label for every record in the SPACE file
50 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
51 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
52 K IO("Q") S %ZIS="Q",%ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="" D ^%ZIS K %ZIS("A") G:POP EXIT1^ENLBL8
53 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")
54 I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="ALL1^ENLBL4",ZTSAVE("EN*")="",ZTDESC="Location Barcode Labels (ALL)" D ^%ZTLOAD K ZTSK D HOME^%ZIS G EXIT1^ENLBL8
55ALL1 K ^TMP($J) U ENBCIO D FORMAT
56 F DA=0:0 S DA=$O(^ENG("SP",DA)) Q:DA'>0 I $D(^(DA,0)) S ENEQB=$P(^(0),U) I ENEQB]"" D SORT D:'(DA#20) DOTS^ENLBL3
57 I $D(^TMP($J)) S J=0 F S J=$O(^TMP($J,J)) Q:J="" S DA=$O(^TMP($J,J,0)) I DA>0 S ENEQB=^(DA) U ENBCIO D LOCPRT D:'(DA#10) DOTS^ENLBL3
58 G EXIT1^ENLBL8
59 ;
60SORT I $D(ENEQC("FR")) I ENEQC("FR")]ENEQB!(ENEQB]ENEQC("TO")) Q
61 I $D(^ENG("SP",DA,9)) S X=$P(^(9),U),^TMP($J,X,DA)=ENEQB Q
62 F I=1:1:3 S X(I)=$P(ENEQB,"-",I)
63 S X=X(3)_":"_X(2)_":"_X(1),^TMP($J,X,DA)=ENEQB
64 Q
65 ;
66LOCPRT ;Actual print
67 I ENEQB["e" S ENEQB=$TR(ENEQB,"e","E")
68 I ENEQB'?.NUP D WARN^ENLBL8 Q
69 S ENEQBC="SP"_ENEQB
70 I ENBAR("LOCATION DATA")]"" X ENBAR("LOCATION DATA") Q
71 W *2,*27,"E3",!,*24
72 N ENX S ENX="* LOCATION LABEL *" I $D(^DIC(6910,1,0)),$P(^(0),U,9)=1,$D(^ENG("SP",DA,4)) S X=$P(^(4),U) I X]"",$D(^ENG(6928.1,X,0)) S X1=$P(^(0),U),ENX=$E(X1,1,20)
73 W ENX,!,ENEQBC,!,ENEQSTAN
74 W *23,*3
75 Q
76 ;
77FORMAT ;Location labels
78 K ENBAR S (ENBAR("LOCATION FORMAT"),ENBAR("LOCATION DATA"))=""
79 S ENBCIOS(0)=$O(^DIC(6910.1,"B",ENBCIOS,0)) D:ENBCIOS(0)
80 . S ENBAR("LOCATION FORMAT")=$G(^DIC(6910.1,ENBCIOS(0),2))
81 . S ENBAR("LOCATION DATA")=$G(^DIC(6910.1,ENBCIOS(0),4))
82 I ENBAR("LOCATION FORMAT")]"" X ENBAR("LOCATION FORMAT") Q
83 D FORMAT1^ENLBL7
84 Q
85 ;ENLBL4
Note: See TracBrowser for help on using the repository browser.