ENBCPM2 ;(WASH ISC)/DH-Bar Coded PMI ;4.9.97
;;7.0;ENGINEERING;**1,35**;Aug 17, 1993
UPDATE ; Update File 6914
N DIE,DA,DR,TAG
I '$D(^ENG(6914,ENEQ,0)) S ENMSG="ITEM NOT IN DATABASE.",ENMSG(0,1)="Label was scanned incorrectly or Equipment File is corrupted." D XCPTN Q
L +^ENG(6914,ENEQ):5 I '$T S ENMSG="RECORD LOCKED. Equipment ID#: "_ENEQ,ENMSG(0,1)="This record is being edited by another user at this time.",ENMSG(0,2)="Please update the inventory data manually." D XCPTN Q
S TAG="XCPTN^ENBCPM2" D FLAG^ENEQNX2
S ENOLDLOC=""
I $P($G(^ENG(6914,ENEQ,2)),U,13)=DT D I ENOLDLOC=ENLOC L -^ENG(6914,ENEQ) Q ;Record already updated
. S X=$P($G(^ENG(6914,ENEQ,3)),U,5) I X]"",X'["E",X=+X S ENOLDLOC=$P($G(^ENG("SP",X,0)),U)
. Q:ENLOC=ENOLDLOC
. I ENLOC["E" S ENOLDLOC=$TR(ENOLDLOC,"e","E")
S ENLOC(0)=ENLOC
I ENLOC]"",'$D(^ENG("SP","B",ENLOC)),ENLOC["E" F S ENLOC(0)=$P(ENLOC(0),"E")_"e"_$P(ENLOC(0),"E",2,99) I $D(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E") Q
I '$D(^ENG("SP","B",ENLOC(0))) L -^ENG(6914,ENEQ) S ENMSG="BAD LOCATION",ENMSG(0,1)="Location not in Space File. Can't update the Equipment Record." D XCPTN Q
S DIE="^ENG(6914,",DA=ENEQ,DR="24///^S X=ENLOC(0);23///^S X=DT"
D ^DIE L -^ENG(6914,ENEQ)
Q
;
XCPTN ; Print Exception Messages
U IO
D:ENY=0!(ENY>(IOSL-5)) HDR W !!,ENMSG,! W:$D(ENLBL) " Label scanned as: ",ENLBL W:$D(ENLOC) " Location: ",ENLOC S ENY=ENY+3
I $D(ENMSG(0)) F I=0:0 S I=$O(ENMSG(0,I)) Q:I'=+I W !,ENMSG(0,I) S ENY=ENY+1
K ENMSG
Q
;
HDR ; New page for exception printing
U IO
I IO=IO(0),$E(IOST,1,2)="C-",ENY>0 D HOLD
I ENPG!($E(IOST,1,2)="C-") W @IOF
S ENPG=ENPG+1
W "BAR CODED PMI EXCEPTION MESSAGES (Time stamp: "_ENCTTI(0)_")",?(IOM-8),ENDATE
W !," Global Reference: ^PRCT(446.4,"_ENCTID_",2,"_ENCTTI_",1,",?(IOM-10),"Page ",ENPG
K X S $P(X,"-",(IOM-1))="-" W !,X
S ENY=4
Q
HOLD I $E(IOST,1,2)="C-" W !,"Press RETURN to continue..." R X:DTIME
Q
ZTSK ;Schedule processing for later time (from ENBCPM1)
K IO("Q") S ZTIO=IO,ZTRTN="NEWLOC^ENBCPM1",ZTDESC="Record PMI (Bar code)",ZTSAVE("EN*")="",ZTSAVE("DT")=""
D ^%ZTLOAD K ZTSK
G EXIT^ENBCPM5
;ENBCPM2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM2 2176 printed Apr 09, 2024@20:57:37 Page 2
ENBCPM2 ;(WASH ISC)/DH-Bar Coded PMI ;4.9.97
+1 ;;7.0;ENGINEERING;**1,35**;Aug 17, 1993
UPDATE ; Update File 6914
+1 NEW DIE,DA,DR,TAG
+2 IF '$DATA(^ENG(6914,ENEQ,0))
SET ENMSG="ITEM NOT IN DATABASE."
SET ENMSG(0,1)="Label was scanned incorrectly or Equipment File is corrupted."
DO XCPTN
QUIT
+3 LOCK +^ENG(6914,ENEQ):5
IF '$TEST
SET ENMSG="RECORD LOCKED. Equipment ID#: "_ENEQ
SET ENMSG(0,1)="This record is being edited by another user at this time."
SET ENMSG(0,2)="Please update the inventory data manually."
DO XCPTN
QUIT
+4 SET TAG="XCPTN^ENBCPM2"
DO FLAG^ENEQNX2
+5 SET ENOLDLOC=""
+6 ;Record already updated
IF $PIECE($GET(^ENG(6914,ENEQ,2)),U,13)=DT
Begin DoDot:1
+7 SET X=$PIECE($GET(^ENG(6914,ENEQ,3)),U,5)
IF X]""
IF X'["E"
IF X=+X
SET ENOLDLOC=$PIECE($GET(^ENG("SP",X,0)),U)
+8 if ENLOC=ENOLDLOC
QUIT
+9 IF ENLOC["E"
SET ENOLDLOC=$TRANSLATE(ENOLDLOC,"e","E")
End DoDot:1
IF ENOLDLOC=ENLOC
LOCK -^ENG(6914,ENEQ)
QUIT
+10 SET ENLOC(0)=ENLOC
+11 IF ENLOC]""
IF '$DATA(^ENG("SP","B",ENLOC))
IF ENLOC["E"
FOR
SET ENLOC(0)=$PIECE(ENLOC(0),"E")_"e"_$PIECE(ENLOC(0),"E",2,99)
IF $DATA(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E")
QUIT
+12 IF '$DATA(^ENG("SP","B",ENLOC(0)))
LOCK -^ENG(6914,ENEQ)
SET ENMSG="BAD LOCATION"
SET ENMSG(0,1)="Location not in Space File. Can't update the Equipment Record."
DO XCPTN
QUIT
+13 SET DIE="^ENG(6914,"
SET DA=ENEQ
SET DR="24///^S X=ENLOC(0);23///^S X=DT"
+14 DO ^DIE
LOCK -^ENG(6914,ENEQ)
+15 QUIT
+16 ;
XCPTN ; Print Exception Messages
+1 USE IO
+2 if ENY=0!(ENY>(IOSL-5))
DO HDR
WRITE !!,ENMSG,!
if $DATA(ENLBL)
WRITE " Label scanned as: ",ENLBL
if $DATA(ENLOC)
WRITE " Location: ",ENLOC
SET ENY=ENY+3
+3 IF $DATA(ENMSG(0))
FOR I=0:0
SET I=$ORDER(ENMSG(0,I))
if I'=+I
QUIT
WRITE !,ENMSG(0,I)
SET ENY=ENY+1
+4 KILL ENMSG
+5 QUIT
+6 ;
HDR ; New page for exception printing
+1 USE IO
+2 IF IO=IO(0)
IF $EXTRACT(IOST,1,2)="C-"
IF ENY>0
DO HOLD
+3 IF ENPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+4 SET ENPG=ENPG+1
+5 WRITE "BAR CODED PMI EXCEPTION MESSAGES (Time stamp: "_ENCTTI(0)_")",?(IOM-8),ENDATE
+6 WRITE !," Global Reference: ^PRCT(446.4,"_ENCTID_",2,"_ENCTTI_",1,",?(IOM-10),"Page ",ENPG
+7 KILL X
SET $PIECE(X,"-",(IOM-1))="-"
WRITE !,X
+8 SET ENY=4
+9 QUIT
HOLD IF $EXTRACT(IOST,1,2)="C-"
WRITE !,"Press RETURN to continue..."
READ X:DTIME
+1 QUIT
ZTSK ;Schedule processing for later time (from ENBCPM1)
+1 KILL IO("Q")
SET ZTIO=IO
SET ZTRTN="NEWLOC^ENBCPM1"
SET ZTDESC="Record PMI (Bar code)"
SET ZTSAVE("EN*")=""
SET ZTSAVE("DT")=""
+2 DO ^%ZTLOAD
KILL ZTSK
+3 GOTO EXIT^ENBCPM5
+4 ;ENBCPM2
