ENSA2 ;(WASH ISC)/DH-Process MedTester Data ;1/9/2001
;;7.0;ENGINEERING;**1,14,21,68**;Aug 17, 1993
PMN S ENEQ(0)=0 I '$D(^ENG(6914,"C",ENLBL)) S ENMSG="LOOK-UP ON EQUIPMENT FILE FAILED.",ENMSG(0,1)="Attempt was by PM #: "_ENLBL D XCPTN Q
S ENPMN=ENLBL,ENEQ=$O(^ENG(6914,"C",ENLBL,0)) Q:ENEQ=""
G UPDATE1
UPDATE ;Update File 6914
S ENEQ(0)=0
I ENLBL[" EE",$P(ENLBL," ")'=ENSTA D I $D(ENMSG) D XCPTN Q
. K ENMSG S ENMSG="FOREIGN EQUIPMENT."
. F I=1:1:8 I ENSTAL(I),$E(ENLBL,1,ENSTAL(I))=ENSTA(I) K ENMSG Q
. I $D(ENMSG) S ENMSG(0,1)="Cannot process a bar code label from another VAMC."
UPDATE1 N DIE,DA,DR I '$D(^ENG(6914,ENEQ,0)) S ENMSG="ITEM NOT IN DATABASE.",ENMSG(0,1)="Control Number entered incorrectly or Equipment File is corrupted." D XCPTN Q
L +^ENG(6914,ENEQ):10 I '$T S ENMSG="RECORD LOCKED.",ENMSG(0,1)="This record is being written to by another user at this time.",ENMSG(0,2)="Please make the update manually." D XCPTN Q
S ENOLDLOC=""
I $P($G(^ENG(6914,ENEQ,2)),U,13)=ENSTDT D I ENLOC=ENOLDLOC 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 ENOLDLOC["e" S ENOLDLOC=$TR(ENOLDLOC,"e","E")
S DIE="^ENG(6914,",DA=ENEQ
I ENLOC]"" D
. I $D(^ENG("SP","B",ENLOC)) S DR="24///^S X=ENLOC" D ^DIE Q
. I ENLOC["E" D
.. S ENLOC(0)=ENLOC 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))) S DR="24///^S X=ENLOC(0)" D ^DIE
.. Q
S:ENSTDT="" ENSTDT=DT S DR="23///^S X=ENSTDT" D ^DIE
L -^ENG(6914,ENEQ)
Q
;
XCPTN ;Print Exception Messages
I 'ENPAPER D:ENY=0!(ENY>(IOSL-6)) HDR
U IO W !,ENMSG,! W:$D(ENLBL) " Control Number: ",ENLBL W:$D(ENLOC) " Location: ",ENLOC S ENY=ENY+3
I $D(ENMSG(0)) D
. F I=0:0 S I=$O(ENMSG(0,I)) Q:I'=+I W !,ENMSG(0,I) S ENY=ENY+1
. W ! S ENY=ENY+1
K ENMSG
Q
HDR ;New page for exception printing
I $E(IOST,1,2)="C-",ENY>0 D HOLD
U IO I ENPG!($E(IOST,1,2)="C-") W @IOF
S ENPG=ENPG+1 W "MedTester EXCEPTION MESSAGES",?(IOM-15),ENDATE
W !," Uploaded by: ",$S($D(DUZ):$P(^VA(200,DUZ,0),U),1:"UNIDENTIFIED USER"),?(IOM-15),"Page ",ENPG
K % S $P(%,"-",(IOM-1))="-" W !,%
S ENY=4
Q
HOLD W !,"Press RETURN to continue..." R X:DTIME
Q
;ENSA2
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSA2 2352 printed Sep 02, 2024@18:40:49 Page 2
ENSA2 ;(WASH ISC)/DH-Process MedTester Data ;1/9/2001
+1 ;;7.0;ENGINEERING;**1,14,21,68**;Aug 17, 1993
PMN SET ENEQ(0)=0
IF '$DATA(^ENG(6914,"C",ENLBL))
SET ENMSG="LOOK-UP ON EQUIPMENT FILE FAILED."
SET ENMSG(0,1)="Attempt was by PM #: "_ENLBL
DO XCPTN
QUIT
+1 SET ENPMN=ENLBL
SET ENEQ=$ORDER(^ENG(6914,"C",ENLBL,0))
if ENEQ=""
QUIT
+2 GOTO UPDATE1
UPDATE ;Update File 6914
+1 SET ENEQ(0)=0
+2 IF ENLBL[" EE"
IF $PIECE(ENLBL," ")'=ENSTA
Begin DoDot:1
+3 KILL ENMSG
SET ENMSG="FOREIGN EQUIPMENT."
+4 FOR I=1:1:8
IF ENSTAL(I)
IF $EXTRACT(ENLBL,1,ENSTAL(I))=ENSTA(I)
KILL ENMSG
QUIT
+5 IF $DATA(ENMSG)
SET ENMSG(0,1)="Cannot process a bar code label from another VAMC."
End DoDot:1
IF $DATA(ENMSG)
DO XCPTN
QUIT
UPDATE1 NEW DIE,DA,DR
IF '$DATA(^ENG(6914,ENEQ,0))
SET ENMSG="ITEM NOT IN DATABASE."
SET ENMSG(0,1)="Control Number entered incorrectly or Equipment File is corrupted."
DO XCPTN
QUIT
+1 LOCK +^ENG(6914,ENEQ):10
IF '$TEST
SET ENMSG="RECORD LOCKED."
SET ENMSG(0,1)="This record is being written to by another user at this time."
SET ENMSG(0,2)="Please make the update manually."
DO XCPTN
QUIT
+2 SET ENOLDLOC=""
+3 ;Record already updated
IF $PIECE($GET(^ENG(6914,ENEQ,2)),U,13)=ENSTDT
Begin DoDot:1
+4 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)
+5 if ENLOC=ENOLDLOC
QUIT
+6 IF ENOLDLOC["e"
SET ENOLDLOC=$TRANSLATE(ENOLDLOC,"e","E")
End DoDot:1
IF ENLOC=ENOLDLOC
LOCK -^ENG(6914,ENEQ)
QUIT
+7 SET DIE="^ENG(6914,"
SET DA=ENEQ
+8 IF ENLOC]""
Begin DoDot:1
+9 IF $DATA(^ENG("SP","B",ENLOC))
SET DR="24///^S X=ENLOC"
DO ^DIE
QUIT
+10 IF ENLOC["E"
Begin DoDot:2
+11 SET ENLOC(0)=ENLOC
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)))
SET DR="24///^S X=ENLOC(0)"
DO ^DIE
+13 QUIT
End DoDot:2
End DoDot:1
+14 if ENSTDT=""
SET ENSTDT=DT
SET DR="23///^S X=ENSTDT"
DO ^DIE
+15 LOCK -^ENG(6914,ENEQ)
+16 QUIT
+17 ;
XCPTN ;Print Exception Messages
+1 IF 'ENPAPER
if ENY=0!(ENY>(IOSL-6))
DO HDR
+2 USE IO
WRITE !,ENMSG,!
if $DATA(ENLBL)
WRITE " Control Number: ",ENLBL
if $DATA(ENLOC)
WRITE " Location: ",ENLOC
SET ENY=ENY+3
+3 IF $DATA(ENMSG(0))
Begin DoDot:1
+4 FOR I=0:0
SET I=$ORDER(ENMSG(0,I))
if I'=+I
QUIT
WRITE !,ENMSG(0,I)
SET ENY=ENY+1
+5 WRITE !
SET ENY=ENY+1
End DoDot:1
+6 KILL ENMSG
+7 QUIT
HDR ;New page for exception printing
+1 IF $EXTRACT(IOST,1,2)="C-"
IF ENY>0
DO HOLD
+2 USE IO
IF ENPG!($EXTRACT(IOST,1,2)="C-")
WRITE @IOF
+3 SET ENPG=ENPG+1
WRITE "MedTester EXCEPTION MESSAGES",?(IOM-15),ENDATE
+4 WRITE !," Uploaded by: ",$SELECT($DATA(DUZ):$PIECE(^VA(200,DUZ,0),U),1:"UNIDENTIFIED USER"),?(IOM-15),"Page ",ENPG
+5 KILL %
SET $PIECE(%,"-",(IOM-1))="-"
WRITE !,%
+6 SET ENY=4
+7 QUIT
HOLD WRITE !,"Press RETURN to continue..."
READ X:DTIME
+1 QUIT
+2 ;ENSA2
