- 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 Mar 13, 2025@20:56:44 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
