Routine: ENBCPM6

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.",!

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

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

 ;ENBCPM6

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

ENBCPM6.m