source: FOIAVistA/trunk/r/ENGINEERING-EN/ENBCPM7.m@ 1582

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1ENBCPM7 ;(WASH ISC)/DH-Bar Coded PMI ;4.9.97
2 ;;7.0;ENGINEERING;**1,35**;Aug 17, 1993
3POST13 ; Device failed
4 N PROBLEM,NUMBER,WARD S PROBLEM="Device failed a PM Inspection"
5 S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
6 S ENX1=ENX+2,ENX=ENX+1,ENLKAHD=$S($D(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
7 S ENMSG="Equipment Entry # "_ENEQ_" FAILED PMI. CORRECTIVE ACTION REQUIRED."
8 S ENMSG(0,3)="NO STATEMENT OF PROBLEM."
9 S $P(^ENG(6920,DA,2),U,2)=ENTEC,$P(^(5),U,8)="C"
10 I '$D(^ENG(6920,DA,7)) S ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
11 S ^ENG(6920,DA,7,1,0)=ENTEC_"^^"_ENSHKEY
12 S EN2=0
13 I ENLKAHD]"",$E(ENLKAHD)'="*",$E(ENLKAHD,1,2)'="SP",$E(ENLKAHD,1,4)'="MOD:",$E(ENLKAHD,1,4)'="PM#:",$E(ENLKAHD,3,8)'[" EE" D Q:EN2
14 . S ENX=ENX1,ENMSG(0,3)="Problem description: "_ENLKAHD
15 . S PROBLEM=ENLKAHD
16 . S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
17 . S ENX1=ENX1+1
18 . S ENLKAHD=$S($D(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
19 . I $E(ENLKAHD,1,4)="TIME" S ENX=ENX+1 D
20 .. S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
21 .. S ENTIME=+$E(ENLKAHD,6,30) I ENTIME>0 D
22 ... S ENMSG(0,3)=ENMSG(0,3)_" (Time: "_ENTIME_" hrs)"
23 ... S X=ENTIME,X(0)=2 D ROUND^ENLIB S ENTIME=+Y S:ENTIME<0 ENTIME=0
24 ... S $P(^ENG(6920,DA,5),U,3)=ENTIME,$P(^(7,1,0),U,2)=ENTIME
25 ... S ENW=$P($G(^ENG("EMP",ENTEC,0)),U,3) I ENW="" S ENW=$P($G(^DIC(6910,1,0)),U,4)
26 ... I ENW>0 S $P(^ENG(6920,DA,5),U,6)=ENW*ENTIME
27 ... S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
28EXST F EN1=0:0 S EN1=$O(^ENG(6920,"G",ENEQ,EN1)) Q:EN2!(EN1'>0) D I EN2 D XCPTN^ENBCPM2 Q
29 . I $D(^ENG(6920,EN1,5)),$P(^(5),U,2)]"" Q
30 . I $E(^ENG(6920,EN1,0),1,3)="PM-" Q
31 . I $D(^ENG(6920,EN1,1)),$P(^(1),U)=.5 S EN2=1 D Q
32 .. S ENMSG(0,1)="PM work order "_$P(^ENG(6920,DA,0),U)_" is being closed."
33 .. S ENMSG(0,2)="Regular work order "_$P(^ENG(6920,EN1,0),U)_" is open."
34 .. N ENDA S ENDA=DA,NUMBER=$P(^ENG(6920,EN1,0),U)
35 .. D WOPOST
36 . I $D(^ENG(6920,EN1,2)),$P(^(2),U)=ENSHKEY S EN2=1 D Q
37 .. N X S:'$D(^ENG(6920,EN1,1)) ^(1)=""
38 .. S X=$P(^ENG(6920,EN1,1),U,2)
39 .. I X'["cf:" S $P(^ENG(6920,EN1,1),U,2)=X_" cf: "_$P(^ENG(6920,DA,0),U)
40 .. S NUMBER=$P(^ENG(6920,EN1,0),U)
41 .. S ENMSG(0,1)="PM work order "_$P(^ENG(6920,DA,0),U)_" is being closed."
42 .. S ENMSG(0,2)="Regular work order "_NUMBER_" is open."
43 .. N ENDA S ENDA=DA
44 .. D WOPOST
45 Q:$G(EN2)
46 ;
47NEWWO N ENDA S ENDA=DA
48 N SHOPKEY,CODE,DA,DR
49 S SHOPKEY=ENSHKEY
50 D WONUM^ENWONEW
51 I NUMBER="" D D XCPTN^ENBCPM2 Q
52 . S ENMSG(0,1)="Work order "_$P(^ENG(6920,ENDA,0),U)_" will remain open."
53 . S ENMSG(0,2)="When closed, it should contain a reference to a regular work order."
54 S ENMSG(0,1)="PM work order "_$P(^ENG(6920,ENDA,0),U)_" is being closed out."
55 S ENMSG(0,2)="Regular work order "_NUMBER_" has been generated."
56 D WOPOST
57 S DIE="^ENG(6920,",DR=".05///^S X=NUMBER;1///^S X=DT;2///^S X=""C"";6///^S X=PROBLEM;7.5////^S X=.5;9////^S X=ENSHKEY;16////^S X=ENTEC;17///^S X=""A"";18///^S X=ENEQ;32///^S X=""PENDING"""
58 D ^DIE
59 I ENLOC]"" D
60 . I $D(^ENG("SP","B",ENLOC)) S DR="3///^S X=ENLOC" D ^DIE Q
61 . I ENLOC["E" D
62 .. S ENLOC(0)=ENLOC F S ENLOC(0)=$P(ENLOC(0),"E")_"e"_$P(ENLOC(0),"E",2,99) I $D(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E") Q
63 .. I $D(^ENG("SP","B",ENLOC(0))) S DR="3///^S X=ENLOC(0)" D ^DIE
64 .. Q
65 S EN1=$O(^ENG(6920.1,"B","GENERAL REPAIR (In-house)",0)) I EN1>0 S ^ENG(6920,DA,8,0)="^6920.035PA^1^1",^ENG(6920,DA,8,1,0)=EN1
66 S ^ENG(6920,DA,6,0)="^^1^"_DT,^ENG(6920,DA,6,1,0)="Generated on the basis of failed PMI "_$P($G(^ENG(6920,ENDA,0)),U)_"."
67 I $D(^ENG(6910.2,1,0)) S ENAUTO=$P(^(0),U,2) D K ENAUTO
68 . I ENAUTO]"","LS"[ENAUTO D
69 .. S ENAUTO(0)=$P(^DIC(6922,SHOPKEY,0),U,3)
70 .. I ENAUTO(0)]"",$D(^%ZIS(1,ENAUTO(0),0)) S WARD=0 D WOPRNT^ENWONEW
71 . Q
72 D XCPTN^ENBCPM2
73 Q
74 ;
75WOPOST ; Close the PM work order
76 N DA,ENTEC,ENEMP,DR,EN1
77 S EN1=$P($G(^ENG(6920,ENDA,5)),U,7) S:EN1]"" EN1=EN1_" "
78 S EN1=EN1_"cf: "_NUMBER
79 I $L(EN1)<50 S EN1=EN1_" (Bar Code)"
80 S $P(^ENG(6920,ENDA,5),U,7)=EN1
81 S DA=ENDA,DIE="^ENG(6920,",DR="36////^S X=DT;32///^S X=""COMPLETED"""
82 I $$GET1^DIQ(6920,DA,3)'=ENLOC S DR=DR_";3///^S X=ENLOC"
83 D ^DIE
84 I ENDEL="Y",$E(^ENG(6920,DA,0),1,3)="PM-" S DIK="^ENG(6920," D ^DIK
85 Q
86 ;ENBCPM7
Note: See TracBrowser for help on using the repository browser.