ENBCPM1 ;(WASH ISC)/DH-Record Bar Coded PMI ;1/9/2001
;;7.0;ENGINEERING;**10,14,21,32,35,68**;Aug 17, 1993
DNLD ;Get PM Inspector
S ENEMP="",DIC="^ENG(""EMP"",",DIC(0)="AEQMZ",DIC("A")="Select PM Inspector: ",DIC("S")="I $P(^(0),U,7)'=""V""" D ^DIC S:Y>0 ENEMP=$P(Y(0),U,1) K DIC
I ENEMP]"",$O(^ENG("EMP","B",ENEMP,+Y))]"" S ENEMP=+Y
I ENEMP]"" S ENEMP=""""_ENEMP_"""" D ^ENCTBAR
Q
RES ;Restart an aborted process
S X="",ENY=0 W !!,"Enter PROCESS ID: " R X:DTIME G:X="^"!(X="") EXIT S ENCTID=$O(^PRCT(446.4,"C",X,"")) I ENCTID="" W !!,*7,"Wrong application. Aborting..." D HOLD G EXIT
S X="" W !!,"Enter TIME STAMP of process to be restarted: " R X:DTIME G:X="^"!(X="") EXIT S ENCTTI=$O(^PRCT(446.4,ENCTID,2,"B",X,"")) I ENCTTI="" W !!,"NO DATA. Aborting..." D HOLD G EXIT
EN ;Main entry point. Expects ENCTID and ENCTTI.
;Normally called by ENCTBAR.
G:'$D(ENCTID) ERR^ENBCPM5
S ENCTTI(0)=$P(^PRCT(446.4,ENCTID,2,ENCTTI,0),U)
S ENSTA=$P($G(^DIC(6910,1,0)),U,2),ENSTAL=$L(ENSTA)
I ENSTA="" W !!,"Can't seem to find your STATION NUMBER. Please check File 6910.",!,"Your IRM staff may need to assist you.",*7 G ERR^ENBCPM5
F I=1,2,3,4,5,6,7,8 S ENSTA(I)="",ENSTAL(I)=0
I $G(^DIC(6910,1,3,0))]"" D
. S (I,ENX)=0 F S ENX=$O(^DIC(6910,1,3,ENX)) Q:'ENX!(I>8) D
.. S I=I+1,ENSTA(I)=$P(^DIC(6910,1,3,ENX,0),U)
.. S ENSTAL(I)=$L(ENSTA(I))
I '$D(DT) S U="^",%DT="",X="T" D ^%DT S DT=+Y S:'$D(DTIME) DTIME=600
S Y=DT X ^DD("DD") S ENDATE=Y
W !! S Y=$E(DT,1,5)_"00" X ^DD("DD") S %DT("A")="For which month do you wish to record PMI's: ",%DT("B")=Y,%DT="AEPMX" D ^%DT G:Y'>0 ERR^ENBCPM5 S ENPMDT=$E(Y,2,5),ENPM="M"
MORW W !,"Are you recording a MONTHLY (as opposed to a WEEKLY) worklist" S %=1 D YN^DICN G:%<0 ERR^ENBCPM5 G:%=0 MORW I %=1 G EN1
WEEK R !,"Week number (enter an integer from 1 to 5): ",X:DTIME G:X="^" ERR^ENBCPM5 I X?1N,X>0,X<6 S ENPM="W"_X G EN1
W "??",*7 G WEEK
EN1 S DIC="^DIC(6922,",DIC(0)="AEMQ" D ^DIC G:Y'>0 ERR^ENBCPM5 S ENSHKEY=+Y,ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1),ENSHABR=$P(^(0),U,2)
S ENPMWO="PM-"_ENSHABR_ENPMDT_ENPM
EN2 S ENDEL="" I $D(^DIC(6910,1,0)) S ENDEL=$P(^(0),U,5)
I ENDEL="" R !,"Should existing PM work orders be deleted after close out? YES// ",X:DTIME G:X="^" ERR^ENBCPM5 S:X=""!("Yy"[$E(X)) ENDEL="Y"
I ENDEL="","Nn"'[$E(X) D COBH1^ENEQPMR4 G EN2
CONT ;Physical processing of uploaded data
N PMTOT
S (ENY,ENPG)=0,ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,0)) I ENX'>0 D HDR^ENBCPM2 W *7,!!,"No data to process." D:$E(IOST,1,2)="C-" HOLD G EXIT
S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) ;ignore file ID
S ENTEC="",ENEMP=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0),ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) I ENEMP?.N S ENTEC=ENEMP S ENEMP=$P($G(^ENG("EMP",ENTEC,0)),U)
S DIR(0)="P^6929:AEQM^I Y>0,$P(^ENG(""EMP"",+Y,0),U,7)=""V"" K X D EN^DDIOL(""VACATED positions may not be selected."")"
S DIR("A",1)="This bar code PMI program was downloaded for "_ENEMP_"."
S DIR("A")="Who actually did the work? ",DIR("B")=ENEMP
S DIR("?",1)="If "_ENEMP_" performed the PMI, just press <RETURN>."
S DIR("?",2)="If you choose another technician, that individual will become the technician"
S DIR("?",3)="of record in both the Work Order and Equipment Files."
S DIR("?",4)=" "
S DIR("?",5)="If more than one technician worked on a PMI then you should either close that"
S DIR("?",6)="PM work order individually (before continuing with this update) or perhaps"
S DIR("?",7)="use teams in your PMI program. If you want to abort this update and come back"
S DIR("?",8)="to it after closing selected work orders manually (via the 'Close Out PM Work"
S DIR("?",9)="Order' option), press the caret key ('^') and be sure to write down the"
S DIR("?")="'Process ID' and 'Time stamp' that the system will give you."
D ^DIR K DIR G:Y'>0!($D(DIRUT)) ERR^ENBCPM5
S ENTEC=+Y,ENEMP=$P(Y,U,2)
;
DEV D MSG^ENBCPM6
S %ZIS="Q",%ZIS("A")="Select Device for PMI Exception Messages: " D ^%ZIS K %ZIS G:POP ERR^ENBCPM5
G:$D(IO("Q")) ZTSK^ENBCPM2
;
NEWLOC ;Beginning of a specific location
S ENLBL=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0),ENLOC=$E(ENLBL,3,50) I $E(ENLBL,1,2)'="SP" S ENMSG="LOCATION EXPECTED." D XCPTN^ENBCPM2 S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) G:ENX'>0 EXIT G NEWLOC
I ENLOC[" " S ENLOC=$P(ENLOC," ")
S X=$L(ENLOC) I $E(ENLOC,X)=" " S ENLOC=$E(ENLOC,1,(X-1))
NEWNX ;Process a piece of equipment
S (ENTIME,ENMATRL)=""
S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) G:ENX'>0 DONE S (ENEQ,ENLBL)=^(ENX,0) G:$E(ENLBL)="*" NEWNX
I $E(ENEQ,1,2)="SP" K ENEQ G NEWLOC
S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENEQ
I $E(ENEQ,1,4)="MOD:" D NOLBL^ENBCPM3 G NEWNX
I $E(ENEQ,1,4)="PM#:" D PMN^ENBCPM3 G NEWNX
I $E(ENEQ,3,8)[" EE",$P(ENEQ," ")'=ENSTA D I $D(ENMSG) D XCPTN^ENBCPM2 G NEWNX
. K ENMSG S ENMSG="FOREIGN EQUIPMENT."
. F I=1:1:8 I ENSTAL(I),$E(ENEQ,1,ENSTAL(I))=ENSTA(I) K ENMSG Q
. I $D(ENMSG) S ENMSG(0,1)="Cannot process a bar code label from another VAMC."
S ENEQ=$S($D(^ENG(6914,"OEE",ENLBL)):$O(^(ENLBL,0)),1:+$P(ENLBL,"EE",2))
I ENEQ>0 D UPDATE^ENBCPM2,POST^ENBCPM4
G NEWNX
;
HOLD I $E(IOST,1,2)="C-" W !,"Press RETURN to continue..." R X:DTIME
Q
DONE ;Delete DATE/TIME OF DATA UPLOAD
;K DA,DIK S DIK="^PRCT(446.4,"_ENCTID_",2,",DA(1)=ENCTID,DA=ENCTTI
;D ^DIK
;K DIK
EXIT D:$D(PMTOT) ^ENBCPM8 G EXIT^ENBCPM5
;ENBCPM1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM1 5389 printed Sep 23, 2025@19:28:03 Page 2
ENBCPM1 ;(WASH ISC)/DH-Record Bar Coded PMI ;1/9/2001
+1 ;;7.0;ENGINEERING;**10,14,21,32,35,68**;Aug 17, 1993
DNLD ;Get PM Inspector
+1 SET ENEMP=""
SET DIC="^ENG(""EMP"","
SET DIC(0)="AEQMZ"
SET DIC("A")="Select PM Inspector: "
SET DIC("S")="I $P(^(0),U,7)'=""V"""
DO ^DIC
if Y>0
SET ENEMP=$PIECE(Y(0),U,1)
KILL DIC
+2 IF ENEMP]""
IF $ORDER(^ENG("EMP","B",ENEMP,+Y))]""
SET ENEMP=+Y
+3 IF ENEMP]""
SET ENEMP=""""_ENEMP_""""
DO ^ENCTBAR
+4 QUIT
RES ;Restart an aborted process
+1 SET X=""
SET ENY=0
WRITE !!,"Enter PROCESS ID: "
READ X:DTIME
if X="^"!(X="")
GOTO EXIT
SET ENCTID=$ORDER(^PRCT(446.4,"C",X,""))
IF ENCTID=""
WRITE !!,*7,"Wrong application. Aborting..."
DO HOLD
GOTO EXIT
+2 SET X=""
WRITE !!,"Enter TIME STAMP of process to be restarted: "
READ X:DTIME
if X="^"!(X="")
GOTO EXIT
SET ENCTTI=$ORDER(^PRCT(446.4,ENCTID,2,"B",X,""))
IF ENCTTI=""
WRITE !!,"NO DATA. Aborting..."
DO HOLD
GOTO EXIT
EN ;Main entry point. Expects ENCTID and ENCTTI.
+1 ;Normally called by ENCTBAR.
+2 if '$DATA(ENCTID)
GOTO ERR^ENBCPM5
+3 SET ENCTTI(0)=$PIECE(^PRCT(446.4,ENCTID,2,ENCTTI,0),U)
+4 SET ENSTA=$PIECE($GET(^DIC(6910,1,0)),U,2)
SET ENSTAL=$LENGTH(ENSTA)
+5 IF ENSTA=""
WRITE !!,"Can't seem to find your STATION NUMBER. Please check File 6910.",!,"Your IRM staff may need to assist you.",*7
GOTO ERR^ENBCPM5
+6 FOR I=1,2,3,4,5,6,7,8
SET ENSTA(I)=""
SET ENSTAL(I)=0
+7 IF $GET(^DIC(6910,1,3,0))]""
Begin DoDot:1
+8 SET (I,ENX)=0
FOR
SET ENX=$ORDER(^DIC(6910,1,3,ENX))
if 'ENX!(I>8)
QUIT
Begin DoDot:2
+9 SET I=I+1
SET ENSTA(I)=$PIECE(^DIC(6910,1,3,ENX,0),U)
+10 SET ENSTAL(I)=$LENGTH(ENSTA(I))
End DoDot:2
End DoDot:1
+11 IF '$DATA(DT)
SET U="^"
SET %DT=""
SET X="T"
DO ^%DT
SET DT=+Y
if '$DATA(DTIME)
SET DTIME=600
+12 SET Y=DT
XECUTE ^DD("DD")
SET ENDATE=Y
+13 WRITE !!
SET Y=$EXTRACT(DT,1,5)_"00"
XECUTE ^DD("DD")
SET %DT("A")="For which month do you wish to record PMI's: "
SET %DT("B")=Y
SET %DT="AEPMX"
DO ^%DT
if Y'>0
GOTO ERR^ENBCPM5
SET ENPMDT=$EXTRACT(Y,2,5)
SET ENPM="M"
MORW WRITE !,"Are you recording a MONTHLY (as opposed to a WEEKLY) worklist"
SET %=1
DO YN^DICN
if %<0
GOTO ERR^ENBCPM5
if %=0
GOTO MORW
IF %=1
GOTO EN1
WEEK READ !,"Week number (enter an integer from 1 to 5): ",X:DTIME
if X="^"
GOTO ERR^ENBCPM5
IF X?1N
IF X>0
IF X<6
SET ENPM="W"_X
GOTO EN1
+1 WRITE "??",*7
GOTO WEEK
EN1 SET DIC="^DIC(6922,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y'>0
GOTO ERR^ENBCPM5
SET ENSHKEY=+Y
SET ENSHOP=$PIECE(^DIC(6922,ENSHKEY,0),U,1)
SET ENSHABR=$PIECE(^(0),U,2)
+1 SET ENPMWO="PM-"_ENSHABR_ENPMDT_ENPM
EN2 SET ENDEL=""
IF $DATA(^DIC(6910,1,0))
SET ENDEL=$PIECE(^(0),U,5)
+1 IF ENDEL=""
READ !,"Should existing PM work orders be deleted after close out? YES// ",X:DTIME
if X="^"
GOTO ERR^ENBCPM5
if X=""!("Yy"[$EXTRACT(X))
SET ENDEL="Y"
+2 IF ENDEL=""
IF "Nn"'[$EXTRACT(X)
DO COBH1^ENEQPMR4
GOTO EN2
CONT ;Physical processing of uploaded data
+1 NEW PMTOT
+2 SET (ENY,ENPG)=0
SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,0))
IF ENX'>0
DO HDR^ENBCPM2
WRITE *7,!!,"No data to process."
if $EXTRACT(IOST,1,2)="C-"
DO HOLD
GOTO EXIT
+3 ;ignore file ID
SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
+4 SET ENTEC=""
SET ENEMP=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)
SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
IF ENEMP?.N
SET ENTEC=ENEMP
SET ENEMP=$PIECE($GET(^ENG("EMP",ENTEC,0)),U)
+5 SET DIR(0)="P^6929:AEQM^I Y>0,$P(^ENG(""EMP"",+Y,0),U,7)=""V"" K X D EN^DDIOL(""VACATED positions may not be selected."")"
+6 SET DIR("A",1)="This bar code PMI program was downloaded for "_ENEMP_"."
+7 SET DIR("A")="Who actually did the work? "
SET DIR("B")=ENEMP
+8 SET DIR("?",1)="If "_ENEMP_" performed the PMI, just press <RETURN>."
+9 SET DIR("?",2)="If you choose another technician, that individual will become the technician"
+10 SET DIR("?",3)="of record in both the Work Order and Equipment Files."
+11 SET DIR("?",4)=" "
+12 SET DIR("?",5)="If more than one technician worked on a PMI then you should either close that"
+13 SET DIR("?",6)="PM work order individually (before continuing with this update) or perhaps"
+14 SET DIR("?",7)="use teams in your PMI program. If you want to abort this update and come back"
+15 SET DIR("?",8)="to it after closing selected work orders manually (via the 'Close Out PM Work"
+16 SET DIR("?",9)="Order' option), press the caret key ('^') and be sure to write down the"
+17 SET DIR("?")="'Process ID' and 'Time stamp' that the system will give you."
+18 DO ^DIR
KILL DIR
if Y'>0!($DATA(DIRUT))
GOTO ERR^ENBCPM5
+19 SET ENTEC=+Y
SET ENEMP=$PIECE(Y,U,2)
+20 ;
DEV DO MSG^ENBCPM6
+1 SET %ZIS="Q"
SET %ZIS("A")="Select Device for PMI Exception Messages: "
DO ^%ZIS
KILL %ZIS
if POP
GOTO ERR^ENBCPM5
+2 if $DATA(IO("Q"))
GOTO ZTSK^ENBCPM2
+3 ;
NEWLOC ;Beginning of a specific location
+1 SET ENLBL=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)
SET ENLOC=$EXTRACT(ENLBL,3,50)
IF $EXTRACT(ENLBL,1,2)'="SP"
SET ENMSG="LOCATION EXPECTED."
DO XCPTN^ENBCPM2
SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
if ENX'>0
GOTO EXIT
GOTO NEWLOC
+2 IF ENLOC[" "
SET ENLOC=$PIECE(ENLOC," ")
+3 SET X=$LENGTH(ENLOC)
IF $EXTRACT(ENLOC,X)=" "
SET ENLOC=$EXTRACT(ENLOC,1,(X-1))
NEWNX ;Process a piece of equipment
+1 SET (ENTIME,ENMATRL)=""
+2 SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
if ENX'>0
GOTO DONE
SET (ENEQ,ENLBL)=^(ENX,0)
if $EXTRACT(ENLBL)="*"
GOTO NEWNX
+3 IF $EXTRACT(ENEQ,1,2)="SP"
KILL ENEQ
GOTO NEWLOC
+4 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENEQ
+5 IF $EXTRACT(ENEQ,1,4)="MOD:"
DO NOLBL^ENBCPM3
GOTO NEWNX
+6 IF $EXTRACT(ENEQ,1,4)="PM#:"
DO PMN^ENBCPM3
GOTO NEWNX
+7 IF $EXTRACT(ENEQ,3,8)[" EE"
IF $PIECE(ENEQ," ")'=ENSTA
Begin DoDot:1
+8 KILL ENMSG
SET ENMSG="FOREIGN EQUIPMENT."
+9 FOR I=1:1:8
IF ENSTAL(I)
IF $EXTRACT(ENEQ,1,ENSTAL(I))=ENSTA(I)
KILL ENMSG
QUIT
+10 IF $DATA(ENMSG)
SET ENMSG(0,1)="Cannot process a bar code label from another VAMC."
End DoDot:1
IF $DATA(ENMSG)
DO XCPTN^ENBCPM2
GOTO NEWNX
+11 SET ENEQ=$SELECT($DATA(^ENG(6914,"OEE",ENLBL)):$ORDER(^(ENLBL,0)),1:+$PIECE(ENLBL,"EE",2))
+12 IF ENEQ>0
DO UPDATE^ENBCPM2
DO POST^ENBCPM4
+13 GOTO NEWNX
+14 ;
HOLD IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Press RETURN to continue..."
READ X:DTIME
+1 QUIT
DONE ;Delete DATE/TIME OF DATA UPLOAD
+1 ;K DA,DIK S DIK="^PRCT(446.4,"_ENCTID_",2,",DA(1)=ENCTID,DA=ENCTTI
+2 ;D ^DIK
+3 ;K DIK
EXIT if $DATA(PMTOT)
DO ^ENBCPM8
GOTO EXIT^ENBCPM5
+1 ;ENBCPM1
