- ENSA4 ;(WASH ISC)/DH-Post MedTester PMI ;5.26.99
- ;;7.0;ENGINEERING;**9,14,35,54**;Aug 17, 1993
- POST ;Post PMI to Equip Hist
- CHK1 I ENFAIL,'$D(^TMP($J,"FAIL",ENEQ)),$D(^TMP($J,"PASS",ENEQ)) D Q
- . S ENMSG="Equipment Entry # "_ENEQ_" FAILED INSPECTION but passed a prior MedTester exam."
- . S ENMSG(0,1)="The first test was posted to the equipment history, which means that you should"
- . S ENMSG(0,2)="manually enter a corrective work order for the failure." I ENTEST]"" S ENMSG(0,2)=ENMSG(0,2)_" Test failed: "_ENTEST
- . D XCPTN^ENSA2
- CHK2 I ENFAIL,$D(^TMP($J,"FAIL",ENEQ)) Q ; already failed
- I ENPMWO="" G POST1^ENSA5 ; not processing worklist
- S ENWOX=0 D WOCHK^ENSA6 ; maybe work already posted
- Q:ENWOX ; WO has been closed ; MedTester time & labor cost added
- F DA=0:0 S DA=$O(^ENG(6920,"G",ENEQ,DA)) Q:DA'>0 I $P(^ENG(6920,DA,0),U,1)[ENPMWO D POST1 Q
- D:DA'>0 POST1^ENSA5
- Q
- POST1 ;PM work order to be closed
- S ENTEC(0)=$P($G(^ENG(6920,DA,2)),U,2)
- I ENTEC'=ENTEC(0)!(ENTIME>0) D
- . I ENTEC]"",ENTEC'=ENTEC(0) D
- .. S $P(^ENG(6920,DA,2),U,2)=ENTEC
- .. S:'$D(^ENG(6920,DA,7,0)) ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
- .. S ^ENG(6920,DA,7,1,0)=ENTEC_U_$P($G(^ENG(6920,DA,5)),U,3)_U_ENSHKEY
- .. I ENTIME'>0 D
- ... S ENH=$P(^ENG(6920,DA,7,1,0),U,2) Q:ENH=""
- ... S ENW="" I $D(^ENG("EMP",ENTEC,0)) S ENW=$P(^(0),U,3)
- ... I ENW="",$D(^DIC(6910,1,0)) S ENW=$P(^(0),U,4)
- ... I ENW>0 S X=ENH*ENW,X(0)=2 D ROUND^ENLIB S $P(^ENG(6920,DA,5),U,6)=+Y
- . I ENTIME>0 D
- .. S $P(^ENG(6920,DA,5),U,3)=ENTIME I $D(^ENG(6920,DA,7,1,0)) S $P(^(0),U,2)=ENTIME
- .. S ENW="" I ENTEC>0,$D(^ENG("EMP",ENTEC,0)) S ENW=$P(^(0),U,3)
- .. I ENW="",$D(^DIC(6910,1,0)) S ENW=$P(^(0),U,4)
- .. I ENW>0 S X=ENTIME*ENW,X(0)=2 D ROUND^ENLIB S $P(^ENG(6920,DA,5),U,6)=+Y
- I ENFAIL S ^TMP($J,"FAIL",ENEQ)="" G POST13^ENSA8
- S ^TMP($J,"PASS",ENEQ)=""
- D:$D(^ENG(6914,ENEQ,6)) PRVPST
- S:ENSTDT="" ENSTDT=DT
- S DIE="^ENG(6920,",DR="35.2///P;36////^S X=ENSTDT;32///^S X=""COMPLETED"""
- I $D(^ENG(6920,DA,5)) S ENWP(0)=$P(^(5),U,7) S:ENWP(0)]"" ENWP(0)=ENWP(0)_"; " S ENWP(0)=ENWP(0)_ENWP S:ENTEST]"" ENWP(0)=ENWP(0)_" "_ENTEST S $P(^(5),U,7)=$E(ENWP(0),1,140)
- K ENWP D ^DIE
- I ENTEC>0 S:ENTIME'>0 ENTIME=$P($G(^ENG(6920,DA,5)),U,3) I ENTIME>0 S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
- I ENDEL="Y",$E(^ENG(6920,DA,0),1,3)="PM-" S DIK="^ENG(6920," D ^DIK
- K EN
- Q
- ;
- PRVPST ;Check for previous (and direct) posting
- L +^ENG(6914,ENEQ,6):5 Q:'$T
- F I=0:0 S I=$O(^ENG(6914,ENEQ,6,I)) Q:I'>0 S ENSA2=$P(^ENG(6914,ENEQ,6,I,0),U,1) I $E(ENSA2,1,6)=$E(ENSTDT,2,7),$P(^(0),U,9)["MedTester" K ^ENG(6914,ENEQ,6,I,0) Q
- I I'>0 L -^ENG(6914,ENEQ,6) Q
- S J=0,I1="" F I=0:0 S I=$O(^ENG(6914,ENEQ,6,I)) Q:I'>0 S I1=I,J=J+1
- S:J=0 J="" S ^ENG(6914,ENEQ,6,0)=$P(^ENG(6914,ENEQ,6,0),U,1,2)_U_I1_U_J
- L -^ENG(6914,ENEQ,6)
- Q
- ;ENSA4
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSA4 2851 printed Feb 18, 2025@23:21:56 Page 2
- ENSA4 ;(WASH ISC)/DH-Post MedTester PMI ;5.26.99
- +1 ;;7.0;ENGINEERING;**9,14,35,54**;Aug 17, 1993
- POST ;Post PMI to Equip Hist
- CHK1 IF ENFAIL
- IF '$DATA(^TMP($JOB,"FAIL",ENEQ))
- IF $DATA(^TMP($JOB,"PASS",ENEQ))
- Begin DoDot:1
- +1 SET ENMSG="Equipment Entry # "_ENEQ_" FAILED INSPECTION but passed a prior MedTester exam."
- +2 SET ENMSG(0,1)="The first test was posted to the equipment history, which means that you should"
- +3 SET ENMSG(0,2)="manually enter a corrective work order for the failure."
- IF ENTEST]""
- SET ENMSG(0,2)=ENMSG(0,2)_" Test failed: "_ENTEST
- +4 DO XCPTN^ENSA2
- End DoDot:1
- QUIT
- CHK2 ; already failed
- IF ENFAIL
- IF $DATA(^TMP($JOB,"FAIL",ENEQ))
- QUIT
- +1 ; not processing worklist
- IF ENPMWO=""
- GOTO POST1^ENSA5
- +2 ; maybe work already posted
- SET ENWOX=0
- DO WOCHK^ENSA6
- +3 ; WO has been closed ; MedTester time & labor cost added
- if ENWOX
- QUIT
- +4 FOR DA=0:0
- SET DA=$ORDER(^ENG(6920,"G",ENEQ,DA))
- if DA'>0
- QUIT
- IF $PIECE(^ENG(6920,DA,0),U,1)[ENPMWO
- DO POST1
- QUIT
- +5 if DA'>0
- DO POST1^ENSA5
- +6 QUIT
- POST1 ;PM work order to be closed
- +1 SET ENTEC(0)=$PIECE($GET(^ENG(6920,DA,2)),U,2)
- +2 IF ENTEC'=ENTEC(0)!(ENTIME>0)
- Begin DoDot:1
- +3 IF ENTEC]""
- IF ENTEC'=ENTEC(0)
- Begin DoDot:2
- +4 SET $PIECE(^ENG(6920,DA,2),U,2)=ENTEC
- +5 if '$DATA(^ENG(6920,DA,7,0))
- SET ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
- +6 SET ^ENG(6920,DA,7,1,0)=ENTEC_U_$PIECE($GET(^ENG(6920,DA,5)),U,3)_U_ENSHKEY
- +7 IF ENTIME'>0
- Begin DoDot:3
- +8 SET ENH=$PIECE(^ENG(6920,DA,7,1,0),U,2)
- if ENH=""
- QUIT
- +9 SET ENW=""
- IF $DATA(^ENG("EMP",ENTEC,0))
- SET ENW=$PIECE(^(0),U,3)
- +10 IF ENW=""
- IF $DATA(^DIC(6910,1,0))
- SET ENW=$PIECE(^(0),U,4)
- +11 IF ENW>0
- SET X=ENH*ENW
- SET X(0)=2
- DO ROUND^ENLIB
- SET $PIECE(^ENG(6920,DA,5),U,6)=+Y
- End DoDot:3
- End DoDot:2
- +12 IF ENTIME>0
- Begin DoDot:2
- +13 SET $PIECE(^ENG(6920,DA,5),U,3)=ENTIME
- IF $DATA(^ENG(6920,DA,7,1,0))
- SET $PIECE(^(0),U,2)=ENTIME
- +14 SET ENW=""
- IF ENTEC>0
- IF $DATA(^ENG("EMP",ENTEC,0))
- SET ENW=$PIECE(^(0),U,3)
- +15 IF ENW=""
- IF $DATA(^DIC(6910,1,0))
- SET ENW=$PIECE(^(0),U,4)
- +16 IF ENW>0
- SET X=ENTIME*ENW
- SET X(0)=2
- DO ROUND^ENLIB
- SET $PIECE(^ENG(6920,DA,5),U,6)=+Y
- End DoDot:2
- End DoDot:1
- +17 IF ENFAIL
- SET ^TMP($JOB,"FAIL",ENEQ)=""
- GOTO POST13^ENSA8
- +18 SET ^TMP($JOB,"PASS",ENEQ)=""
- +19 if $DATA(^ENG(6914,ENEQ,6))
- DO PRVPST
- +20 if ENSTDT=""
- SET ENSTDT=DT
- +21 SET DIE="^ENG(6920,"
- SET DR="35.2///P;36////^S X=ENSTDT;32///^S X=""COMPLETED"""
- +22 IF $DATA(^ENG(6920,DA,5))
- SET ENWP(0)=$PIECE(^(5),U,7)
- if ENWP(0)]""
- SET ENWP(0)=ENWP(0)_"; "
- SET ENWP(0)=ENWP(0)_ENWP
- if ENTEST]""
- SET ENWP(0)=ENWP(0)_" "_ENTEST
- SET $PIECE(^(5),U,7)=$EXTRACT(ENWP(0),1,140)
- +23 KILL ENWP
- DO ^DIE
- +24 IF ENTEC>0
- if ENTIME'>0
- SET ENTIME=$PIECE($GET(^ENG(6920,DA,5)),U,3)
- IF ENTIME>0
- SET PMTOT(ENSHKEY,ENTEC)=$GET(PMTOT(ENSHKEY,ENTEC))+ENTIME
- +25 IF ENDEL="Y"
- IF $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
- SET DIK="^ENG(6920,"
- DO ^DIK
- +26 KILL EN
- +27 QUIT
- +28 ;
- PRVPST ;Check for previous (and direct) posting
- +1 LOCK +^ENG(6914,ENEQ,6):5
- if '$TEST
- QUIT
- +2 FOR I=0:0
- SET I=$ORDER(^ENG(6914,ENEQ,6,I))
- if I'>0
- QUIT
- SET ENSA2=$PIECE(^ENG(6914,ENEQ,6,I,0),U,1)
- IF $EXTRACT(ENSA2,1,6)=$EXTRACT(ENSTDT,2,7)
- IF $PIECE(^(0),U,9)["MedTester"
- KILL ^ENG(6914,ENEQ,6,I,0)
- QUIT
- +3 IF I'>0
- LOCK -^ENG(6914,ENEQ,6)
- QUIT
- +4 SET J=0
- SET I1=""
- FOR I=0:0
- SET I=$ORDER(^ENG(6914,ENEQ,6,I))
- if I'>0
- QUIT
- SET I1=I
- SET J=J+1
- +5 if J=0
- SET J=""
- SET ^ENG(6914,ENEQ,6,0)=$PIECE(^ENG(6914,ENEQ,6,0),U,1,2)_U_I1_U_J
- +6 LOCK -^ENG(6914,ENEQ,6)
- +7 QUIT
- +8 ;ENSA4
