source: FOIAVistA/trunk/r/ENGINEERING-EN/ENBCPM5.m@ 1336

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