source: FOIAVistA/tag/r/ENGINEERING-EN/ENBCPM4.m@ 1642

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