source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENSA8.m@ 1150

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

initial load of WorldVistAEHR
File size: 3.6 KB
Line 
1ENSA8 ;(WASH ISC)/DH-MedTester PMI ;5.26.99
2 ;;7.0;ENGINEERING;**1,14,35,54**;Aug 17, 1993
3POST13 ;Device failed
4 N PROBLEM,NUMBER,WARD S PROBLEM="Device failed a MedTester Inspection"
5 S ENMSG="Equipment Entry # "_ENEQ_" FAILED INSPECTION. CORRECTIVE ACTION REQUIRED."
6 S ENMSG(0,3)="MEDTESTER UPLOAD."
7 S $P(^ENG(6920,DA,5),U,8)="C"
8 I ENTEC>0,$D(^ENG("EMP",ENTEC,0)) D
9 . I '$D(^ENG(6920,DA,7)) S ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
10 . S:ENTIME'>0 ENTIME=$P($G(^ENG(6920,DA,5)),U,3)
11 . S ^ENG(6920,DA,7,1,0)=ENTEC_U_ENTIME_U_ENSHKEY
12 . I ENTIME>0 D
13 .. S $P(^ENG(6920,DA,5),U,3)=ENTIME
14 .. S ENW=$P($G(^ENG("EMP",ENTEC,0)),U,3)
15 .. I ENW="" S ENW=$P($G(^DIC(6910,1,0)),U,4)
16 .. I ENW>0 S X=ENW*ENTIME,X(0)=2 D ROUND^ENLIB S $P(^ENG(6920,DA,5),U,6)=+Y
17EXST S EN2=0 F EN1=0:0 S EN1=$O(^ENG(6920,"G",ENEQ,EN1)) Q:EN2!(EN1'>0) D I EN2 D XCPTN^ENSA2 Q
18 . I $D(^ENG(6920,EN1,5)),$P(^(5),U,2)]"" Q
19 . I $E(^ENG(6920,EN1,0),1,3)="Y2-" Q
20 . I $E(^ENG(6920,EN1,0),1,3)="PM-" Q
21 . I $D(^ENG(6920,EN1,1)),$P(^(1),U)=.5 S EN2=1 D Q
22 .. S ENMSG(0,1)="PM work order "_$P(^ENG(6920,DA,0),U)_" is being closed."
23 .. S ENMSG(0,2)="Regular work order "_$P(^ENG(6920,EN1,0),U)_" is open."
24 .. N ENDA S ENDA=DA,NUMBER=$P(^ENG(6920,EN1,0),U)
25 .. D WOPOST
26 . I $D(^ENG(6920,EN1,2)),$P(^(2),U)=ENSHKEY S EN2=1 D Q
27 .. N X S:'$D(^ENG(6920,EN1,1)) ^(1)=""
28 .. S X=$P(^ENG(6920,EN1,1),U,2)
29 .. I X'["cf:" S $P(^ENG(6920,EN1,1),U,2)=X_" cf: "_$P(^ENG(6920,DA,0),U)
30 .. S NUMBER=$P(^ENG(6920,EN1,0),U)
31 .. S ENMSG(0,1)="PM work order "_$P(^ENG(6920,DA,0),U)_" is being closed."
32 .. S ENMSG(0,2)="Regular work order "_NUMBER_" is open."
33 .. N ENDA S ENDA=DA
34 .. D WOPOST
35 Q:EN2
36NEWWO N ENDA S ENDA=DA
37 N SHOPKEY,CODE,DA,DR
38 S SHOPKEY=ENSHKEY
39 D WONUM^ENWONEW
40 I NUMBER="" D D XCPTN^ENSA2 Q
41 . S ENMSG(0,1)="Work order "_$P(^ENG(6920,ENDA,0),U)_" will remain open."
42 . S ENMSG(0,2)="When closed, it should contain a reference to a regular work order."
43 S ENMSG(0,1)="PM work order "_$P(^ENG(6920,ENDA,0),U)_" is being closed out."
44 S ENMSG(0,2)="Regular work order "_NUMBER_" has been generated."
45 D WOPOST
46 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"""
47 D ^DIE
48 I ENLOC]"" D
49 . I $D(^ENG("SP","B",ENLOC)) S DR="3///^S X=ENLOC" D ^DIE Q
50 . I ENLOC["E" D
51 .. 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
52 .. I $D(^ENG("SP","B",ENLOC(0))) S DR="3///^S X=ENLOC(0)" D ^DIE
53 .. Q
54 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
55 S ^ENG(6920,DA,6,0)="^^1^"_DT,^ENG(6920,DA,6,1,0)="Generated on the basis of MedTester upload "_$P($G(^ENG(6920,ENDA,0)),U)_"."
56 I ENWP]"" S $P(^ENG(6920,DA,6,0),U,3)=2,^ENG(6920,DA,6,2,0)=ENWP
57 I $D(^ENG(6910.2,1,0)) S ENAUTO=$P(^(0),U,2) D K ENAUTO
58 . I ENAUTO]"","LS"[ENAUTO D
59 .. S ENAUTO(0)=$P(^DIC(6922,SHOPKEY,0),U,3)
60 .. I ENAUTO(0)]"",$D(^%ZIS(1,ENAUTO(0),0)) S WARD=0 D WOPRNT^ENWONEW
61 . Q
62 D XCPTN^ENSA2
63 Q
64 ;
65WOPOST N DA,DR,EN1,X,X1 D
66 . I ENTEC>0,$D(^ENG("EMP",ENTEC,0)) S X=ENTEC
67 . E S X=$P($G(^ENG(6920,ENDA,2)),U,2)
68 . I ENTIME>0 S X1=ENTIME
69 . E S X1=$P($G(^ENG(6920,ENDA,7,1,0)),U,2)
70 . I X>0,X1>0 S PMTOT(ENSHKEY,X)=$G(PMTOT(ENSHKEY,X))+X1
71 S:'$D(^ENG(6920,ENDA,5)) ^ENG(6920,ENDA,5)=""
72 S EN1=$P(^ENG(6920,ENDA,5),U,7) S:EN1]"" EN1=EN1_" "
73 S EN1=EN1_"cf: "_NUMBER_" MedTester" S:ENTEST]"" EN1=EN1_" "_ENTEST
74 S $P(^ENG(6920,ENDA,5),U,7)=$E(EN1,1,140)
75 S DA=ENDA,DIE="^ENG(6920,",DR="36////^S X=DT;32///^S X=""COMPLETED"""
76 D ^DIE
77 I ENDEL="Y",$E(^ENG(6920,DA,0),1,3)="PM-" S DIK="^ENG(6920," D ^DIK
78 Q
79 ;ENSA8
Note: See TracBrowser for help on using the repository browser.