ENBCPM6 ;(WASH ISC)/DH-Bar Coded PMI Utilities ;4.9.97
;;7.0;ENGINEERING;**14,35**;Aug 17, 1993
MSG ;Opening message to user
W !!,"The system is now ready to update the Equipment File on the basis of",!,"data acquired from the portable bar code reader."
W !!,"Data that cannot be processed normally will be reported as Exception Messages."
W !,"These messages will provide notification of such things as missing bar code",!,"labels and database inconsistencies."
W !!,"Exception Messages will also be printed for devices that FAIL their PM"
W !,"inspection. Regular work orders will be automatically generated. The PM work",!,"order will be closed with a reference to the regular work order."
W !!,"You must now select a hard copy device (printer) to receive PMI Exception",!,"Messages."
W !!,"You may enter the letter 'Q' and then select a device if you wish to",!,"schedule this data processing task for some later time. You may enter the"
W !,"caret key ('^') to abort this update with the intention of manually re-",!,"starting it at some later date.",!
Q
;
WOCHK ; Has PM already been posted?
; Expects ENEQ as IEN to Equipment File
;
F I=0:0 S I=$O(^ENG(6914,ENEQ,6,I)) Q:I'>0 I $P(^ENG(6914,ENEQ,6,I,0),U,2)[ENPMWO S ENWOX=1
I 'ENWOX Q ;Nothing recorded
S ENMSG="PM Work Order already posted for Equipment ID#: "_ENEQ D XCPTN^ENBCPM2
Q
;
POST ; Retain PM work order
N ENDA
S ENPMWO(0)=$O(^ENG(6920,"B",ENPMWO_"-9999"),-1) S:ENPMWO(0)'[ENPMWO ENPMWO(0)=ENPMWO_"-001"
L +^ENG(6920,"B"):30 I '$T K ENPMWO(0) Q
POST1 I $D(^ENG(6920,"B",ENPMWO(0)))!($D(^ENG(6920,"H",ENPMWO(0)))) S J=+$P(ENPMWO(0),"-",3)+1 S:J?1.2N J=$S(J?1N:"00"_J,1:"0"_J) S ENPMWO(0)=ENPMWO_"-"_J G POST1
K DD,DO S DIC="^ENG(6920,",DIC(0)="LX",X=ENPMWO(0) D FILE^DICN S DA=+Y
L -^ENG(6920,"B")
I DA'>0 K ENPMWO(0) Q
S ENWP="UNSCHEDULED PMI (Bar Code Reader)"
S DIE="^ENG(6920,",DR=".05///^S X=ENPMWO(0);1///^S X=DT;3///^S X=ENLOC;6///^S X=""PM Inspection (Unscheduled)"";9///^S X=ENSHKEY;10///^S X=DT;18///^S X=ENEQ;35.2///^S X=""P"";39///^S X=ENWP"
D ^DIE
S ^ENG(6920,DA,8,0)="^6920.035PA^1^1",DIE="^ENG(6920,DA(1),8,",(ENDA,DA(1))=DA,DA=1,DR=".01///^S X=""PREVENTIVE MAINTENANCE""" D ^DIE K DA S DA=ENDA
I $G(EN)=21 D Q
. S ^ENG(6920,DA,7,0)="^6920.02PA^1^1",DIE="^ENG(6920,DA(1),7,",(ENDA,DA(1))=DA,DA=1,DR=".01///^S X=ENTEC;2///^S X=ENSHKEY" D ^DIE K DA S DA=ENDA
. K DR S DIE="^ENG(6920,",DR="36///^S X=DT;32///^S X=""COMPLETED""" D ^DIE
S ENTIME=+$E(ENLKAHD,6,30) I ENTIME]"" S X=ENTIME,X(0)=2 D ROUND^ENLIB S ENTIME=+Y S:ENTIME<0 ENTIME="" S:ENTIME>0 $P(^ENG(6920,DA,5),U,3)=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=""
. I ENMATRL=+ENMATRL S X=ENMATRL,X(0)=2 D ROUND^ENLIB S ENMATRL=+Y
. 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
S X=ENX,ENWP=""
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)"
I ENWP="" S ENWP="UNSCHEDULED PMI (Bar Code Reader)"
I ENTIME>0 S ENW=$P($G(^ENG("EMP",ENTEC,0)),U,3) D
. I ENW'>0 S ENW=$P($G(^DIC(6910,1,0)),U,4)
. I ENW>0 S $P(^ENG(6920,DA,5),U,6)=ENW*ENTIME
S ^ENG(6920,DA,7,0)="^6920.02PA^1^1",DIE="^ENG(6920,DA(1),7,",(ENDA,DA(1))=DA,DA=1,DR=".01///^S X=ENTEC;1///^S X=ENTIME;2///^S X=ENSHKEY" D ^DIE K DA S DA=ENDA
K DR S DIE="^ENG(6920,",DR="38///^S X=ENMATRL;39///^S X=ENWP;36///^S X=DT;32///^S X=""COMPLETED""" D ^DIE
I $G(ENTIME)>0 S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
Q
;ENBCPM6
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM6 4224 printed Oct 16, 2024@17:52:54 Page 2
ENBCPM6 ;(WASH ISC)/DH-Bar Coded PMI Utilities ;4.9.97
+1 ;;7.0;ENGINEERING;**14,35**;Aug 17, 1993
MSG ;Opening message to user
+1 WRITE !!,"The system is now ready to update the Equipment File on the basis of",!,"data acquired from the portable bar code reader."
+2 WRITE !!,"Data that cannot be processed normally will be reported as Exception Messages."
+3 WRITE !,"These messages will provide notification of such things as missing bar code",!,"labels and database inconsistencies."
+4 WRITE !!,"Exception Messages will also be printed for devices that FAIL their PM"
+5 WRITE !,"inspection. Regular work orders will be automatically generated. The PM work",!,"order will be closed with a reference to the regular work order."
+6 WRITE !!,"You must now select a hard copy device (printer) to receive PMI Exception",!,"Messages."
+7 WRITE !!,"You may enter the letter 'Q' and then select a device if you wish to",!,"schedule this data processing task for some later time. You may enter the"
+8 WRITE !,"caret key ('^') to abort this update with the intention of manually re-",!,"starting it at some later date.",!
+9 QUIT
+10 ;
WOCHK ; Has PM already been posted?
+1 ; Expects ENEQ as IEN to Equipment File
+2 ;
+3 FOR I=0:0
SET I=$ORDER(^ENG(6914,ENEQ,6,I))
if I'>0
QUIT
IF $PIECE(^ENG(6914,ENEQ,6,I,0),U,2)[ENPMWO
SET ENWOX=1
+4 ;Nothing recorded
IF 'ENWOX
QUIT
+5 SET ENMSG="PM Work Order already posted for Equipment ID#: "_ENEQ
DO XCPTN^ENBCPM2
+6 QUIT
+7 ;
POST ; Retain PM work order
+1 NEW ENDA
+2 SET ENPMWO(0)=$ORDER(^ENG(6920,"B",ENPMWO_"-9999"),-1)
if ENPMWO(0)'[ENPMWO
SET ENPMWO(0)=ENPMWO_"-001"
+3 LOCK +^ENG(6920,"B"):30
IF '$TEST
KILL ENPMWO(0)
QUIT
POST1 IF $DATA(^ENG(6920,"B",ENPMWO(0)))!($DATA(^ENG(6920,"H",ENPMWO(0))))
SET J=+$PIECE(ENPMWO(0),"-",3)+1
if J?1.2N
SET J=$SELECT(J?1N:"00"_J,1:"0"_J)
SET ENPMWO(0)=ENPMWO_"-"_J
GOTO POST1
+1 KILL DD,DO
SET DIC="^ENG(6920,"
SET DIC(0)="LX"
SET X=ENPMWO(0)
DO FILE^DICN
SET DA=+Y
+2 LOCK -^ENG(6920,"B")
+3 IF DA'>0
KILL ENPMWO(0)
QUIT
+4 SET ENWP="UNSCHEDULED PMI (Bar Code Reader)"
+5 SET DIE="^ENG(6920,"
SET DR=".05///^S X=ENPMWO(0);1///^S X=DT;3///^S X=ENLOC;6///^S X=""PM Inspection (Unscheduled)"";9///^S X=ENSHKEY;10///^S X=DT;18///^S X=ENEQ;35.2///^S X=""P"";39///^S X=ENWP"
+6 DO ^DIE
+7 SET ^ENG(6920,DA,8,0)="^6920.035PA^1^1"
SET DIE="^ENG(6920,DA(1),8,"
SET (ENDA,DA(1))=DA
SET DA=1
SET DR=".01///^S X=""PREVENTIVE MAINTENANCE"""
DO ^DIE
KILL DA
SET DA=ENDA
+8 IF $GET(EN)=21
Begin DoDot:1
+9 SET ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
SET DIE="^ENG(6920,DA(1),7,"
SET (ENDA,DA(1))=DA
SET DA=1
SET DR=".01///^S X=ENTEC;2///^S X=ENSHKEY"
DO ^DIE
KILL DA
SET DA=ENDA
+10 KILL DR
SET DIE="^ENG(6920,"
SET DR="36///^S X=DT;32///^S X=""COMPLETED"""
DO ^DIE
End DoDot:1
QUIT
+11 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=""
if ENTIME>0
SET $PIECE(^ENG(6920,DA,5),U,3)=ENTIME
+12 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:"")
+13 SET ENMATRL=""
IF $EXTRACT(ENLKAHD,1,5)="MATRL"
Begin DoDot:1
+14 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=""
+15 IF ENMATRL=+ENMATRL
SET X=ENMATRL
SET X(0)=2
DO ROUND^ENLIB
SET ENMATRL=+Y
+16 SET ENX1=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
SET ENLKAHD=$SELECT(ENX1]"":^(ENX1,0),1:"")
+17 IF $EXTRACT(ENLKAHD,1,5)="CODE:"
Begin DoDot:2
+18 SET ENX=ENX1
SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
+19 IF $PIECE(ENLKAHD,":",2)?1N
NEW DIE,DA
Begin DoDot:3
+20 SET DA=ENEQ
SET DIE="^ENG(6914,"
SET DR="53///"_$PIECE(ENLKAHD,":",2)
DO ^DIE
+21 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+22 SET X=ENX
SET ENWP=""
+23 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
+24 SET ENX=X
SET ENWP=ENWP_X1
+25 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,X,0)="*"_X1
End DoDot:1
+26 IF ENWP]""
IF $LENGTH(ENWP)<130
SET ENWP=ENWP_" (Bar Code)"
+27 IF ENWP=""
SET ENWP="UNSCHEDULED PMI (Bar Code Reader)"
+28 IF ENTIME>0
SET ENW=$PIECE($GET(^ENG("EMP",ENTEC,0)),U,3)
Begin DoDot:1
+29 IF ENW'>0
SET ENW=$PIECE($GET(^DIC(6910,1,0)),U,4)
+30 IF ENW>0
SET $PIECE(^ENG(6920,DA,5),U,6)=ENW*ENTIME
End DoDot:1
+31 SET ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
SET DIE="^ENG(6920,DA(1),7,"
SET (ENDA,DA(1))=DA
SET DA=1
SET DR=".01///^S X=ENTEC;1///^S X=ENTIME;2///^S X=ENSHKEY"
DO ^DIE
KILL DA
SET DA=ENDA
+32 KILL DR
SET DIE="^ENG(6920,"
SET DR="38///^S X=ENMATRL;39///^S X=ENWP;36///^S X=DT;32///^S X=""COMPLETED"""
DO ^DIE
+33 IF $GET(ENTIME)>0
SET PMTOT(ENSHKEY,ENTEC)=$GET(PMTOT(ENSHKEY,ENTEC))+ENTIME
+34 QUIT
+35 ;ENBCPM6
