ENBCPM4 ;(WASH ISC)/DH-Bar Coded PMI ;4.9.97
;;7.0;ENGINEERING;**9,35**;Aug 17, 1993
POST ;Post PMI to Equip Hist
Q:'$D(^ENG(6914,ENEQ)) ;Could be foreign equipment
S ENWOX=0 D WOCHK^ENBCPM6 ;Maybe work already posted
Q:ENWOX ;WO has been closed
S ENWP=""
F DA=0:0 S DA=$O(^ENG(6920,"G",ENEQ,DA)) Q:DA'>0 I $P(^ENG(6920,DA,0),U,1)[ENPMWO D POST1 Q
D:DA'>0 POST2^ENBCPM5
Q
;
POST1 ;PM work order to be closed
S ENLKAHD="",ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) S:ENX1]"" ENLKAHD=^(ENX1,0)
G:ENLKAHD=""!($E(ENLKAHD)="*") POST11 I $E(ENLKAHD,3,8)[" EE" G POST11
I $E(ENLKAHD,1,2)="SP"!($E(ENLKAHD,1,4)="MOD:")!($E(ENLKAHD,1,4)="PM#:") G POST11
I $E(ENLKAHD,1,4)="TIME" G POST12
I ENLKAHD="FAILED" G POST13^ENBCPM7
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
;
POST11 ;Device passed, no t&m
S ENTIME=$P($G(^ENG(6920,DA,5)),U,3),ENPMTEC=$P($G(^(2)),U,2)
L +^ENG(6920,DA):10 I '$T S ENMSG="Work order "_$P(^ENG(6920,DA,0),U,1)_" being edited by another user.",ENMSG(0,1)="Can't process." D XCPTN^ENBCPM2 Q
I ENTEC'=ENPMTEC S:'$D(^ENG(6920,DA,7)) ^ENG(6920,DA,7,0)="^6920.02PA^1^1^" S ^ENG(6920,DA,7,1,0)=ENTEC_U_ENTIME_U_ENSHKEY,$P(^ENG(6920,DA,2),U,2)=ENTEC
I ENTEC'=ENPMTEC,ENTIME]"" S ENW=$S($D(^ENG("EMP",ENTEC,0)):$P(^(0),U,3),1:"") S:ENW="" ENW=$S($D(^DIC(6910.1,1,0)):$P(^(0),U,4),1:"") I ENW]"" S $P(^ENG(6920,DA,5),U,6)=(ENW*ENTIME)
G RECRD1
;
POST12 ;Device passed, t&m recorded
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=""
. 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 $P($G(^ENG(6920,DA,2)),U,2)'=ENTEC S $P(^(2),U,2)=ENTEC D
. S:'$D(^ENG(6920,DA,7)) ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
. S ^ENG(6920,DA,7,1,0)=ENTEC_U_ENTIME_U_ENSHKEY
S X=ENX
F S X=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,X)) Q:X="" S X1=^(X,0) Q:X1=""!($E(X1)="*")!($E(X1,1,2)="SP")!($E(X1,1,4)="MOD:")!($E(X1,1,4)="PM#:")!($E(X1,3,8)[" EE") S ENX=X,ENWP=ENWP_X1,^(0)="*"_X1
L +^ENG(6920,DA):5 I '$T S ENMSG="Work order "_$P(^ENG(6920,DA,0),U,1)_" being edited by another user.",ENMSG(0,1)="Can't process." D XCPTN^ENBCPM2 Q
I ENMATRL=+ENMATRL S X=ENMATRL,X(0)=2 D ROUND^ENLIB S ENMATRL=+Y,$P(^ENG(6920,DA,5),U,4)=ENMATRL
G:ENTIME="" RECRD1 S ENW="" S ENW=$P($G(^ENG("EMP",ENTEC,0)),U,3) I ENW="",$D(^DIC(6910,1,0)) S ENW=$P(^(0),U,4)
S:ENW<0 ENW=0 S Y=$S(ENW]"":(ENW*ENTIME),1:""),$P(^ENG(6920,DA,5),U,6)=Y
;
RECRD1 ;
I ENWP="",$D(^ENG(6920,DA,5)) S ENWP=$P(^(5),U,7)
I $L(ENWP)<130 S ENWP=ENWP_" (Bar Code)"
S ENPMTEC=ENTEC,ENPMEMP=ENEMP,DIE="^ENG(6920,",DR="35.2///^S X=""P"";39///^S X=ENWP;36///^S X=DT;32///^S X=""COMPLETED"""
I $$GET1^DIQ(6920,DA,3)'=ENLOC S DR=DR_";3///^S X=ENLOC"
D ^DIE
L -^ENG(6920,DA)
I ENDEL="Y",$E(^ENG(6920,DA,0),1,3)="PM-" S DIK="^ENG(6920," D ^DIK
S ENTEC=ENPMTEC,ENEMP=ENPMEMP K EN
I $G(ENTIME)>0 S PMTOT(ENSHKEY,ENTEC)=$G(PMTOT(ENSHKEY,ENTEC))+ENTIME
Q
;ENBCPM4
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM4 3654 printed Oct 16, 2024@17:52:52 Page 2
ENBCPM4 ;(WASH ISC)/DH-Bar Coded PMI ;4.9.97
+1 ;;7.0;ENGINEERING;**9,35**;Aug 17, 1993
POST ;Post PMI to Equip Hist
+1 ;Could be foreign equipment
if '$DATA(^ENG(6914,ENEQ))
QUIT
+2 ;Maybe work already posted
SET ENWOX=0
DO WOCHK^ENBCPM6
+3 ;WO has been closed
if ENWOX
QUIT
+4 SET ENWP=""
+5 FOR DA=0:0
SET DA=$ORDER(^ENG(6920,"G",ENEQ,DA))
if DA'>0
QUIT
IF $PIECE(^ENG(6920,DA,0),U,1)[ENPMWO
DO POST1
QUIT
+6 if DA'>0
DO POST2^ENBCPM5
+7 QUIT
+8 ;
POST1 ;PM work order to be closed
+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 POST11
IF $EXTRACT(ENLKAHD,3,8)[" EE"
GOTO POST11
+3 IF $EXTRACT(ENLKAHD,1,2)="SP"!($EXTRACT(ENLKAHD,1,4)="MOD:")!($EXTRACT(ENLKAHD,1,4)="PM#:")
GOTO POST11
+4 IF $EXTRACT(ENLKAHD,1,4)="TIME"
GOTO POST12
+5 IF ENLKAHD="FAILED"
GOTO POST13^ENBCPM7
+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 ;
POST11 ;Device passed, no t&m
+1 SET ENTIME=$PIECE($GET(^ENG(6920,DA,5)),U,3)
SET ENPMTEC=$PIECE($GET(^(2)),U,2)
+2 LOCK +^ENG(6920,DA):10
IF '$TEST
SET ENMSG="Work order "_$PIECE(^ENG(6920,DA,0),U,1)_" being edited by another user."
SET ENMSG(0,1)="Can't process."
DO XCPTN^ENBCPM2
QUIT
+3 IF ENTEC'=ENPMTEC
if '$DATA(^ENG(6920,DA,7))
SET ^ENG(6920,DA,7,0)="^6920.02PA^1^1^"
SET ^ENG(6920,DA,7,1,0)=ENTEC_U_ENTIME_U_ENSHKEY
SET $PIECE(^ENG(6920,DA,2),U,2)=ENTEC
+4 IF ENTEC'=ENPMTEC
IF ENTIME]""
SET ENW=$SELECT($DATA(^ENG("EMP",ENTEC,0)):$PIECE(^(0),U,3),1:"")
if ENW=""
SET ENW=$SELECT($DATA(^DIC(6910.1,1,0)):$PIECE(^(0),U,4),1:"")
IF ENW]""
SET $PIECE(^ENG(6920,DA,5),U,6)=(ENW*ENTIME)
+5 GOTO RECRD1
+6 ;
POST12 ;Device passed, t&m recorded
+1 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
+2 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:"")
+3 SET ENMATRL=""
IF $EXTRACT(ENLKAHD,1,5)="MATRL"
Begin DoDot:1
+4 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=""
+5 SET ENX1=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
SET ENLKAHD=$SELECT(ENX1]"":^(ENX1,0),1:"")
+6 IF $EXTRACT(ENLKAHD,1,5)="CODE:"
Begin DoDot:2
+7 SET ENX=ENX1
SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
+8 IF $PIECE(ENLKAHD,":",2)?1N
NEW DIE,DA
Begin DoDot:3
+9 SET DA=ENEQ
SET DIE="^ENG(6914,"
SET DR="53///"_$PIECE(ENLKAHD,":",2)
DO ^DIE
+10 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+11 IF $PIECE($GET(^ENG(6920,DA,2)),U,2)'=ENTEC
SET $PIECE(^(2),U,2)=ENTEC
Begin DoDot:1
+12 if '$DATA(^ENG(6920,DA,7))
SET ^ENG(6920,DA,7,0)="^6920.02PA^1^1"
+13 SET ^ENG(6920,DA,7,1,0)=ENTEC_U_ENTIME_U_ENSHKEY
End DoDot:1
+14 SET X=ENX
+15 FOR
SET X=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,X))
if X=""
QUIT
SET X1=^(X,0)
if X1=""!($EXTRACT(X1)="*")!($EXTRACT(X1,1,2)="SP")!($EXTRACT(X1,1,4)="MOD
QUIT
SET ENX=X
SET ENWP=ENWP_X1
SET ^(0)="*"_X1
+16 LOCK +^ENG(6920,DA):5
IF '$TEST
SET ENMSG="Work order "_$PIECE(^ENG(6920,DA,0),U,1)_" being edited by another user."
SET ENMSG(0,1)="Can't process."
DO XCPTN^ENBCPM2
QUIT
+17 IF ENMATRL=+ENMATRL
SET X=ENMATRL
SET X(0)=2
DO ROUND^ENLIB
SET ENMATRL=+Y
SET $PIECE(^ENG(6920,DA,5),U,4)=ENMATRL
+18 if ENTIME=""
GOTO RECRD1
SET ENW=""
SET ENW=$PIECE($GET(^ENG("EMP",ENTEC,0)),U,3)
IF ENW=""
IF $DATA(^DIC(6910,1,0))
SET ENW=$PIECE(^(0),U,4)
+19 if ENW<0
SET ENW=0
SET Y=$SELECT(ENW]"":(ENW*ENTIME),1:"")
SET $PIECE(^ENG(6920,DA,5),U,6)=Y
+20 ;
RECRD1 ;
+1 IF ENWP=""
IF $DATA(^ENG(6920,DA,5))
SET ENWP=$PIECE(^(5),U,7)
+2 IF $LENGTH(ENWP)<130
SET ENWP=ENWP_" (Bar Code)"
+3 SET ENPMTEC=ENTEC
SET ENPMEMP=ENEMP
SET DIE="^ENG(6920,"
SET DR="35.2///^S X=""P"";39///^S X=ENWP;36///^S X=DT;32///^S X=""COMPLETED"""
+4 IF $$GET1^DIQ(6920,DA,3)'=ENLOC
SET DR=DR_";3///^S X=ENLOC"
+5 DO ^DIE
+6 LOCK -^ENG(6920,DA)
+7 IF ENDEL="Y"
IF $EXTRACT(^ENG(6920,DA,0),1,3)="PM-"
SET DIK="^ENG(6920,"
DO ^DIK
+8 SET ENTEC=ENPMTEC
SET ENEMP=ENPMEMP
KILL EN
+9 IF $GET(ENTIME)>0
SET PMTOT(ENSHKEY,ENTEC)=$GET(PMTOT(ENSHKEY,ENTEC))+ENTIME
+10 QUIT
+11 ;ENBCPM4
