Released EN*7*90 SEQ #85 Extracted from mail message **KIDS**:EN*7.0*90^ **INSTALL NAME** EN*7.0*90 "BLD",8239,0) EN*7.0*90^ENGINEERING^0^3100309^y "BLD",8239,1,0) ^^3^3^3100126^ "BLD",8239,1,1,0) This patch addresses two issues about non-standard IO symbols for the "BLD",8239,1,2,0) bar code printing in the Engineering application running under the Red "BLD",8239,1,3,0) Hat Linux operating system. "BLD",8239,4,0) ^9.64PA^^0 "BLD",8239,6) ^84 "BLD",8239,6.3) 25 "BLD",8239,"ABPKG") n "BLD",8239,"INID") ^ "BLD",8239,"INIT") "BLD",8239,"KRN",0) ^9.67PA^779.2^20 "BLD",8239,"KRN",.4,0) .4 "BLD",8239,"KRN",.4,"NM",0) ^9.68A^^0 "BLD",8239,"KRN",.401,0) .401 "BLD",8239,"KRN",.402,0) .402 "BLD",8239,"KRN",.403,0) .403 "BLD",8239,"KRN",.403,"NM",0) ^9.68A^^0 "BLD",8239,"KRN",.5,0) .5 "BLD",8239,"KRN",.84,0) .84 "BLD",8239,"KRN",3.6,0) 3.6 "BLD",8239,"KRN",3.6,"NM",0) ^9.68A^^0 "BLD",8239,"KRN",3.8,0) 3.8 "BLD",8239,"KRN",3.8,"NM",0) ^9.68A^^0 "BLD",8239,"KRN",9.2,0) 9.2 "BLD",8239,"KRN",9.8,0) 9.8 "BLD",8239,"KRN",9.8,"NM",0) ^9.68A^9^9 "BLD",8239,"KRN",9.8,"NM",1,0) ENLBL3^^0^B20585581 "BLD",8239,"KRN",9.8,"NM",2,0) ENLBL4^^0^B26614374 "BLD",8239,"KRN",9.8,"NM",3,0) ENLBL5^^0^B19840430 "BLD",8239,"KRN",9.8,"NM",4,0) ENLBL6^^0^B21556376 "BLD",8239,"KRN",9.8,"NM",5,0) ENLBL10^^0^B18912054 "BLD",8239,"KRN",9.8,"NM",6,0) ENLBL11^^0^B10789094 "BLD",8239,"KRN",9.8,"NM",7,0) ENLBL12^^0^B20705398 "BLD",8239,"KRN",9.8,"NM",8,0) ENLBL15^^0^B17967284 "BLD",8239,"KRN",9.8,"NM",9,0) ENLBL9^^0^B16770608 "BLD",8239,"KRN",9.8,"NM","B","ENLBL10",5) "BLD",8239,"KRN",9.8,"NM","B","ENLBL11",6) "BLD",8239,"KRN",9.8,"NM","B","ENLBL12",7) "BLD",8239,"KRN",9.8,"NM","B","ENLBL15",8) "BLD",8239,"KRN",9.8,"NM","B","ENLBL3",1) "BLD",8239,"KRN",9.8,"NM","B","ENLBL4",2) "BLD",8239,"KRN",9.8,"NM","B","ENLBL5",3) "BLD",8239,"KRN",9.8,"NM","B","ENLBL6",4) "BLD",8239,"KRN",9.8,"NM","B","ENLBL9",9) "BLD",8239,"KRN",19,0) 19 "BLD",8239,"KRN",19,"NM",0) ^9.68A^^0 "BLD",8239,"KRN",19.1,0) 19.1 "BLD",8239,"KRN",19.1,"NM",0) ^9.68A^^0 "BLD",8239,"KRN",101,0) 101 "BLD",8239,"KRN",409.61,0) 409.61 "BLD",8239,"KRN",771,0) 771 "BLD",8239,"KRN",779.2,0) 779.2 "BLD",8239,"KRN",870,0) 870 "BLD",8239,"KRN",8989.51,0) 8989.51 "BLD",8239,"KRN",8989.52,0) 8989.52 "BLD",8239,"KRN",8994,0) 8994 "BLD",8239,"KRN","B",.4,.4) "BLD",8239,"KRN","B",.401,.401) "BLD",8239,"KRN","B",.402,.402) "BLD",8239,"KRN","B",.403,.403) "BLD",8239,"KRN","B",.5,.5) "BLD",8239,"KRN","B",.84,.84) "BLD",8239,"KRN","B",3.6,3.6) "BLD",8239,"KRN","B",3.8,3.8) "BLD",8239,"KRN","B",9.2,9.2) "BLD",8239,"KRN","B",9.8,9.8) "BLD",8239,"KRN","B",19,19) "BLD",8239,"KRN","B",19.1,19.1) "BLD",8239,"KRN","B",101,101) "BLD",8239,"KRN","B",409.61,409.61) "BLD",8239,"KRN","B",771,771) "BLD",8239,"KRN","B",779.2,779.2) "BLD",8239,"KRN","B",870,870) "BLD",8239,"KRN","B",8989.51,8989.51) "BLD",8239,"KRN","B",8989.52,8989.52) "BLD",8239,"KRN","B",8994,8994) "BLD",8239,"QDEF") ^^^^^^^^^^ "BLD",8239,"QUES",0) ^9.62^^ "BLD",8239,"REQB",0) ^9.611^2^2 "BLD",8239,"REQB",1,0) EN*7.0*68^2 "BLD",8239,"REQB",2,0) EN*7.0*80^2 "BLD",8239,"REQB","B","EN*7.0*68",1) "BLD",8239,"REQB","B","EN*7.0*80",2) "MBREQ") 0 "PKG",33,-1) 1^1 "PKG",33,0) ENGINEERING^EN^AUTOMATED ENGINEERING MANAGEMENT SYSTEM "PKG",33,20,0) ^9.402P^^ "PKG",33,22,0) ^9.49I^1^1 "PKG",33,22,1,0) 7.0^2930817^2960130 "PKG",33,22,1,"PAH",1,0) 90^3100309 "PKG",33,22,1,"PAH",1,1,0) ^^3^3^3100309 "PKG",33,22,1,"PAH",1,1,1,0) This patch addresses two issues about non-standard IO symbols for the "PKG",33,22,1,"PAH",1,1,2,0) bar code printing in the Engineering application running under the Red "PKG",33,22,1,"PAH",1,1,3,0) Hat Linux operating system. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 9 "RTN","ENLBL10") 0^5^B18912054^B18822825 "RTN","ENLBL10",1,0) ENLBL10 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97 "RTN","ENLBL10",2,0) ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25 "RTN","ENLBL10",3,0) PM ;Range of PM numbers "RTN","ENLBL10",4,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL10",5,0) N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1 "RTN","ENLBL10",6,0) PM1 S X="" R !,"Starting with: ",X:DTIME G:X=""!($E(X)="^") EXIT1^ENLBL8 "RTN","ENLBL10",7,0) I $E(X)="?" D G PM1 "RTN","ENLBL10",8,0) . W !!,"Property Management (PM) numbers should consist of four numbers, followed",!,"by a dash (-), followed by four more numbers. There may be an alphabetic" "RTN","ENLBL10",9,0) . W !,"at the end (for a grand total of ten characters), but there usually isn't." "RTN","ENLBL10",10,0) . W !!,"The first four numbers correspond to the Federal Supply Classification Code." "RTN","ENLBL10",11,0) . W !,"The next four numbers are assigned at the site, usually by the Property",!,"Management Section in A&MM." "RTN","ENLBL10",12,0) . W !!,"It is the intent of VACO Program Offices to phase out PM numbers in favor of",!,"the AEMS/MERS entry number, but no official timetable has been established.",! "RTN","ENLBL10",13,0) S FR=X I FR'?4N1"-"4N W !,"Doesn't look like a standard PM number. Are you sure",*7 S %=2 D YN^DICN G:%<0 EXIT1^ENLBL8 G:%=2 PM1 I %=0 W !,"PM #'s look like '7025-5001'." G PM1 "RTN","ENLBL10",14,0) I FR=+FR S FR=FR_" " "RTN","ENLBL10",15,0) PM2 S X="" R !,"and ending with: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S TO=X I FR]TO W !!,"Your ending point does not follow your starting point. I'm confused.",*7 G PM1 "RTN","ENLBL10",16,0) I TO'?4N1"-"4N W !,"Are you sure" S %=2 D YN^DICN G:%<0 EXIT1^ENLBL8 G:%=2 PM2 I %=0 W !,"PM numbers look like '7025-5001'." G PM2 "RTN","ENLBL10",17,0) I '$D(^ENG(6914,"C",FR)) S I=$O(^ENG(6914,"C",FR)) I I]TO W !!,*7,"Sorry, but there doesn't appear to be any equipment in specified range." G PM1 "RTN","ENLBL10",18,0) D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8 "RTN","ENLBL10",19,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL10",20,0) S ENLOCSRT=1 "RTN","ENLBL10",21,0) PM21 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 VA PM #." G PM21 "RTN","ENLBL10",22,0) S:%=2 ENLOCSRT=0 "RTN","ENLBL10",23,0) S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL10",24,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL10",25,0) 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") "RTN","ENLBL10",26,0) I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="PM3^ENLBL10",ZTSAVE("D*")="",ZTSAVE("EN*")="",ZTSAVE("FR")="",ZTSAVE("TO")="",ZTDESC="NX Barcode Labels by PM #" D ^%ZTLOAD K ZTSK G EXIT1^ENLBL8 "RTN","ENLBL10",27,0) PM3 S ENEQBY="PM # "_FR_" thru "_TO,ENBCIO=IO ;HD308658 "RTN","ENLBL10",28,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL10",29,0) K ^TMP($J) S I1=FR I $D(^ENG(6914,"C",FR)) S DA=$O(^ENG(6914,"C",FR,0)) D STATCK^ENLBL3 I DA]"" D:ENLOCSRT SORT^ENLBL3 I 'ENLOCSRT D PMNSRT "RTN","ENLBL10",30,0) F K=0:0 S I1=$O(^ENG(6914,"C",I1)) Q:I1=""!(I1]TO) S DA=$O(^ENG(6914,"C",I1,0)) D STATCK^ENLBL3 I DA]"" D:ENLOCSRT SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3 I 'ENLOCSRT D PMNSRT "RTN","ENLBL10",31,0) I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F J1=0:0 S I1=$O(^TMP($J,I1)) Q:I1="" F DA=0:0 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 "RTN","ENLBL10",32,0) G EXIT^ENLBL8 "RTN","ENLBL10",33,0) ; "RTN","ENLBL10",34,0) PMNSRT S ^TMP($J,I1,DA)="" Q "RTN","ENLBL10",35,0) HOLD W !,"Press to continue..." R X:DTIME "RTN","ENLBL10",36,0) Q "RTN","ENLBL10",37,0) ;ENLBL10 "RTN","ENLBL11") 0^6^B10789094^B10604363 "RTN","ENLBL11",1,0) ENLBL11 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;1/11/2001 "RTN","ENLBL11",2,0) ;;7.0;ENGINEERING;**12,35,45,68,90**;Aug 17, 1993;Build 25 "RTN","ENLBL11",3,0) ; "RTN","ENLBL11",4,0) WRKLST ;Print labels for PM worklist "RTN","ENLBL11",5,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL11",6,0) I '$D(DT) S %DT="",X="T" D ^%DT G:Y'>0 EXIT1^ENLBL8 S DT=+Y "RTN","ENLBL11",7,0) 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) "RTN","ENLBL11",8,0) D SSHOP^ENWO G:ENSHKEY'>0 EXIT1^ENLBL8 S ENPM="" "RTN","ENLBL11",9,0) 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 "RTN","ENLBL11",10,0) S:%=1 ENPM="M" D:ENPM="" WEEK G:X="^" EXIT1^ENLBL8 "RTN","ENLBL11",11,0) 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 "RTN","ENLBL11",12,0) S DIR(0)="Y",DIR("A")="New labels only",DIR("B")="YES" "RTN","ENLBL11",13,0) S DIR("?",1)="The system records the printing of equipment bar code labels. If you do not" "RTN","ENLBL11",14,0) S DIR("?",2)="wish to have labels printed again if they have already been printed at least" "RTN","ENLBL11",15,0) S DIR("?")="once, please enter 'YES' at this time." "RTN","ENLBL11",16,0) D ^DIR K DIR Q:$D(DIRUT) ;Suppress reprints? "RTN","ENLBL11",17,0) S ENEQREP=+Y "RTN","ENLBL11",18,0) 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 "RTN","ENLBL11",19,0) 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") "RTN","ENLBL11",20,0) 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 "RTN","ENLBL11",21,0) ;HD308658 "RTN","ENLBL11",22,0) 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 "RTN","ENLBL11",23,0) 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 "RTN","ENLBL11",24,0) . S DA=$P($G(^ENG(6920,ENDA,3)),U,8) I DA]"" D STATCK^ENLBL3 I DA]"" D NXPRT^ENLBL7,BCDT^ENLBL7 "RTN","ENLBL11",25,0) D:'(DA#10) DOTS^ENLBL3 G:ENPMWO[ENPMWO(0) WRKLST2 "RTN","ENLBL11",26,0) G EXIT1^ENLBL8 "RTN","ENLBL11",27,0) ; "RTN","ENLBL11",28,0) HOLD W !,"Press to continue..." R X:DTIME "RTN","ENLBL11",29,0) Q "RTN","ENLBL11",30,0) WEEK R !,"Week number (enter an integer from 1 to 5, or '^' to escape): ",X:DTIME Q:X="^" "RTN","ENLBL11",31,0) I X?1N,X>0,X<6 S ENPM="W"_X "RTN","ENLBL11",32,0) E W "??",*7 G WEEK "RTN","ENLBL11",33,0) Q "RTN","ENLBL11",34,0) ;ENLBL11 "RTN","ENLBL12") 0^7^B20705398^B20492966 "RTN","ENLBL12",1,0) ENLBL12 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97 "RTN","ENLBL12",2,0) ;;7.0;ENGINEERING;**12,16,35,45,90**;Aug 17, 1993;Build 25 "RTN","ENLBL12",3,0) PO ;All items on one specific Purchase Order "RTN","ENLBL12",4,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL12",5,0) N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1 "RTN","ENLBL12",6,0) D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8 "RTN","ENLBL12",7,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL12",8,0) S DIC="^ENG(6914,",ENDX="M",ENLOCSRT=1 "RTN","ENLBL12",9,0) PO1 S ENPO="" R !,"Purchase Order #: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S:X=" " X="?" G:$E(X)="?" PO15 "RTN","ENLBL12",10,0) S X2=$L(X) I $D(^ENG(6914,"M",X)) S ENPO=X G PO2 "RTN","ENLBL12",11,0) 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 "RTN","ENLBL12",12,0) 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 "RTN","ENLBL12",13,0) I 'ENIX W !,"There is no PURCHASE ORDER # in the Equipment File that begins with:",!,?5,ENX "RTN","ENLBL12",14,0) K ENIX "RTN","ENLBL12",15,0) PO15 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 "RTN","ENLBL12",16,0) S X="" D IX^ENLIB1 G:X="" PO1 G:X="^" EXIT1^ENLBL8 S ENPO=X W " ",ENPO "RTN","ENLBL12",17,0) PO2 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 "RTN","ENLBL12",18,0) S:%=2 ENLOCSRT=0 "RTN","ENLBL12",19,0) S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL12",20,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL12",21,0) 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") "RTN","ENLBL12",22,0) 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 "RTN","ENLBL12",23,0) PO3 S ENEQBY="PO# "_ENPO,ENBCIO=IO ;HD308658 "RTN","ENLBL12",24,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL12",25,0) 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 "RTN","ENLBL12",26,0) 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 "RTN","ENLBL12",27,0) G EXIT^ENLBL8 "RTN","ENLBL12",28,0) ; "RTN","ENLBL12",29,0) SRVC ;By OWNING SERVICE "RTN","ENLBL12",30,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL12",31,0) N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1 "RTN","ENLBL12",32,0) D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8 "RTN","ENLBL12",33,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL12",34,0) S ENLOCSRT=1 "RTN","ENLBL12",35,0) SRVC1 S DIC="^DIC(49,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQDA=+Y "RTN","ENLBL12",36,0) SRVC2 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 "RTN","ENLBL12",37,0) S:%=2 ENLOCSRT=0 "RTN","ENLBL12",38,0) S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL12",39,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL12",40,0) 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") "RTN","ENLBL12",41,0) 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 "RTN","ENLBL12",42,0) ;HD308658 "RTN","ENLBL12",43,0) SRVC3 G:'$D(^DIC(49,ENEQDA)) EXIT1^ENLBL8 S ENEQBY="Owning Service: "_$P(^DIC(49,ENEQDA,0),U,1),ENBCIO=IO "RTN","ENLBL12",44,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL12",45,0) 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 "RTN","ENLBL12",46,0) 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 "RTN","ENLBL12",47,0) G EXIT^ENLBL8 "RTN","ENLBL12",48,0) ; "RTN","ENLBL12",49,0) HOLD W !,"Press to continue..." R X:DTIME "RTN","ENLBL12",50,0) Q "RTN","ENLBL12",51,0) ;ENLBL12 "RTN","ENLBL15") 0^8^B17967284^B17825720 "RTN","ENLBL15",1,0) ENLBL15 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97 "RTN","ENLBL15",2,0) ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25 "RTN","ENLBL15",3,0) LOCID ;By LOCAL IDENTIFIER "RTN","ENLBL15",4,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL15",5,0) N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1 "RTN","ENLBL15",6,0) D EN^ENLBL9 I $D(DIRUT) G EXIT1^ENLBL8 "RTN","ENLBL15",7,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL15",8,0) S DIC="^ENG(6914,",ENDX="L",ENLOCSRT=1 "RTN","ENLBL15",9,0) LOCID1 S (X,ENLID)="" R !,"Start with: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S:X=" " X="?" G:$E(X)="?" LOCID15 "RTN","ENLBL15",10,0) S X2=$L(X) I $D(^ENG(6914,"L",X)) S ENLID("FR")=X G LOCID2 "RTN","ENLBL15",11,0) I $E($O(^ENG(6914,"L",X)),1,X2)=X D IX^ENLIB1 G:X="" LOCID1 G:X="^" EXIT1^ENLBL8 S ENLID("FR")=X W " ",ENLID("FR") G LOCID2 "RTN","ENLBL15",12,0) S ENX=X,ENIX=0 I X?.N D IX^ENLIB1 G:X="^" EXIT1^ENLBL8 I $E(X,1,X2)=ENX S ENLID("FR")=X W " ",ENLID("FR") G LOCID2 "RTN","ENLBL15",13,0) I 'ENIX W !,"There is no LOCAL IDENTIFIER in the Equipment File that begins with:",!,?5,ENX "RTN","ENLBL15",14,0) K ENIX "RTN","ENLBL15",15,0) LOCID15 W !,"Would you like a list of all LOCAL IDENTIFIERS" S %=1 D YN^DICN S:%<0 X="^" G:%<0 EXIT1^ENLBL8 G:%'=1 LOCID1 "RTN","ENLBL15",16,0) S X="" D IX^ENLIB1 G:X="" LOCID1 G:X="^" EXIT1^ENLBL8 S ENLID("FR")=X W " ",ENLID("FR") "RTN","ENLBL15",17,0) LOCID2 S X="" R !,"Go to: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 S:X=" " X="?" "RTN","ENLBL15",18,0) I $E(X)="?" W !,"Please enter a character string which follows (or equals):",!,ENLID("FR"),!,"This will be the end point of our print job." G LOCID2 "RTN","ENLBL15",19,0) I ENLID("FR")?.N,$L(X)>0,X'?.N G LOCID25 "RTN","ENLBL15",20,0) I ENLID("FR")?.N,X?.N,X'0 S DA=ENDA D STATCK^ENLBL3 I DA]"" D:ENLOCSRT SORT^ENLBL3 I 'ENLOCSRT D LIDSRT "RTN","ENLBL15",33,0) I $G(I1)]"" F S I1=$O(^ENG(6914,"L",I1)) Q:I1="" D NEXT Q:I1="" S ENDA=0 F S ENDA=$O(^ENG(6914,"L",I1,ENDA)) Q:ENDA'>0 S DA=ENDA D STATCK^ENLBL3 I DA]"" D:ENLOCSRT SORT^ENLBL3 D:'(ENDA#10) DOTS^ENLBL3 I 'ENLOCSRT D LIDSRT "RTN","ENLBL15",34,0) 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 "RTN","ENLBL15",35,0) G EXIT^ENLBL8 "RTN","ENLBL15",36,0) ; "RTN","ENLBL15",37,0) NEXT ;Time to quit? "RTN","ENLBL15",38,0) I I1=+I1,ENLID("TO")'=+ENLID("TO") Q "RTN","ENLBL15",39,0) I I1=+I1,ENLID("TO")=+ENLID("TO") S:I1>ENLID("TO") I1="" Q "RTN","ENLBL15",40,0) I I1'=+I1,ENLID("TO")=+ENLID("TO") S I1="" Q "RTN","ENLBL15",41,0) I I1]ENLID("TO") S I1="" "RTN","ENLBL15",42,0) Q "RTN","ENLBL15",43,0) ; "RTN","ENLBL15",44,0) LIDSRT S ^TMP($J,I1,DA)="" Q "RTN","ENLBL15",45,0) HOLD W !,"Press to continue..." R X:DTIME "RTN","ENLBL15",46,0) Q "RTN","ENLBL15",47,0) ;ENLBL15 "RTN","ENLBL3") 0^1^B20585581^B20262703 "RTN","ENLBL3",1,0) ENLBL3 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97 "RTN","ENLBL3",2,0) ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25 "RTN","ENLBL3",3,0) ; "RTN","ENLBL3",4,0) SD ;Single device "RTN","ENLBL3",5,0) S ENERR=0 D STA G:ENEQSTA="^" QUIT "RTN","ENLBL3",6,0) N DIC,DIE,DR,DA,FR,TO,X,X1,X2,I,J,K,I1 "RTN","ENLBL3",7,0) N TAG D EN1^ENLBL9 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL3",8,0) SD1 D GETEQ^ENUTL "RTN","ENLBL3",9,0) I Y'>0 S TAG=$S('$D(ENEQIO):"EXIT1",$D(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8" G @TAG "RTN","ENLBL3",10,0) S DA=+Y "RTN","ENLBL3",11,0) S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")=$S($D(ENBCIO):ENBCION,1:""),%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL3",12,0) K IO("Q") D ^%ZIS K %ZIS I POP S TAG=$S('$D(ENEQIO):"EXIT1",$D(IO(1,ENEQIO)):"EXIT",1:"EXIT1")_"^ENLBL8" G @TAG "RTN","ENLBL3",13,0) I $D(ENBCIO),ENBCIO'=IO D "RTN","ENLBL3",14,0) . N IO,IOSL,IOF,ION,IOST S IO=ENBCIO D ^%ZISC Q "RTN","ENLBL3",15,0) 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") "RTN","ENLBL3",16,0) I $D(IO("Q")) D G SD1 "RTN","ENLBL3",17,0) . S:$D(ENEQIO) ENEQY(0)=ENEQY,ENEQPG(0)=ENEQPG,(ENEQY,ENEQPG)=0 "RTN","ENLBL3",18,0) . S ZTIO=ION,ZTRTN="SD2^ENLBL3",ZTSAVE("DA")="",ZTSAVE("EN*")="",ZTDESC="Single Equipment Bar Code Label" D ^%ZTLOAD K ZTSK,IO("Q") D ^%ZISC "RTN","ENLBL3",19,0) . S:$D(ENEQIO) ENEQY=ENEQY(0),ENEQPG=ENEQPG(0) "RTN","ENLBL3",20,0) ;HD308658 "RTN","ENLBL3",21,0) SD2 S ENEQBY="Single Label(s)",ENBCIO=IO "RTN","ENLBL3",22,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL3",23,0) U ENBCIO D FORMAT^ENLBL7 "RTN","ENLBL3",24,0) D NXPRT^ENLBL7,BCDT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9 "RTN","ENLBL3",25,0) G:$D(ZTQUEUED) EXIT^ENLBL8 "RTN","ENLBL3",26,0) D HOME^%ZIS U IO G SD1 "RTN","ENLBL3",27,0) ; "RTN","ENLBL3",28,0) CAT ;Complete Equip Category "RTN","ENLBL3",29,0) S ENERR=0 D STA G:ENEQSTA="^" QUIT "RTN","ENLBL3",30,0) N DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1 "RTN","ENLBL3",31,0) D EN^ENLBL9 G:$D(DIRUT) EXIT1^ENLBL8 "RTN","ENLBL3",32,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL3",33,0) K ENEQDA "RTN","ENLBL3",34,0) CAT1 S DIC="^ENG(6911,",DIC(0)="AEMQ" D ^DIC "RTN","ENLBL3",35,0) I Y'>0 G EXIT1^ENLBL8 "RTN","ENLBL3",36,0) S ENEQDA=+Y "RTN","ENLBL3",37,0) S ENLOCSRT=1 "RTN","ENLBL3",38,0) CAT11 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 CAT11 "RTN","ENLBL3",39,0) S:%=2 ENLOCSRT=0 "RTN","ENLBL3",40,0) S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL3",41,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL3",42,0) 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") "RTN","ENLBL3",43,0) I $D(IO("Q")) S ZTIO=ION,ZTRTN="CAT2^ENLBL3",ZTSAVE("EN*")="",ZTDESC="Barcode Labels by CATEGORY" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^ENLBL8 "RTN","ENLBL3",44,0) ;HD308658 "RTN","ENLBL3",45,0) CAT2 G:'$D(^ENG(6911,ENEQDA,0)) EXIT1^ENLBL8 S ENEQBY="Equip Cat: "_$P(^ENG(6911,ENEQDA,0),U,1),ENBCIO=IO "RTN","ENLBL3",46,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL3",47,0) K ^TMP($J) S I1=0 F J1=0:0 S I1=$O(^ENG(6914,"G",ENEQDA,I1)) Q:I1'>0 S DA=I1 D STATCK I DA]"" D SORT D:'(DA#10) DOTS "RTN","ENLBL3",48,0) I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F J1=0:0 S I1=$O(^TMP($J,I1)) Q:I1="" F DA=0:0 S DA=$O(^TMP($J,I1,DA)) Q:DA'>0 U ENBCIO D NXPRT^ENLBL7 D:$D(ENEQIO) CPRNT^ENLBL9 D:'(DA#10) DOTS D BCDT^ENLBL7 "RTN","ENLBL3",49,0) G EXIT^ENLBL8 "RTN","ENLBL3",50,0) ; "RTN","ENLBL3",51,0) SORT I 'ENLOCSRT S ^TMP($J,DA,DA)="" Q "RTN","ENLBL3",52,0) S X=$S($D(^ENG(6914,DA,3)):$P(^(3),U,5),1:0) S:X="" X=0 "RTN","ENLBL3",53,0) G:X=0 SORT1 "RTN","ENLBL3",54,0) I X=+X,$D(^ENG("SP",X,0)) D G SORT1 "RTN","ENLBL3",55,0) . I $D(^ENG("SP",X,9)) S X(0)=$P(^(9),U) I X(0)]"" S X=X(0) Q "RTN","ENLBL3",56,0) . S X=$P(^ENG("SP",X,0),U) F I=1,2,3 S X(I)=$P(X,"-",I) "RTN","ENLBL3",57,0) . S X=X(3)_":"_X(2)_":"_X(1) "RTN","ENLBL3",58,0) F I=1,2,3 S X(I)=$P(X,"-",I) "RTN","ENLBL3",59,0) S X=X(3)_":"_X(2)_":"_X(1) "RTN","ENLBL3",60,0) SORT1 S ^TMP($J,X,DA)="" "RTN","ENLBL3",61,0) Q "RTN","ENLBL3",62,0) ; "RTN","ENLBL3",63,0) STATCK S:'$D(^ENG(6914,DA,0)) DA="" I DA]"" S ENA=$G(^(3)) D:ENA]"" Q "RTN","ENLBL3",64,0) . I $P(ENA,U)>3,$P(ENA,U)<6 S DA="" Q "RTN","ENLBL3",65,0) . I $G(ENEQREP),$P(ENA,U,10)]"" S DA="" "RTN","ENLBL3",66,0) ; "RTN","ENLBL3",67,0) STA I $D(^DIC(6910,1,0)),$P(^(0),U,2)]"" S ENEQSTA=$P(^(0),U,2) "RTN","ENLBL3",68,0) E S ENEQSTA="^" "RTN","ENLBL3",69,0) I ENEQSTA'="^" S ENEQSTAN="DVAMC "_$P(^DIC(6910,1,0),U),ENEQLM=(135+(4*$L(ENEQSTAN))) "RTN","ENLBL3",70,0) Q "RTN","ENLBL3",71,0) ; "RTN","ENLBL3",72,0) DOTS ;Act indic "RTN","ENLBL3",73,0) Q:$D(ZTQUEUED) "RTN","ENLBL3",74,0) I '$D(ENEQIO) U IO(0) W "." Q "RTN","ENLBL3",75,0) I ENEQIO'=IO(0) U IO(0) W "." "RTN","ENLBL3",76,0) Q "RTN","ENLBL3",77,0) ; "RTN","ENLBL3",78,0) HOLD W !,"Press to continue..." R X:DTIME "RTN","ENLBL3",79,0) Q "RTN","ENLBL3",80,0) ; "RTN","ENLBL3",81,0) QUIT I $D(ENEQSTA),ENEQSTA="^" W !!,"Can't seem to find your Station Number. Please check File 6910 (ENG INIT",!,"PARAMETERS).",*7 "RTN","ENLBL3",82,0) G EXIT1^ENLBL8 "RTN","ENLBL3",83,0) ;ENLBL3 "RTN","ENLBL4") 0^2^B26614374^B26211960 "RTN","ENLBL4",1,0) ENLBL4 ;(WASH ISC)/DH-Print Bar Coded Location Labels ;10.10.97 "RTN","ENLBL4",2,0) ;;7.0;ENGINEERING;**12,35,42,45,90**;Aug 17, 1993;Build 25 "RTN","ENLBL4",3,0) WING ;Print an entire WING from Space File (6928) "RTN","ENLBL4",4,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL4",5,0) N DIC,DIE,DA,DR,FR,TO,X,X1,X2,I,J,K,I1 "RTN","ENLBL4",6,0) W @IOF R !!,"Select WING: ",X:DTIME G:X="^"!(X="") EXIT1^ENLBL8 I "?"[X D WHELP1^ENLBL8 "RTN","ENLBL4",7,0) I X["??" D WHELP2^ENLBL8 "RTN","ENLBL4",8,0) I X]"",$D(^ENG("SP","C",X)) D WING1 G EXIT1^ENLBL8 "RTN","ENLBL4",9,0) I X]"" W " ??",!,*7,"Invalid entry. Press to continue, '^' to exit, or ""?"" for help..." R X:DTIME D:X["?" WHELP1^ENLBL8 G:X="^" EXIT1^ENLBL8 "RTN","ENLBL4",10,0) S X="" G WING "RTN","ENLBL4",11,0) WING1 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 "RTN","ENLBL4",12,0) K IO("Q") S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8 "RTN","ENLBL4",13,0) 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") "RTN","ENLBL4",14,0) 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 "RTN","ENLBL4",15,0) WING2 K ^TMP($J) S ENBCIO=IO U ENBCIO D FORMAT ;HD308658 "RTN","ENLBL4",16,0) 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 "RTN","ENLBL4",17,0) 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 "RTN","ENLBL4",18,0) Q "RTN","ENLBL4",19,0) ; "RTN","ENLBL4",20,0) BLDG ;Print labels for all rooms in specified building "RTN","ENLBL4",21,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL4",22,0) N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1 "RTN","ENLBL4",23,0) 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) "RTN","ENLBL4",24,0) S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" K IO("Q") D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8 "RTN","ENLBL4",25,0) 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") "RTN","ENLBL4",26,0) 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 "RTN","ENLBL4",27,0) BLDG1 K ^TMP($J) S ENBCIO=IO ;HD308658 "RTN","ENLBL4",28,0) F DA=0:0 S DA=$O(^ENG("SP","E",ENBLDG,DA)) Q:DA'>0 D CKDIV D:'(+DA#20) DOTS^ENLBL3 "RTN","ENLBL4",29,0) I $D(^TMP($J)) D "RTN","ENLBL4",30,0) . U ENBCIO D FORMAT "RTN","ENLBL4",31,0) . 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 "RTN","ENLBL4",32,0) G EXIT1^ENLBL8 "RTN","ENLBL4",33,0) CKDIV Q:'$D(^ENG("SP",DA,0)) S ENEQB=$P(^(0),U,1) I $D(ENDIV),$P(ENEQB,"-",3)'=ENDIV Q "RTN","ENLBL4",34,0) D SORT "RTN","ENLBL4",35,0) Q "RTN","ENLBL4",36,0) ; "RTN","ENLBL4",37,0) RM ;Print a single room label "RTN","ENLBL4",38,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL4",39,0) N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1 "RTN","ENLBL4",40,0) RM0 S DIC="^ENG(""SP"",",DIC(0)="AEQMZ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQB=Y(0,0),DA=+Y "RTN","ENLBL4",41,0) K IO("Q") S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS="Q",%ZIS("B")="" D ^%ZIS K %ZIS("A"),%ZIS("B") G:POP EXIT1^ENLBL8 "RTN","ENLBL4",42,0) 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") "RTN","ENLBL4",43,0) 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 "RTN","ENLBL4",44,0) RM1 S ENBCIO=IO U ENBCIO D FORMAT ;HD308658 "RTN","ENLBL4",45,0) D LOCPRT "RTN","ENLBL4",46,0) G:$D(ZTQUEUED) EXIT1^ENLBL8 "RTN","ENLBL4",47,0) D ^%ZISC G RM0 "RTN","ENLBL4",48,0) ; "RTN","ENLBL4",49,0) ALL ;Print a location label for every record in the SPACE file "RTN","ENLBL4",50,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL4",51,0) N DIC,DIE,DA,DR,X,X1,X2,I,J,K,I1 "RTN","ENLBL4",52,0) K IO("Q") S %ZIS="Q",%ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="" D ^%ZIS K %ZIS("A") G:POP EXIT1^ENLBL8 "RTN","ENLBL4",53,0) 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") "RTN","ENLBL4",54,0) 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 "RTN","ENLBL4",55,0) ALL1 K ^TMP($J) S ENBCIO=IO U ENBCIO D FORMAT ;HD308658 "RTN","ENLBL4",56,0) 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 "RTN","ENLBL4",57,0) 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 "RTN","ENLBL4",58,0) G EXIT1^ENLBL8 "RTN","ENLBL4",59,0) ; "RTN","ENLBL4",60,0) SORT I $D(ENEQC("FR")) I ENEQC("FR")]ENEQB!(ENEQB]ENEQC("TO")) Q "RTN","ENLBL4",61,0) I $D(^ENG("SP",DA,9)) S X=$P(^(9),U),^TMP($J,X,DA)=ENEQB Q "RTN","ENLBL4",62,0) F I=1:1:3 S X(I)=$P(ENEQB,"-",I) "RTN","ENLBL4",63,0) S X=X(3)_":"_X(2)_":"_X(1),^TMP($J,X,DA)=ENEQB "RTN","ENLBL4",64,0) Q "RTN","ENLBL4",65,0) ; "RTN","ENLBL4",66,0) LOCPRT ;Actual print "RTN","ENLBL4",67,0) I ENEQB["e" S ENEQB=$TR(ENEQB,"e","E") "RTN","ENLBL4",68,0) I ENEQB'?.NUP D WARN^ENLBL8 Q "RTN","ENLBL4",69,0) S ENEQBC="SP"_ENEQB "RTN","ENLBL4",70,0) I ENBAR("LOCATION DATA")]"" X ENBAR("LOCATION DATA") Q "RTN","ENLBL4",71,0) W *2,*27,"E3",!,*24 "RTN","ENLBL4",72,0) 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) "RTN","ENLBL4",73,0) W ENX,!,ENEQBC,!,ENEQSTAN "RTN","ENLBL4",74,0) W *23,*3 "RTN","ENLBL4",75,0) Q "RTN","ENLBL4",76,0) ; "RTN","ENLBL4",77,0) FORMAT ;Location labels "RTN","ENLBL4",78,0) K ENBAR S (ENBAR("LOCATION FORMAT"),ENBAR("LOCATION DATA"))="" "RTN","ENLBL4",79,0) S ENBCIOS(0)=$O(^DIC(6910.1,"B",ENBCIOS,0)) D:ENBCIOS(0) "RTN","ENLBL4",80,0) . S ENBAR("LOCATION FORMAT")=$G(^DIC(6910.1,ENBCIOS(0),2)) "RTN","ENLBL4",81,0) . S ENBAR("LOCATION DATA")=$G(^DIC(6910.1,ENBCIOS(0),4)) "RTN","ENLBL4",82,0) I ENBAR("LOCATION FORMAT")]"" X ENBAR("LOCATION FORMAT") Q "RTN","ENLBL4",83,0) D FORMAT1^ENLBL7 "RTN","ENLBL4",84,0) Q "RTN","ENLBL4",85,0) ;ENLBL4 "RTN","ENLBL5") 0^3^B19840430^B19602915 "RTN","ENLBL5",1,0) ENLBL5 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97 "RTN","ENLBL5",2,0) ;;7.0;ENGINEERING;**12,16,35,45,90**;Aug 17, 1993;Build 25 "RTN","ENLBL5",3,0) CMR ;Complete CMR "RTN","ENLBL5",4,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL5",5,0) D EN^ENLBL9 G:$D(DIRUT) EXIT1^ENLBL8 "RTN","ENLBL5",6,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL5",7,0) S ENLOCSRT=1 "RTN","ENLBL5",8,0) CMR1 S DIC="^ENG(6914.1,",DIC(0)="AEMQ" D ^DIC G:Y'>0 EXIT1^ENLBL8 S ENEQDA=+Y "RTN","ENLBL5",9,0) CMR11 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 "RTN","ENLBL5",10,0) I %=0 W !,"Say YES to sort labels by DIVISION, BUILDING, and then by ROOM.",!,"If you say NO, labels will be sorted by Category Stock Number." G CMR11 "RTN","ENLBL5",11,0) S:%=2 ENLOCSRT=0 "RTN","ENLBL5",12,0) S %ZIS("A")="Select BARCODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL5",13,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL5",14,0) 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") "RTN","ENLBL5",15,0) I $D(IO("Q")) S ZTIO=ION,ZTRTN="CMR2^ENLBL5",ZTSAVE("EN*")="",ZTDESC="Barcode Labels by CMR" D ^%ZTLOAD K ZTSK,IO("Q") G EXIT1^ENLBL8 "RTN","ENLBL5",16,0) CMR2 S ENEQBY="CMR "_$P(^ENG(6914.1,ENEQDA,0),U,1),ENBCIO=IO ;HD308658 "RTN","ENLBL5",17,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL5",18,0) K ^TMP($J) F I1=0:0 S I1=$O(^ENG(6914,"AD",ENEQDA,I1)) Q:I1'>0 S DA=I1 D STATCK^ENLBL3 I DA]"" D CMRSRT D:'(DA#10) DOTS^ENLBL3 "RTN","ENLBL5",19,0) I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F J1=0:0 S I1=$O(^TMP($J,I1)) Q:I1="" F DA=0:0 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 "RTN","ENLBL5",20,0) G EXIT^ENLBL8 "RTN","ENLBL5",21,0) ; "RTN","ENLBL5",22,0) CMRSRT I ENLOCSRT=1 D SORT^ENLBL3 Q "RTN","ENLBL5",23,0) S X=$$GET1^DIQ(6914,DA,18) S:X="" X=0 "RTN","ENLBL5",24,0) S ^TMP($J,X,DA)="" "RTN","ENLBL5",25,0) Q "RTN","ENLBL5",26,0) ; "RTN","ENLBL5",27,0) ALL ;By Equipment ID "RTN","ENLBL5",28,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL5",29,0) D EN^ENLBL9 G:$D(DIRUT) EXIT1^ENLBL8 "RTN","ENLBL5",30,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL5",31,0) ALL1 K ENFR,ENTO W !!,"Would you like to specify a range of entries" S %=1 D YN^DICN G:%=2 ALL2 G:%<0 EXIT1^ENLBL8 I %<1 W *7 G ALL1 "RTN","ENLBL5",32,0) S DIC="^ENG(6914,",DIC(0)="AEQN",D="B",DIC("A")="Starting with: " D IX^DIC G:Y'>0 EXIT1^ENLBL8 S ENFR=+Y "RTN","ENLBL5",33,0) S D="B",DIC("A")="And ending with: ",DIC("S")="I +Y>ENFR" D IX^DIC K DIC("S") G:Y'>0 EXIT1^ENLBL8 S ENTO=+Y "RTN","ENLBL5",34,0) ALL2 I '$D(ENFR) W !,"You have chosen to print labels for the ENTIRE Equipment File.",!,"(All "_$P(^ENG(6914,0),U,3)_" entries.)" "RTN","ENLBL5",35,0) S ENLOCSRT=1 "RTN","ENLBL5",36,0) ALL21 W !,"Sort labels by LOCATION" S %=1 D YN^DICN G:%<0 EXIT1^ENLBL8 "RTN","ENLBL5",37,0) 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 ALL21 "RTN","ENLBL5",38,0) S:%=2 ENLOCSRT=0 "RTN","ENLBL5",39,0) S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL5",40,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL5",41,0) 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") "RTN","ENLBL5",42,0) I $D(IO("Q")) K IO("Q") S ZTIO=ION,ZTRTN="ALL3^ENLBL5",ZTSAVE("EN*")="",ZTDESC="All Equipment Labels (Bar Code)" D ^%ZTLOAD K ZTSK G EXIT1^ENLBL8 "RTN","ENLBL5",43,0) ;HD308658 "RTN","ENLBL5",44,0) ALL3 S ENEQBY=$S($D(ENFR):"Equipment ID#: "_ENFR_" to "_ENTO,1:"ENTIRE EQUIPMENT FILE"),ENBCIO=IO "RTN","ENLBL5",45,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL5",46,0) K ^TMP($J) S ENDA=$S($D(ENFR):ENFR,1:$O(^ENG(6914,0))) "RTN","ENLBL5",47,0) ALL4 S DA=ENDA D STATCK^ENLBL3 I DA]"" D SORT^ENLBL3 D:'(DA#10) DOTS^ENLBL3 "RTN","ENLBL5",48,0) S ENDA=$O(^ENG(6914,ENDA)) I $D(ENTO),ENDA=+ENDA,ENDA'>ENTO G ALL4 "RTN","ENLBL5",49,0) I ENDA=+ENDA,'$D(ENTO) G ALL4 "RTN","ENLBL5",50,0) I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1="" F J1=0:0 S I1=$O(^TMP($J,I1)) Q:I1="" F DA=0:0 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 "RTN","ENLBL5",51,0) G EXIT^ENLBL8 "RTN","ENLBL5",52,0) ; "RTN","ENLBL5",53,0) HOLD W !,"Press to continue..." R X:DTIME "RTN","ENLBL5",54,0) Q "RTN","ENLBL5",55,0) ;ENLBL5 "RTN","ENLBL6") 0^4^B21556376^B21325158 "RTN","ENLBL6",1,0) ENLBL6 ;(WASH ISC)/DH-Print Bar Coded Equipment Labels ;10.10.97 "RTN","ENLBL6",2,0) ;;7.0;ENGINEERING;**12,35,45,90**;Aug 17, 1993;Build 25 "RTN","ENLBL6",3,0) WING ;General location (Space File WING) "RTN","ENLBL6",4,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL6",5,0) WING1 S X="" R !,"Enter WING: ",X:DTIME G:X=""!(X="^") EXIT1^ENLBL8 I $E(X)="?" D HWING G WING1 "RTN","ENLBL6",6,0) I $D(^ENG("SP","C",X)) G WB "RTN","ENLBL6",7,0) S X1=$O(^ENG("SP","C",X)),X2=$L(X) I $E(X1,1,X2)'=X S X="" "RTN","ENLBL6",8,0) I X]"" D "RTN","ENLBL6",9,0) . I $E($O(^ENG("SP","C",X1)),1,X2)'=X S X=X1 Q "RTN","ENLBL6",10,0) . S DIC="^ENG(""SP"",",ENDX="C" D IX^ENLIB1 "RTN","ENLBL6",11,0) I X="" W !!,*7,"Sorry, no such WING. Please try again or enter '^' to exit.",! G WING1 "RTN","ENLBL6",12,0) WB ; More than 1 BUILDING? "RTN","ENLBL6",13,0) 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))="" "RTN","ENLBL6",14,0) WB1 S X=$O(X(0)) I $O(X(X))="" S ENBLDG="ALL" "RTN","ENLBL6",15,0) E D G:X="^" EXIT1^ENLBL8 I ENBLDG'="ALL",'$D(X(ENBLDG)) G WB1 "RTN","ENLBL6",16,0) . W !,"Please select a BUILDING." "RTN","ENLBL6",17,0) . W !,?5,"Choices are: " S X=0 F S X=$O(X(X)) Q:X']"" W X_", " W:(IOM-$X)'>15 !,?5 "RTN","ENLBL6",18,0) . W "or ALL." "RTN","ENLBL6",19,0) . R !,?5,"BUILDING: ALL// ",X:DTIME I '$T!(X="^") S X="^" Q "RTN","ENLBL6",20,0) . I X=""!(X="ALL") S ENBLDG="ALL" Q "RTN","ENLBL6",21,0) . S ENBLDG=X "RTN","ENLBL6",22,0) WING11 S (ENFLG,ENROOM)=0 F S ENROOM=$O(^ENG("SP","C",ENWNG,ENROOM)) Q:ENFLG!(ENROOM="") D "RTN","ENLBL6",23,0) . I ENBLDG="ALL",$D(^ENG(6914,"D",ENROOM)) S ENFLG=1 Q "RTN","ENLBL6",24,0) . I $P($G(^ENG("SP",ENROOM,0)),U,2)=ENBLDG,$D(^ENG(6914,"D",ENROOM)) S ENFLG=1 "RTN","ENLBL6",25,0) I 'ENFLG W !!,*7,"There does not appear to be any equipment located on this WING",!,"(",ENWNG,"). Nothing to print.",!! G WING1 "RTN","ENLBL6",26,0) D EN^ENLBL9 G:$D(DIRUT) EXIT^ENLBL8 "RTN","ENLBL6",27,0) I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL6",28,0) S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL6",29,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL6",30,0) 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") "RTN","ENLBL6",31,0) 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 "RTN","ENLBL6",32,0) WING2 S ENEQBY="WING "_ENWNG,ENLOCSRT=1,ENBCIO=IO ;HD308658 "RTN","ENLBL6",33,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL6",34,0) 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 "RTN","ENLBL6",35,0) . 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 "RTN","ENLBL6",36,0) I $D(^TMP($J)) U ENBCIO D FORMAT^ENLBL7 S I1=0 F S I1=$O(^TMP($J,I1)) Q:I1="" D "RTN","ENLBL6",37,0) . 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 "RTN","ENLBL6",38,0) G EXIT^ENLBL8 "RTN","ENLBL6",39,0) ; "RTN","ENLBL6",40,0) HWING S X="" W !,"Enter WING as defined in Space File. Would you like a list" S %=2 D YN^DICN Q:%'=1 "RTN","ENLBL6",41,0) 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 "RTN","ENLBL6",42,0) S X="" Q "RTN","ENLBL6",43,0) HWING2 S ENY=0 W !,"Press to continue or ""^"" to escape..." R X:DTIME S:X="^" I="^" "RTN","ENLBL6",44,0) Q "RTN","ENLBL6",45,0) RM ;Single room (from Space File) "RTN","ENLBL6",46,0) S ENERR=0 D STA^ENLBL3 G:ENEQSTA="^" QUIT^ENLBL3 "RTN","ENLBL6",47,0) RM1 S DIC="^ENG(""SP"",",DIC(0)="AEQM" D ^DIC "RTN","ENLBL6",48,0) I Y'>0 G EXIT1^ENLBL8 "RTN","ENLBL6",49,0) S ENROOM=+Y,ENROOM("TXT")=$P(^ENG("SP",ENROOM,0),U) "RTN","ENLBL6",50,0) I '$D(^ENG(6914,"D",ENROOM)) W !!,*7,"There does not appear to be any equipment in ",ENROOM("TXT"),".",!! K ENROOM G RM1 "RTN","ENLBL6",51,0) D EN^ENLBL9 I '$D(ENEQIO),%<0 G EXIT1^ENLBL8 "RTN","ENLBL6",52,0) S %ZIS("A")="Select BAR CODE PRINTER: ",%ZIS("B")="",%ZIS="Q" I $D(ENEQIO),ENEQIO=IO S %ZIS="" "RTN","ENLBL6",53,0) K IO("Q") D ^%ZIS K %ZIS G:POP EXIT1^ENLBL8 "RTN","ENLBL6",54,0) 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") "RTN","ENLBL6",55,0) 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 "RTN","ENLBL6",56,0) RM2 S ENEQBY="Room "_ENROOM("TXT"),ENBCIO=IO ;HD308658 "RTN","ENLBL6",57,0) I $D(ENEQIO) D OPEN^ENLBL9 I POP G:$D(ZTQUEUED) REQ^ENLBL8 W !,*7,"Companion Printer UNAVAILABLE." D HOLD G EXIT1^ENLBL8 "RTN","ENLBL6",58,0) 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 "RTN","ENLBL6",59,0) G EXIT^ENLBL8 "RTN","ENLBL6",60,0) ; "RTN","ENLBL6",61,0) HOLD W !,"Press to continue..." R X:DTIME "RTN","ENLBL6",62,0) Q "RTN","ENLBL6",63,0) ; "RTN","ENLBL6",64,0) ;ENLBL6 "RTN","ENLBL9") 0^9^B16770608^B16569946 "RTN","ENLBL9",1,0) ENLBL9 ;(WASH ISC)/DH-Companion Listing for Equipment Labels ;11.27.96 "RTN","ENLBL9",2,0) ;;7.0;ENGINEERING;**12,35,80,90**;Aug 17, 1993;Build 25 "RTN","ENLBL9",3,0) ; Print companion list (if desired) "RTN","ENLBL9",4,0) ; Also asks if previously printed labels should be reprinted "RTN","ENLBL9",5,0) EN S DIR(0)="Y",DIR("A")="New labels only",DIR("B")="YES" "RTN","ENLBL9",6,0) S DIR("?",1)="The system records the printing of equipment bar code labels. If you do not" "RTN","ENLBL9",7,0) S DIR("?",2)="wish to have labels printed again if they have already been printed at least" "RTN","ENLBL9",8,0) S DIR("?")="once, please enter 'YES' at this time." "RTN","ENLBL9",9,0) D ^DIR K DIR Q:$D(DIRUT) "RTN","ENLBL9",10,0) S ENEQREP=+Y "RTN","ENLBL9",11,0) EN1 K ENEQIO W !,"Would you like a companion listing for this set of labels" S %=1 D YN^DICN Q:%=2!(%<0) I %<1 D HLP G EN "RTN","ENLBL9",12,0) S %ZIS("A")="Select PRINTER for Companion Listing: ",%ZIS="NQ",%ZIS("B")="" D ^%ZIS K %ZIS I POP D ERR G EN "RTN","ENLBL9",13,0) I IOM<80 D HOME^%ZIS W !,*7,"Device selected must have a MARGIN WIDTH of at least 80 char.",!! G EN "RTN","ENLBL9",14,0) I $E(^%ZOSF("OS"),1,3)="MSM",IO=IO(0) D ^%ZISC W !,*7,"MSM sites may not send Companion List to HOME device.",!! G EN "RTN","ENLBL9",15,0) S ENEQIO=IO,ENEQIOSL=IOSL,ENEQIOF=IOF,ENEQION=ION,ENEQIOST=IOST,ENEQIOST(0)=IOST(0),ENEQPG=0,ENEQY=0 S:$D(IO("S")) ENEQIO("S")=IO("S") S X="N",%DT="T" D ^%DT X ^DD("DD") S ENEQDATE=Y,ENHDMRGN=79-$L(ENEQDATE) "RTN","ENLBL9",16,0) D HOME^%ZIS "RTN","ENLBL9",17,0) I $D(DUZ),$D(^VA(200,DUZ,0)) S ENEQUSER=$P(^(0),U) "RTN","ENLBL9",18,0) E S ENEQUSER="" "RTN","ENLBL9",19,0) Q "RTN","ENLBL9",20,0) ; "RTN","ENLBL9",21,0) CPRNT ;I $D(^ENG(6914,DA,3)),$P(^(3),U,10)]"" Q ;Suppress if already printed "RTN","ENLBL9",22,0) ;I $F(ENEQIO,"/") S ENEQIO=$P(ENEQIO,"/",$L(ENEQIO,"/")) "RTN","ENLBL9",23,0) U ENEQIO I ENEQY=0!((ENEQIOSL-ENEQY)<8) D CHDR "RTN","ENLBL9",24,0) K EN S (ENMAN,ENMOD,ENSN,ENCAT,ENUSE,ENSER,ENLOC,ENPMN)="",ENMEN=$P(^ENG(6914,DA,0),U,2) S:$D(^ENG(6914,DA,1)) EN(1)=^(1) S:$D(^(3)) EN(3)=^(3) "RTN","ENLBL9",25,0) I $D(EN(1)) S ENMAN=$P(EN(1),U,4),ENMOD=$P(EN(1),U,2),ENSN=$P(EN(1),U,3),ENCAT=$P(EN(1),U,1) "RTN","ENLBL9",26,0) S:ENMAN]"" ENMAN=$P(^ENG("MFG",ENMAN,0),U,1) S:ENCAT]"" ENCAT=$P(^ENG(6911,ENCAT,0),U,1) "RTN","ENLBL9",27,0) I $D(EN(3)) S ENUSE=$P(EN(3),U,1),ENSER=$P(EN(3),U,2),ENLOC=$P(EN(3),U,5),ENPMN=$P(EN(3),U,6) S:ENUSE]"" ENUSE=$P($P(^DD(6914,20,0),U,3),";",ENUSE) I ENSER]"",$D(^DIC(49,ENSER)) S ENSER=$P(^DIC(49,ENSER,0),U,1) "RTN","ENLBL9",28,0) I ENLOC=+ENLOC,$D(^ENG("SP",ENLOC,0)) S ENLOC=$P(^(0),U) "RTN","ENLBL9",29,0) W !!,DA,?15,$E(ENMEN,1,60),!,?5,"Man: ",$E(ENMAN,1,30),?40,"Cat: ",$E(ENCAT,1,35) "RTN","ENLBL9",30,0) W !,?5,"Model: ",$E(ENMOD,1,28),?40,"S/N: ",$E(ENSN,1,35),!,?5,"Servc: ",$E(ENSER,1,28),?40,"Status: ",$P(ENUSE,":",2),!,?5,"Location: ",$E(ENLOC,1,25),?40,"PM#: ",ENPMN "RTN","ENLBL9",31,0) S ENEQY=ENEQY+6 K EN "RTN","ENLBL9",32,0) D:$O(^DIC(6910,1,2,0))]"" LOC1^ENLBL16 "RTN","ENLBL9",33,0) Q "RTN","ENLBL9",34,0) CHDR W:ENEQPG @ENEQIOF S ENEQPG=ENEQPG+1 W "COMPANION LISTING (Bar Code Labels)",?ENHDMRGN,"Page ",ENEQPG "RTN","ENLBL9",35,0) W !,ENEQBY W:$L(ENEQBY)<41 " (",$S(ENEQUSER]"":$E(ENEQUSER,1,20),1:"User unknown"),")" W ?ENHDMRGN,ENEQDATE,!,"Equip ID",?15,"* Description *" "RTN","ENLBL9",36,0) S X="",$P(X,"-",80)="-" W !,X "RTN","ENLBL9",37,0) S ENEQY=0 "RTN","ENLBL9",38,0) Q "RTN","ENLBL9",39,0) HLP W !!,"A 'companion listing' is simply a printout on regular paper (must be at",!,"least 80 columns wide) that is intended for use in the initial application" "RTN","ENLBL9",40,0) W !,"of the actual bar code labels to individual equipment items. The companion",!,"listing will contain more descriptive information than can be printed" "RTN","ENLBL9",41,0) W !,"on the labels themselves, and will be sorted in the same order as the",!,"labels." "RTN","ENLBL9",42,0) Q "RTN","ENLBL9",43,0) OPEN ; "RTN","ENLBL9",44,0) S IOP=ENEQION D ^%ZIS K IOP "RTN","ENLBL9",45,0) S ENEQIO=IO ;HD308658 "RTN","ENLBL9",46,0) Q "RTN","ENLBL9",47,0) ERR W !,*7,"Device selection unsuccessful.",! "RTN","ENLBL9",48,0) Q "RTN","ENLBL9",49,0) ;ENLBL9 "VER") 8.0^22.0 "BLD",8239,6) ^85 **END** **END**