ENBCPM5 ;(WASH ISC)/DH-Bar Coded PMI ;1.14.98
;;7.0;ENGINEERING;**14,21,35,48**;Aug 17, 1993
POST2 ;No existing PM work order - Post directly to equip hist
S ENLKAHD="",ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) S:ENX1]"" ENLKAHD=^(ENX1,0)
G:ENLKAHD=""!($E(ENLKAHD)="*") POST21 I $E(ENLKAHD,1,2)="SP"!($E(ENLKAHD,3,8)[" EE") G POST21
I $E(ENLKAHD,1,4)="MOD:"!($E(ENLKAHD,1,4)="PM#:") G POST21
I $E(ENLKAHD,1,4)="TIME" G POST22
I ENLKAHD="FAILED" G POST23
S ENMSG="UNEXPECTED DATA UPLOADED FROM BAR CODE READER.",ENMSG(0,1)="Please check entry following "_ENLBL_".",ENMSG(0,2)="Attempting to process: "_ENLKAHD D XCPTN^ENBCPM2
Q
;
POST21 ;Device passed, no t&m
I ENDEL'="Y" K ENPMWO(0) S EN=21 D POST^ENBCPM6 Q:$D(ENPMWO(0))
S ENDTCP=DT,ENH=ENDTCP_"-P2"_U_ENPMWO_U_"P"_"^^^^^"_ENEMP_"^PM Inspection (Recorded via Bar Code Reader)",ENINV=ENEQ
L +^ENG(6914,ENEQ,6):5 I '$T S ENMSG="Skipping service history for Equipment ID#: "_ENEQ D XCPTN^ENBCPM2 Q
S ENPMEMP=ENEMP D EXT^ENEQHS S ENEMP=ENPMEMP
L -^ENG(6914,ENEQ,6)
Q
;
POST22 ;Device passed, t&m recorded
I ENDEL'="Y" S EN=22 K ENPMWO(0) D POST^ENBCPM6 Q:$D(ENPMWO(0))
S ENTIME=+$E(ENLKAHD,6,30) I ENTIME]"" S X=ENTIME,X(0)=2 D ROUND^ENLIB S ENTIME=+Y S:ENTIME<0 ENTIME=""
I $G(ENTIME)>0 S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
S ENX=ENX1,^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD,ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) S ENLKAHD=$S(ENX1]"":^(ENX1,0),1:"")
S ENMATRL="" I $E(ENLKAHD,1,5)="MATRL" D
. S ENX=ENX1,^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD,ENMATRL=+$E(ENLKAHD,7,30) S:ENMATRL<0 ENMATRL=""
. S ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)),ENLKAHD=$S(ENX1]"":^(ENX1,0),1:"")
. I $E(ENLKAHD,1,5)="CODE:" D
.. S ENX=ENX1,^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
.. I $P(ENLKAHD,":",2)?1N N DIE,DA D
... S DA=ENEQ,DIE="^ENG(6914,",DR="53///"_$P(ENLKAHD,":",2) D ^DIE
... Q
I ENMATRL=+ENMATRL S X=ENMATRL,X(0)=2 D ROUND^ENLIB S ENMATRL=+Y
S ENLBR="" I ENTIME]"",$D(^ENG("EMP",ENTEC,0)) S ENLBR=$P(^(0),U,3) I ENLBR]"" S:ENLBR<0 ENLBR=0 S ENLBR=ENLBR*ENTIME
S X=ENX,ENWP=""
I X]"" F S X=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,X)) Q:X="" S X1=^(X,0) Q:($E(X1)="*")!($E(X1,1,2)="SP")!($E(X1,1,4)="MOD:")!($E(X1,1,4)="PM#:")!($E(X1,3,8)[" EE") D
. S ENX=X,ENWP=ENWP_X1
. S ^PRCT(446.4,ENCTID,2,ENCTTI,1,X,0)="*"_X1
I ENWP]"",$L(ENWP)<130 S ENWP=ENWP_" (Bar Code)"
S:ENWP="" ENWP="PM Inspection (Recorded via Bar Code Reader)"
S ENDTCP=DT,ENH=ENDTCP_"-PM"_U_ENPMWO_U_"P"_U_ENTIME_U_ENLBR_U_ENMATRL_"^^"_ENEMP_U_ENWP,ENINV=ENEQ
L +^ENG(6914,ENEQ,6):5 I '$T S ENMSG="Skipping service history for Equipment ID#: "_ENINV D XCPTN^ENBCPM2 Q
S ENPMEMP=ENEMP D EXT^ENEQHS S ENEMP=ENPMEMP
L -^ENG(6914,ENEQ,6)
Q
;
POST23 ;Device failed
N PROBLEM S PROBLEM="Device failed a PM Inspection",ENTIME=""
S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
S ENX1=ENX+2,ENX=ENX+1,ENLKAHD=$S($D(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
S ENMSG="Equipment Entry # "_ENEQ_" FAILED PMI. CORRECTIVE ACTION REQUIRED."
S ENMSG(0,1)="This device has no open work order that begins with "_ENPMWO_"..."
S ENMSG(0,2)="Nothing is being posted to the equipment history."
S ENMSG(0,3)="NO STATEMENT OF PROBLEM."
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
. S ENX=ENX1,ENMSG(0,3)="Problem description: "_ENLKAHD
. S PROBLEM=ENLKAHD
. S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
. S ENX1=ENX1+1
. S ENLKAHD=$S($D(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
. I $E(ENLKAHD,1,4)="TIME" S ENX=ENX+1 D
.. S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
.. S ENTIME=+$E(ENLKAHD,6,30) I ENTIME>0 D
... S ENMSG(0,3)=ENMSG(0,3)_" (Time: "_ENTIME_" hrs)"
... S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
NEWWO D NEWWO^ENBCPM9
Q
;
HOLD I $E(IOST,1,2)="C-" W !,"Press RETURN to continue..." R X:DTIME
Q
ERR ;Error message (Forced exit)
W !!,*7,"FATAL ERROR OR USER ABORT.",*7
W !,"Process ID is: ENPM Time stamp is: ",$S($D(ENCTTI):$P(^PRCT(446.4,ENCTID,2,ENCTTI,0),U,1),1:"UNDEFINED.")
W !,"Please make a note of this information, as you will need it to RESTART",!,"processing of the data on file."
S ENY=0 D HOLD
EXIT I $E(IOST,1,2)="C-",$D(ENY),ENY>0 D HOLD
K EN,ENA,ENB,ENEQ,ENLBL,ENSTA,ENSTAL,ENMSG,ENCTTI,ENCTID,ENX,ENX1,ENY
K ENLOC,ENOLDLOC,ENLKAHD,ENTEC,ENEMP,ENPMEMP,ENPMTEC,ENPM,ENPMWO,ENSHABR,ENSHOP,ENDTCP,ENH,ENINV,ENPG,ENWOX,ENW,EN1,EN2
K %,I,J,K,ENTIME,ENMATRL,ENLBR,ENDATE,ENDEL,ENWP,DIC,DIE,DA,DR
W @IOF
I $E(IOST,1,2)="P-",'$D(ZTQUEUED) D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@"
Q
;ENBCPM5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM5 4729 printed Nov 22, 2024@17:02:13 Page 2
ENBCPM5 ;(WASH ISC)/DH-Bar Coded PMI ;1.14.98
+1 ;;7.0;ENGINEERING;**14,21,35,48**;Aug 17, 1993
POST2 ;No existing PM work order - Post directly to equip hist
+1 SET ENLKAHD=""
SET ENX1=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
if ENX1]""
SET ENLKAHD=^(ENX1,0)
+2 if ENLKAHD=""!($EXTRACT(ENLKAHD)="*")
GOTO POST21
IF $EXTRACT(ENLKAHD,1,2)="SP"!($EXTRACT(ENLKAHD,3,8)[" EE")
GOTO POST21
+3 IF $EXTRACT(ENLKAHD,1,4)="MOD:"!($EXTRACT(ENLKAHD,1,4)="PM#:")
GOTO POST21
+4 IF $EXTRACT(ENLKAHD,1,4)="TIME"
GOTO POST22
+5 IF ENLKAHD="FAILED"
GOTO POST23
+6 SET ENMSG="UNEXPECTED DATA UPLOADED FROM BAR CODE READER."
SET ENMSG(0,1)="Please check entry following "_ENLBL_"."
SET ENMSG(0,2)="Attempting to process: "_ENLKAHD
DO XCPTN^ENBCPM2
+7 QUIT
+8 ;
POST21 ;Device passed, no t&m
+1 IF ENDEL'="Y"
KILL ENPMWO(0)
SET EN=21
DO POST^ENBCPM6
if $DATA(ENPMWO(0))
QUIT
+2 SET ENDTCP=DT
SET ENH=ENDTCP_"-P2"_U_ENPMWO_U_"P"_"^^^^^"_ENEMP_"^PM Inspection (Recorded via Bar Code Reader)"
SET ENINV=ENEQ
+3 LOCK +^ENG(6914,ENEQ,6):5
IF '$TEST
SET ENMSG="Skipping service history for Equipment ID#: "_ENEQ
DO XCPTN^ENBCPM2
QUIT
+4 SET ENPMEMP=ENEMP
DO EXT^ENEQHS
SET ENEMP=ENPMEMP
+5 LOCK -^ENG(6914,ENEQ,6)
+6 QUIT
+7 ;
POST22 ;Device passed, t&m recorded
+1 IF ENDEL'="Y"
SET EN=22
KILL ENPMWO(0)
DO POST^ENBCPM6
if $DATA(ENPMWO(0))
QUIT
+2 SET ENTIME=+$EXTRACT(ENLKAHD,6,30)
IF ENTIME]""
SET X=ENTIME
SET X(0)=2
DO ROUND^ENLIB
SET ENTIME=+Y
if ENTIME<0
SET ENTIME=""
+3 IF $GET(ENTIME)>0
SET PMTOT(ENSHKEY,ENTEC)=$GET(PMTOT(ENSHKEY,ENTEC))+ENTIME
+4 SET ENX=ENX1
SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
SET ENX1=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
SET ENLKAHD=$SELECT(ENX1]"":^(ENX1,0),1:"")
+5 SET ENMATRL=""
IF $EXTRACT(ENLKAHD,1,5)="MATRL"
Begin DoDot:1
+6 SET ENX=ENX1
SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
SET ENMATRL=+$EXTRACT(ENLKAHD,7,30)
if ENMATRL<0
SET ENMATRL=""
+7 SET ENX1=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
SET ENLKAHD=$SELECT(ENX1]"":^(ENX1,0),1:"")
+8 IF $EXTRACT(ENLKAHD,1,5)="CODE:"
Begin DoDot:2
+9 SET ENX=ENX1
SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
+10 IF $PIECE(ENLKAHD,":",2)?1N
NEW DIE,DA
Begin DoDot:3
+11 SET DA=ENEQ
SET DIE="^ENG(6914,"
SET DR="53///"_$PIECE(ENLKAHD,":",2)
DO ^DIE
+12 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+13 IF ENMATRL=+ENMATRL
SET X=ENMATRL
SET X(0)=2
DO ROUND^ENLIB
SET ENMATRL=+Y
+14 SET ENLBR=""
IF ENTIME]""
IF $DATA(^ENG("EMP",ENTEC,0))
SET ENLBR=$PIECE(^(0),U,3)
IF ENLBR]""
if ENLBR<0
SET ENLBR=0
SET ENLBR=ENLBR*ENTIME
+15 SET X=ENX
SET ENWP=""
+16 IF X]""
FOR
SET X=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,X))
if X=""
QUIT
SET X1=^(X,0)
if ($EXTRACT(X1)="*")!($EXTRACT(X1,1,2)="SP")!($EXTRACT(X1,1,4)="MOD
QUIT
Begin DoDot:1
+17 SET ENX=X
SET ENWP=ENWP_X1
+18 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,X,0)="*"_X1
End DoDot:1
+19 IF ENWP]""
IF $LENGTH(ENWP)<130
SET ENWP=ENWP_" (Bar Code)"
+20 if ENWP=""
SET ENWP="PM Inspection (Recorded via Bar Code Reader)"
+21 SET ENDTCP=DT
SET ENH=ENDTCP_"-PM"_U_ENPMWO_U_"P"_U_ENTIME_U_ENLBR_U_ENMATRL_"^^"_ENEMP_U_ENWP
SET ENINV=ENEQ
+22 LOCK +^ENG(6914,ENEQ,6):5
IF '$TEST
SET ENMSG="Skipping service history for Equipment ID#: "_ENINV
DO XCPTN^ENBCPM2
QUIT
+23 SET ENPMEMP=ENEMP
DO EXT^ENEQHS
SET ENEMP=ENPMEMP
+24 LOCK -^ENG(6914,ENEQ,6)
+25 QUIT
+26 ;
POST23 ;Device failed
+1 NEW PROBLEM
SET PROBLEM="Device failed a PM Inspection"
SET ENTIME=""
+2 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
+3 SET ENX1=ENX+2
SET ENX=ENX+1
SET ENLKAHD=$SELECT($DATA(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
+4 SET ENMSG="Equipment Entry # "_ENEQ_" FAILED PMI. CORRECTIVE ACTION REQUIRED."
+5 SET ENMSG(0,1)="This device has no open work order that begins with "_ENPMWO_"..."
+6 SET ENMSG(0,2)="Nothing is being posted to the equipment history."
+7 SET ENMSG(0,3)="NO STATEMENT OF PROBLEM."
+8 IF ENLKAHD]""
IF $EXTRACT(ENLKAHD)'="*"
IF $EXTRACT(ENLKAHD,1,2)'="SP"
IF $EXTRACT(ENLKAHD,1,4)'="MOD:"
IF $EXTRACT(ENLKAHD,1,4)'="PM#:"
IF $EXTRACT(ENLKAHD,3,8)'[" EE"
Begin DoDot:1
+9 SET ENX=ENX1
SET ENMSG(0,3)="Problem description: "_ENLKAHD
+10 SET PROBLEM=ENLKAHD
+11 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
+12 SET ENX1=ENX1+1
+13 SET ENLKAHD=$SELECT($DATA(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
+14 IF $EXTRACT(ENLKAHD,1,4)="TIME"
SET ENX=ENX+1
Begin DoDot:2
+15 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
+16 SET ENTIME=+$EXTRACT(ENLKAHD,6,30)
IF ENTIME>0
Begin DoDot:3
+17 SET ENMSG(0,3)=ENMSG(0,3)_" (Time: "_ENTIME_" hrs)"
+18 SET PMTOT(ENSHKEY,ENTEC)=$GET(PMTOT(ENSHKEY,ENTEC))+ENTIME
End DoDot:3
End DoDot:2
End DoDot:1
NEWWO DO NEWWO^ENBCPM9
+1 QUIT
+2 ;
HOLD IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Press RETURN to continue..."
READ X:DTIME
+1 QUIT
ERR ;Error message (Forced exit)
+1 WRITE !!,*7,"FATAL ERROR OR USER ABORT.",*7
+2 WRITE !,"Process ID is: ENPM Time stamp is: ",$SELECT($DATA(ENCTTI):$PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),U,1),1:"UNDEFINED.")
+3 WRITE !,"Please make a note of this information, as you will need it to RESTART",!,"processing of the data on file."
+4 SET ENY=0
DO HOLD
EXIT IF $EXTRACT(IOST,1,2)="C-"
IF $DATA(ENY)
IF ENY>0
DO HOLD
+1 KILL EN,ENA,ENB,ENEQ,ENLBL,ENSTA,ENSTAL,ENMSG,ENCTTI,ENCTID,ENX,ENX1,ENY
+2 KILL ENLOC,ENOLDLOC,ENLKAHD,ENTEC,ENEMP,ENPMEMP,ENPMTEC,ENPM,ENPMWO,ENSHABR,ENSHOP,ENDTCP,ENH,ENINV,ENPG,ENWOX,ENW,EN1,EN2
+3 KILL %,I,J,K,ENTIME,ENMATRL,ENLBR,ENDATE,ENDEL,ENWP,DIC,DIE,DA,DR
+4 WRITE @IOF
+5 IF $EXTRACT(IOST,1,2)="P-"
IF '$DATA(ZTQUEUED)
DO ^%ZISC
+6 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
+8 ;ENBCPM5
