source: FOIAVistA/trunk/r/ENGINEERING-EN/ENLBL12.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.6 KB
Line 
1ENLBL12 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97
2 ;;7.0;ENGINEERING;**12,16,35,45**;Aug 17, 1993
3PO ;All items on one specific Purchase Order
4 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
5 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
6 D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8
7 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
8 S DIC="^ENG(6914,",ENDX="M",ENLOCSRT=1
9PO1 S ENPO="" R !,"Purchase Order #: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S:X=" " X="?" G:$E(X)="?" PO15
10 S X2=$L(X) I $D(^ENG(6914,"M",X)) S ENPO=X G PO2
11 I $E($O(^ENG(6914,"M",X)),1,X2)=X D IX^ENLIB1 G:X="" PO1 G:X="^" EXIT1^ENLBL8 S ENPO=X W " ",ENPO G PO2
12 S ENX=X,ENIX=0 I X?.N D IX^ENLIB1 G:X="^" EXIT1^ENLBL8 I $E(X,1,X2)=ENX S ENPO=X W " ",ENPO G PO2
13 I 'ENIX W !,"There is no PURCHASE ORDER # in the Equipment File that begins with:",!,?5,ENX
14 K ENIX
15PO15 W !,"Would you like a list of all PURCHASE ORDERS" S %=1 D YN^DICN S:%<0 X="^" G:%<0 EXIT1^ENLBL8 G:%'=1 PO1
16 S X="" D IX^ENLIB1 G:X="" PO1 G:X="^" EXIT1^ENLBL8 S ENPO=X W " ",ENPO
17PO2 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 I %=0 W !,"Say YES to sort labels by BUILDING, then by ROOM within BUILDING.",!,"If you say NO, labels will be sorted by EQUIPMENT ID #." G PO2
18 S:%=2 ENLOCSRT=0
19 S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""
20 K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8
21 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")
22 I $D(IO("Q")) S ZTIO=ION,ZTRTN="PO3^ENLBL12",ZTSAVE("EN*")="",ZTDESC="Barcode Labels by PO#" D ^%ZTLOAD K IO("Q"),ZTSK G EXIT1^ENLBL8
23PO3 S ENEQBY="PO# "_ENPO
24 I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8
25 K ^TMP($J) S I1=0 F S I1=$O(^ENG(6914,"M",ENPO,I1)) Q:I1'>0 S DA=I1 D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3
26 I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F S I1=$O(^TMP($J,I1)) Q:I1="" 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
27 G EXIT^ENLBL8
28 ;
29SRVC ;By OWNING SERVICE
30 S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3
31 N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1
32 D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8
33 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8
34 S ENLOCSRT=1
35SRVC1 S DIC="^DIC(49,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQDA=+Y
36SRVC2 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 I %=0 W !,"Say YES to sort labels by DIVISION, BUILDING, then by ROOM.",!,"If you say NO, labels will be sorted by EQUIPMENT ID#." G SRVC2
37 S:%=2 ENLOCSRT=0
38 S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS=""
39 K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8
40 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")
41 I $D(IO("Q")) S ZTIO=ION,ZTRTN="SRVC3^ENLBL12",ZTDESC="Bar Code Labels by SERVICE",ZTSAVE("EN*")="" D ^%ZTLOAD K IO("Q"),ZTSK G EXIT1^ENLBL8
42SRVC3 G:'$D(^DIC(49,ENEQDA)) EXIT1^ENLBL8 S ENEQBY="Owning Service: "_$P(^DIC(49,ENEQDA,0),U,1)
43 I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8
44 K ^TMP($J) F I1=0:0 S I1=$O(^ENG(6914,"AC",ENEQDA,I1)) Q:I1'>0 S DA=I1 D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3
45 I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F S I1=$O(^TMP($J,I1)) Q:I1="" 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
46 G EXIT^ENLBL8
47 ;
48HOLD W !,"Press <RETURN> to continue..." R X:DTIME
49 Q
50 ;ENLBL12
Note: See TracBrowser for help on using the repository browser.