source: FOIAVistA/tag/r/ENGINEERING-EN/ENBCPM5.m@ 1767

Last change on this file since 1767 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.5 KB
Line 
1ENBCPM5 ;(WASH ISC)/DH-Bar Coded PMI ;1.14.98
2 ;;7.0;ENGINEERING;**14,21,35,48**;Aug 17, 1993
3POST2 ;No existing PM work order - Post directly to equip hist
4 S ENLKAHD="",ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) S:ENX1]"" ENLKAHD=^(ENX1,0)
5 G:ENLKAHD=""!($E(ENLKAHD)="*") POST21 I $E(ENLKAHD,1,2)="SP"!($E(ENLKAHD,3,8)[" EE") G POST21
6 I $E(ENLKAHD,1,4)="MOD:"!($E(ENLKAHD,1,4)="PM#:") G POST21
7 I $E(ENLKAHD,1,4)="TIME" G POST22
8 I ENLKAHD="FAILED" G POST23
9 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
10 Q
11 ;
12POST21 ;Device passed, no t&m
13 I ENDEL'="Y" K ENPMWO(0) S EN=21 D POST^ENBCPM6 Q:$D(ENPMWO(0))
14 S ENDTCP=DT,ENH=ENDTCP_"-P2"_U_ENPMWO_U_"P"_"^^^^^"_ENEMP_"^PM Inspection (Recorded via Bar Code Reader)",ENINV=ENEQ
15 L +^ENG(6914,ENEQ,6):5 I '$T S ENMSG="Skipping service history for Equipment ID#: "_ENEQ D XCPTN^ENBCPM2 Q
16 S ENPMEMP=ENEMP D EXT^ENEQHS S ENEMP=ENPMEMP
17 L -^ENG(6914,ENEQ,6)
18 Q
19 ;
20POST22 ;Device passed, t&m recorded
21 I ENDEL'="Y" S EN=22 K ENPMWO(0) D POST^ENBCPM6 Q:$D(ENPMWO(0))
22 S ENTIME=+$E(ENLKAHD,6,30) I ENTIME]"" S X=ENTIME,X(0)=2 D ROUND^ENLIB S ENTIME=+Y S:ENTIME<0 ENTIME=""
23 I $G(ENTIME)>0 S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
24 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:"")
25 S ENMATRL="" I $E(ENLKAHD,1,5)="MATRL" D
26 . S ENX=ENX1,^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD,ENMATRL=+$E(ENLKAHD,7,30) S:ENMATRL<0 ENMATRL=""
27 . S ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)),ENLKAHD=$S(ENX1]"":^(ENX1,0),1:"")
28 . I $E(ENLKAHD,1,5)="CODE:" D
29 .. S ENX=ENX1,^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
30 .. I $P(ENLKAHD,":",2)?1N N DIE,DA D
31 ... S DA=ENEQ,DIE="^ENG(6914,",DR="53///"_$P(ENLKAHD,":",2) D ^DIE
32 ... Q
33 I ENMATRL=+ENMATRL S X=ENMATRL,X(0)=2 D ROUND^ENLIB S ENMATRL=+Y
34 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
35 S X=ENX,ENWP=""
36 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
37 . S ENX=X,ENWP=ENWP_X1
38 . S ^PRCT(446.4,ENCTID,2,ENCTTI,1,X,0)="*"_X1
39 I ENWP]"",$L(ENWP)<130 S ENWP=ENWP_" (Bar Code)"
40 S:ENWP="" ENWP="PM Inspection (Recorded via Bar Code Reader)"
41 S ENDTCP=DT,ENH=ENDTCP_"-PM"_U_ENPMWO_U_"P"_U_ENTIME_U_ENLBR_U_ENMATRL_"^^"_ENEMP_U_ENWP,ENINV=ENEQ
42 L +^ENG(6914,ENEQ,6):5 I '$T S ENMSG="Skipping service history for Equipment ID#: "_ENINV D XCPTN^ENBCPM2 Q
43 S ENPMEMP=ENEMP D EXT^ENEQHS S ENEMP=ENPMEMP
44 L -^ENG(6914,ENEQ,6)
45 Q
46 ;
47POST23 ;Device failed
48 N PROBLEM S PROBLEM="Device failed a PM Inspection",ENTIME=""
49 S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
50 S ENX1=ENX+2,ENX=ENX+1,ENLKAHD=$S($D(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
51 S ENMSG="Equipment Entry # "_ENEQ_" FAILED PMI. CORRECTIVE ACTION REQUIRED."
52 S ENMSG(0,1)="This device has no open work order that begins with "_ENPMWO_"..."
53 S ENMSG(0,2)="Nothing is being posted to the equipment history."
54 S ENMSG(0,3)="NO STATEMENT OF PROBLEM."
55 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
56 . S ENX=ENX1,ENMSG(0,3)="Problem description: "_ENLKAHD
57 . S PROBLEM=ENLKAHD
58 . S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
59 . S ENX1=ENX1+1
60 . S ENLKAHD=$S($D(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)):^(0),1:"")
61 . I $E(ENLKAHD,1,4)="TIME" S ENX=ENX+1 D
62 .. S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX1,0)="*"_ENLKAHD
63 .. S ENTIME=+$E(ENLKAHD,6,30) I ENTIME>0 D
64 ... S ENMSG(0,3)=ENMSG(0,3)_" (Time: "_ENTIME_" hrs)"
65 ... S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
66NEWWO D NEWWO^ENBCPM9
67 Q
68 ;
69HOLD I $E(IOST,1,2)="C-" W !,"Press RETURN to continue..." R X:DTIME
70 Q
71ERR ;Error message (Forced exit)
72 W !!,*7,"FATAL ERROR OR USER ABORT.",*7
73 W !,"Process ID is: ENPM Time stamp is: ",$S($D(ENCTTI):$P(^PRCT(446.4,ENCTID,2,ENCTTI,0),U,1),1:"UNDEFINED.")
74 W !,"Please make a note of this information, as you will need it to RESTART",!,"processing of the data on file."
75 S ENY=0 D HOLD
76EXIT I $E(IOST,1,2)="C-",$D(ENY),ENY>0 D HOLD
77 K EN,ENA,ENB,ENEQ,ENLBL,ENSTA,ENSTAL,ENMSG,ENCTTI,ENCTID,ENX,ENX1,ENY
78 K ENLOC,ENOLDLOC,ENLKAHD,ENTEC,ENEMP,ENPMEMP,ENPMTEC,ENPM,ENPMWO,ENSHABR,ENSHOP,ENDTCP,ENH,ENINV,ENPG,ENWOX,ENW,EN1,EN2
79 K %,I,J,K,ENTIME,ENMATRL,ENLBR,ENDATE,ENDEL,ENWP,DIC,DIE,DA,DR
80 W @IOF
81 I $E(IOST,1,2)="P-",'$D(ZTQUEUED) D ^%ZISC
82 S:$D(ZTQUEUED) ZTREQ="@"
83 Q
84 ;ENBCPM5
Note: See TracBrowser for help on using the repository browser.