source: FOIAVistA/tag/r/ENGINEERING-EN/ENY2K3.m@ 668

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

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1ENY2K3 ;(WASH ISC)/DH-Select Equipment for Y2K Worklist ;5.19.98
2 ;;7.0;ENGINEERING;**51**;Aug 17, 1993
3 ; called by ENY2K2
4ENTRY ; select IENs for Y2K worklist
5 ; store in ^TMP($J,
6 K ^TMP($J) N NODE,SUB
7 S X=$$UP^XLFSTR($E($P($G(^DIC(6922,35,0)),U),1,10)) I X["BIO" S ENY2K("BME")=35
8 I '$G(ENY2K("BME")) D
9 . S DA=0 F S DA=$O(^DIC(6922,DA)) Q:'DA!($G(ENY2K("BME"))) S X=$$UP^XLFSTR($E($P(^(DA,0),U),1,10)) I X["BIO" S ENY2K("BME")=DA
10 I '$G(ENY2K("BME")) W !!,"Cannot find the BIOMEDICAL ENGINEERING shop. Can't proceed.",*7 G OUT
11 S ENSHKEY("SEL")=ENSHKEY
12 I ENSHKEY'="ALL" D
13 . S DA=0 F S DA=$O(^ENG(6914,"AK","CC",DA)) Q:'DA D
14 .. Q:'$D(^ENG(6914,DA,11)) S X=^(11)
15 .. Q:$P(X,U,2)>ENY2DT ;check estimated compliance date
16 .. I $P(X,U,7)=ENSHKEY S ^TMP($J,ENSHKEY,DA)="" Q
17 .. I $P(X,U,7)="" D
18 ... S X(1)=$O(^ENG(6914,DA,4,0)) I X(1)>0 S X(2)=$P(^(X(1),0),U) S:X(2)=ENSHKEY ^TMP($J,ENSHKEY,DA)="" Q
19 ... I ENSHKEY=ENY2K("BME") S ^TMP($J,ENSHKEY,DA)=""
20 I ENSHKEY="ALL" D
21 . S DA=0 F S DA=$O(^ENG(6914,"AK","CC",DA)) Q:'DA D
22 .. Q:'$D(^ENG(6914,DA,11)) S X=^(11)
23 .. Q:$P(X,U,2)>ENY2DT ;check estimated compliance date
24 .. I $P(X,U,7) S ^TMP($J,$P(X,U,7),DA)="" Q
25 .. S X(1)=$O(^ENG(6914,DA,4,0)) I X(1)>0 S X(2)=$P(^(X(1),0),U),^TMP($J,X(2),DA)="" Q
26 .. S ^TMP($J,ENY2K("BME"),DA)=""
27 D LST2,PR^ENY2K5
28 G OUT
29 ;
30LST2 N EN,A,B,C,X,TAG
31 S ENSHKEY=0 F S ENSHKEY=$O(^TMP($J,ENSHKEY)) Q:'ENSHKEY S DA=0 F S DA=$O(^TMP($J,ENSHKEY,DA)) Q:'DA D LST3
32 Q
33 ;
34LST3 S X=$P($G(^ENG(6914,DA,3)),U) I "^4^5^"[(U_X_U) Q ;check use status
35 I 'ENSRT("OOS"),X=2 Q ;is OUT OF SERVICE an issue?
36 S EN("NEXT")="A" F X="A","B","C" S @X=""
37 I 'ENTECH("ALL"),$P(^ENG(6914,DA,11),U,5)'=ENTECH Q ;check for assigned tech
38 S X=$P(^ENG(6914,DA,11),U,5) I X>0 D
39 . I $D(^ENG("EMP",X,0)) S X(1)=""""_$P(^(0),U)_"""" Q
40 . S X(1)=""""_"DELETED"_""""
41 I X'>0 S X(1)=""""_"UNASSIGNED"_""""
42 S @EN("NEXT")=X(1)
43 S EN("NEXT")=$C($A(EN("NEXT"))+1)
44 S TAG="LST"_ENSRT D @TAG Q:$G(X)=-1
45 S SUB="" F X(1)="A","B","C" Q:$G(@X(1))="" S SUB=SUB_@X(1)_","
46 D BLD
47 Q
48 ;
49LSTE ; By ENTRY NUMBER
50 I ENSRT("ALL") Q
51 I ENSRT("FR")]DA!(DA]ENSRT("TO")) S X=-1
52 Q
53LSTP ; By PM NUMBER
54 S X(1)=$P($G(^ENG(6914,DA,3)),U,6) S:X(1)="" X(1)=0
55 S:X(1)'=0 X(1)=""""_X(1)_""""
56 S @EN("NEXT")=X(1)
57 Q
58LSTI ; By LOCAL ID
59 S X(1)=$P($G(^ENG(6914,DA,3)),U,7) S:X(1)="" X(1)=0
60 S X(2)=$S(X(1)?.N:X(1),1:""""_X(1)_"""")
61 I ENSRT("ALL") S @EN("NEXT")=X(2),EN("NEXT")=$C($A(EN("NEXT"))+1)
62 E S X="" D
63 . I ENSRT("FR")]X(1)!(X(1)]ENSRT("TO")) S X=-1 Q
64 . S @EN("NEXT")=X(2),EN("NEXT")=$C($A(EN("NEXT"))+1)
65 I ENSRT("LOC"),$G(X)'=-1 D
66 . S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
67 . I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
68 .. S X(1)=""""_$P(X(1),U,2)_""""
69 .. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
70 . I $P(X(1),U)=-2 S X=-1 Q
71 . I X(1)=-3,ENSRT("LOC","ALL") D
72 .. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
73 . I X(1)=-3 S X=-1 Q
74 . S @EN("NEXT")=X(1)
75 Q
76LSTL ; By LOCATION
77 S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
78 I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
79 . S X(1)=""""_$P(X(1),U,2)_""""
80 . F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
81 I $P(X(1),U)=-2 S X=-1 Q
82 I X(1)=-3,ENSRT("LOC","ALL") D
83 . S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
84 I X(1)=-3 S X=-1 Q
85 S @EN("NEXT")=X(1)
86 Q
87LSTC ; By EQUIPMENT CATEGORY
88 S X(2)=$P($G(^ENG(6914,DA,1)),U) S:X(2)="" X(1)=0
89 I X(2)>0 S X(1)=$P($G(^ENG(6911,X(2),0)),U) S:X(1)="" X(1)=0
90 S:X(1)'?.N X(1)=""""_X(1)_""""
91 I 'ENSRT("ALL"),X(2)'=ENSRT("FR") S X=-1 Q
92 S @EN("NEXT")=X(1),EN("NEXT")=$C($A(EN("NEXT"))+1)
93 I ENSRT("LOC") D
94 . S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
95 . I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
96 .. S X(1)=""""_$P(X(1),U,2)_""""
97 .. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
98 . I $P(X(1),U)=-2 S X=-1 Q
99 . I X(1)=-3,ENSRT("LOC","ALL") D
100 .. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
101 . I X(1)=-3 S X=-1 Q
102 . S @EN("NEXT")=X(1)
103 Q
104LSTS ; By OWNING SERVICE
105 S X(2)=$P($G(^ENG(6914,DA,3)),U,2) S:X(2)="" X(1)=0
106 I X(2)>0 S X(1)=$P($G(^DIC(49,X(2),0)),U) S:X(1)="" X(1)=0
107 S:X(1)'?.N X(1)=""""_X(1)_""""
108 I 'ENSRT("ALL"),X(2)'=ENSRT("FR") S X=-1 Q
109 S @EN("NEXT")=X(1),EN("NEXT")=$C($A(EN("NEXT"))+1)
110 I ENSRT("LOC") D
111 . S X(1)=$$LOC^ENEQPMS8(DA) I X(1)=-1 S X=-1 Q
112 . I $P(X(1),U)=-2,ENSRT("LOC","ALL") D
113 .. S X(1)=""""_$P(X(1),U,2)_""""
114 .. F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
115 . I $P(X(1),U)=-2 S X=-1 Q
116 . I X(1)=-3,ENSRT("LOC","ALL") D
117 .. S X(1)=0 F J=1:1:($L(ENSRT("BY"))-1) S X(1)="0,"_X(1)
118 . I X(1)=-3 S X=-1 Q
119 . S @EN("NEXT")=X(1)
120 Q
121 ;
122BLD ; build ^TMP global from which to print Y2K worklist
123 S NODE="^TMP($J,""ENY2"","_ENSHKEY_","_SUB_DA_")"
124 S @NODE=""
125 Q
126 ;
127OUT K K,S,ENPM,ENPMDT,ENA,ENHZS,ENPMWK,ENSHOP,ENSHKEY,ENPMMN,ENSTMN,ENSTYR,ENCRIT,ENSRT,ENTECH,ENY,ENERR,ENMN,ENMNTH,ENI,ENLID
128 S:$D(ZTQUEUED) ZTREQ="@"
129 Q
130 ;ENY2K3
Note: See TracBrowser for help on using the repository browser.