ENSA8 ;(WASH ISC)/DH-MedTester PMI ;5.26.99
;;7.0;ENGINEERING;**1,14,35,54**;Aug 17, 1993
POST13 ;Device failed
N PROBLEM,NUMBER,WARD S PROBLEM="Device failed a MedTester Inspection"
S ENMSG="Equipment Entry # "_ENEQ_" FAILED INSPECTION. CORRECTIVE ACTION REQUIRED."
S ENMSG(0,3)="MEDTESTER UPLOAD."
S $P(^ENG(6920,DA,5),U,8)="C"
I ENTEC>0,$D(^ENG("EMP",ENTEC,0)) D
. I '$D(^ENG(6920,DA,7)) S ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
. S:ENTIME'>0 ENTIME=$P($G(^ENG(6920,DA,5)),U,3)
. S ^ENG(6920,DA,7,1,0)=ENTEC_U_ENTIME_U_ENSHKEY
. I ENTIME>0 D
.. S $P(^ENG(6920,DA,5),U,3)=ENTIME
.. S ENW=$P($G(^ENG("EMP",ENTEC,0)),U,3)
.. I ENW="" S ENW=$P($G(^DIC(6910,1,0)),U,4)
.. I ENW>0 S X=ENW*ENTIME,X(0)=2 D ROUND^ENLIB S $P(^ENG(6920,DA,5),U,6)=+Y
EXST 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
. I $D(^ENG(6920,EN1,5)),$P(^(5),U,2)]"" Q
. I $E(^ENG(6920,EN1,0),1,3)="Y2-" Q
. I $E(^ENG(6920,EN1,0),1,3)="PM-" Q
. I $D(^ENG(6920,EN1,1)),$P(^(1),U)=.5 S EN2=1 D Q
.. S ENMSG(0,1)="PM work order "_$P(^ENG(6920,DA,0),U)_" is being closed."
.. S ENMSG(0,2)="Regular work order "_$P(^ENG(6920,EN1,0),U)_" is open."
.. N ENDA S ENDA=DA,NUMBER=$P(^ENG(6920,EN1,0),U)
.. D WOPOST
. I $D(^ENG(6920,EN1,2)),$P(^(2),U)=ENSHKEY S EN2=1 D Q
.. N X S:'$D(^ENG(6920,EN1,1)) ^(1)=""
.. S X=$P(^ENG(6920,EN1,1),U,2)
.. I X'["cf:" S $P(^ENG(6920,EN1,1),U,2)=X_" cf: "_$P(^ENG(6920,DA,0),U)
.. S NUMBER=$P(^ENG(6920,EN1,0),U)
.. S ENMSG(0,1)="PM work order "_$P(^ENG(6920,DA,0),U)_" is being closed."
.. S ENMSG(0,2)="Regular work order "_NUMBER_" is open."
.. N ENDA S ENDA=DA
.. D WOPOST
Q:EN2
NEWWO N ENDA S ENDA=DA
N SHOPKEY,CODE,DA,DR
S SHOPKEY=ENSHKEY
D WONUM^ENWONEW
I NUMBER="" D D XCPTN^ENSA2 Q
. S ENMSG(0,1)="Work order "_$P(^ENG(6920,ENDA,0),U)_" will remain open."
. S ENMSG(0,2)="When closed, it should contain a reference to a regular work order."
S ENMSG(0,1)="PM work order "_$P(^ENG(6920,ENDA,0),U)_" is being closed out."
S ENMSG(0,2)="Regular work order "_NUMBER_" has been generated."
D WOPOST
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"""
D ^DIE
I ENLOC]"" D
. I $D(^ENG("SP","B",ENLOC)) S DR="3///^S X=ENLOC" D ^DIE Q
. I ENLOC["E" D
.. 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
.. I $D(^ENG("SP","B",ENLOC(0))) S DR="3///^S X=ENLOC(0)" D ^DIE
.. Q
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
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)_"."
I ENWP]"" S $P(^ENG(6920,DA,6,0),U,3)=2,^ENG(6920,DA,6,2,0)=ENWP
I $D(^ENG(6910.2,1,0)) S ENAUTO=$P(^(0),U,2) D K ENAUTO
. I ENAUTO]"","LS"[ENAUTO D
.. S ENAUTO(0)=$P(^DIC(6922,SHOPKEY,0),U,3)
.. I ENAUTO(0)]"",$D(^%ZIS(1,ENAUTO(0),0)) S WARD=0 D WOPRNT^ENWONEW
. Q
D XCPTN^ENSA2
Q
;
WOPOST N DA,DR,EN1,X,X1 D
. I ENTEC>0,$D(^ENG("EMP",ENTEC,0)) S X=ENTEC
. E S X=$P($G(^ENG(6920,ENDA,2)),U,2)
. I ENTIME>0 S X1=ENTIME
. E S X1=$P($G(^ENG(6920,ENDA,7,1,0)),U,2)
. I X>0,X1>0 S PMTOT(ENSHKEY,X)=$G(PMTOT(ENSHKEY,X))+X1
S:'$D(^ENG(6920,ENDA,5)) ^ENG(6920,ENDA,5)=""
S EN1=$P(^ENG(6920,ENDA,5),U,7) S:EN1]"" EN1=EN1_" "
S EN1=EN1_"cf: "_NUMBER_" MedTester" S:ENTEST]"" EN1=EN1_" "_ENTEST
S $P(^ENG(6920,ENDA,5),U,7)=$E(EN1,1,140)
S DA=ENDA,DIE="^ENG(6920,",DR="36////^S X=DT;32///^S X=""COMPLETED"""
D ^DIE
I ENDEL="Y",$E(^ENG(6920,DA,0),1,3)="PM-" S DIK="^ENG(6920," D ^DIK
Q
;ENSA8
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSA8 3815 printed Oct 16, 2024@17:56:24 Page 2
ENSA8 ;(WASH ISC)/DH-MedTester PMI ;5.26.99
+1 ;;7.0;ENGINEERING;**1,14,35,54**;Aug 17, 1993
POST13 ;Device failed
+1 NEW PROBLEM,NUMBER,WARD
SET PROBLEM="Device failed a MedTester Inspection"
+2 SET ENMSG="Equipment Entry # "_ENEQ_" FAILED INSPECTION. CORRECTIVE ACTION REQUIRED."
+3 SET ENMSG(0,3)="MEDTESTER UPLOAD."
+4 SET $PIECE(^ENG(6920,DA,5),U,8)="C"
+5 IF ENTEC>0
IF $DATA(^ENG("EMP",ENTEC,0))
Begin DoDot:1
+6 IF '$DATA(^ENG(6920,DA,7))
SET ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
+7 if ENTIME'>0
SET ENTIME=$PIECE($GET(^ENG(6920,DA,5)),U,3)
+8 SET ^ENG(6920,DA,7,1,0)=ENTEC_U_ENTIME_U_ENSHKEY
+9 IF ENTIME>0
Begin DoDot:2
+10 SET $PIECE(^ENG(6920,DA,5),U,3)=ENTIME
+11 SET ENW=$PIECE($GET(^ENG("EMP",ENTEC,0)),U,3)
+12 IF ENW=""
SET ENW=$PIECE($GET(^DIC(6910,1,0)),U,4)
+13 IF ENW>0
SET X=ENW*ENTIME
SET X(0)=2
DO ROUND^ENLIB
SET $PIECE(^ENG(6920,DA,5),U,6)=+Y
End DoDot:2
End DoDot:1
EXST SET EN2=0
FOR EN1=0:0
SET EN1=$ORDER(^ENG(6920,"G",ENEQ,EN1))
if EN2!(EN1'>0)
QUIT
Begin DoDot:1
+1 IF $DATA(^ENG(6920,EN1,5))
IF $PIECE(^(5),U,2)]""
QUIT
+2 IF $EXTRACT(^ENG(6920,EN1,0),1,3)="Y2-"
QUIT
+3 IF $EXTRACT(^ENG(6920,EN1,0),1,3)="PM-"
QUIT
+4 IF $DATA(^ENG(6920,EN1,1))
IF $PIECE(^(1),U)=.5
SET EN2=1
Begin DoDot:2
+5 SET ENMSG(0,1)="PM work order "_$PIECE(^ENG(6920,DA,0),U)_" is being closed."
+6 SET ENMSG(0,2)="Regular work order "_$PIECE(^ENG(6920,EN1,0),U)_" is open."
+7 NEW ENDA
SET ENDA=DA
SET NUMBER=$PIECE(^ENG(6920,EN1,0),U)
+8 DO WOPOST
End DoDot:2
QUIT
+9 IF $DATA(^ENG(6920,EN1,2))
IF $PIECE(^(2),U)=ENSHKEY
SET EN2=1
Begin DoDot:2
+10 NEW X
if '$DATA(^ENG(6920,EN1,1))
SET ^(1)=""
+11 SET X=$PIECE(^ENG(6920,EN1,1),U,2)
+12 IF X'["cf:"
SET $PIECE(^ENG(6920,EN1,1),U,2)=X_" cf: "_$PIECE(^ENG(6920,DA,0),U)
+13 SET NUMBER=$PIECE(^ENG(6920,EN1,0),U)
+14 SET ENMSG(0,1)="PM work order "_$PIECE(^ENG(6920,DA,0),U)_" is being closed."
+15 SET ENMSG(0,2)="Regular work order "_NUMBER_" is open."
+16 NEW ENDA
SET ENDA=DA
+17 DO WOPOST
End DoDot:2
QUIT
End DoDot:1
IF EN2
DO XCPTN^ENSA2
QUIT
+18 if EN2
QUIT
NEWWO NEW ENDA
SET ENDA=DA
+1 NEW SHOPKEY,CODE,DA,DR
+2 SET SHOPKEY=ENSHKEY
+3 DO WONUM^ENWONEW
+4 IF NUMBER=""
Begin DoDot:1
+5 SET ENMSG(0,1)="Work order "_$PIECE(^ENG(6920,ENDA,0),U)_" will remain open."
+6 SET ENMSG(0,2)="When closed, it should contain a reference to a regular work order."
End DoDot:1
DO XCPTN^ENSA2
QUIT
+7 SET ENMSG(0,1)="PM work order "_$PIECE(^ENG(6920,ENDA,0),U)_" is being closed out."
+8 SET ENMSG(0,2)="Regular work order "_NUMBER_" has been generated."
+9 DO WOPOST
+10 SET DIE="^ENG(6920,"
SET 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"""
+11 DO ^DIE
+12 IF ENLOC]""
Begin DoDot:1
+13 IF $DATA(^ENG("SP","B",ENLOC))
SET DR="3///^S X=ENLOC"
DO ^DIE
QUIT
+14 IF ENLOC["E"
Begin DoDot:2
+15 SET ENLOC(0)=ENLOC
FOR
SET ENLOC(0)=$PIECE(ENLOC(0),"E")_"e"_$PIECE(ENLOC(0),"E",2,99)
IF $DATA(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E")
QUIT
+16 IF $DATA(^ENG("SP","B",ENLOC(0)))
SET DR="3///^S X=ENLOC(0)"
DO ^DIE
+17 QUIT
End DoDot:2
End DoDot:1
+18 SET EN1=$ORDER(^ENG(6920.1,"B","GENERAL REPAIR (In-house)",0))
IF EN1>0
SET ^ENG(6920,DA,8,0)="^6920.035PA^1^1"
SET ^ENG(6920,DA,8,1,0)=EN1
+19 SET ^ENG(6920,DA,6,0)="^^1^"_DT
SET ^ENG(6920,DA,6,1,0)="Generated on the basis of MedTester upload "_$PIECE($GET(^ENG(6920,ENDA,0)),U)_"."
+20 IF ENWP]""
SET $PIECE(^ENG(6920,DA,6,0),U,3)=2
SET ^ENG(6920,DA,6,2,0)=ENWP
+21 IF $DATA(^ENG(6910.2,1,0))
SET ENAUTO=$PIECE(^(0),U,2)
Begin DoDot:1
+22 IF ENAUTO]""
IF "LS"[ENAUTO
Begin DoDot:2
+23 SET ENAUTO(0)=$PIECE(^DIC(6922,SHOPKEY,0),U,3)
+24 IF ENAUTO(0)]""
IF $DATA(^%ZIS(1,ENAUTO(0),0))
SET WARD=0
DO WOPRNT^ENWONEW
End DoDot:2
+25 QUIT
End DoDot:1
KILL ENAUTO
+26 DO XCPTN^ENSA2
+27 QUIT
+28 ;
WOPOST NEW DA,DR,EN1,X,X1
Begin DoDot:1
+1 IF ENTEC>0
IF $DATA(^ENG("EMP",ENTEC,0))
SET X=ENTEC
+2 IF '$TEST
SET X=$PIECE($GET(^ENG(6920,ENDA,2)),U,2)
+3 IF ENTIME>0
SET X1=ENTIME
+4 IF '$TEST
SET X1=$PIECE($GET(^ENG(6920,ENDA,7,1,0)),U,2)
+5 IF X>0
IF X1>0
SET PMTOT(ENSHKEY,X)=$GET(PMTOT(ENSHKEY,X))+X1
End DoDot:1
+6 if '$DATA(^ENG(6920,ENDA,5))
SET ^ENG(6920,ENDA,5)=""
+7 SET EN1=$PIECE(^ENG(6920,ENDA,5),U,7)
if EN1]""
SET EN1=EN1_" "
+8 SET EN1=EN1_"cf: "_NUMBER_" MedTester"
if ENTEST]""
SET EN1=EN1_" "_ENTEST
+9 SET $PIECE(^ENG(6920,ENDA,5),U,7)=$EXTRACT(EN1,1,140)
+10 SET DA=ENDA
SET DIE="^ENG(6920,"
SET DR="36////^S X=DT;32///^S X=""COMPLETED"""
+11 DO ^DIE
+12 IF ENDEL="Y"
IF $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
SET DIK="^ENG(6920,"
DO ^DIK
+13 QUIT
+14 ;ENSA8
