Routine: ENBCPM4

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

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

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

 ;ENBCPM4

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM4   3654     printed  Mar 13, 2025@20:56:43                                                                                                                                                                                                     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

ENBCPM4.m