| 1 | ENSA2 ;(WASH ISC)/DH-Process MedTester Data ;1/9/2001
|
|---|
| 2 | ;;7.0;ENGINEERING;**1,14,21,68**;Aug 17, 1993
|
|---|
| 3 | 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
|
|---|
| 4 | S ENPMN=ENLBL,ENEQ=$O(^ENG(6914,"C",ENLBL,0)) Q:ENEQ=""
|
|---|
| 5 | G UPDATE1
|
|---|
| 6 | UPDATE ;Update File 6914
|
|---|
| 7 | S ENEQ(0)=0
|
|---|
| 8 | I ENLBL[" EE",$P(ENLBL," ")'=ENSTA D I $D(ENMSG) D XCPTN Q
|
|---|
| 9 | . K ENMSG S ENMSG="FOREIGN EQUIPMENT."
|
|---|
| 10 | . F I=1:1:8 I ENSTAL(I),$E(ENLBL,1,ENSTAL(I))=ENSTA(I) K ENMSG Q
|
|---|
| 11 | . I $D(ENMSG) S ENMSG(0,1)="Cannot process a bar code label from another VAMC."
|
|---|
| 12 | 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
|
|---|
| 13 | 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
|
|---|
| 14 | S ENOLDLOC=""
|
|---|
| 15 | I $P($G(^ENG(6914,ENEQ,2)),U,13)=ENSTDT D I ENLOC=ENOLDLOC L -^ENG(6914,ENEQ) Q ;Record already updated
|
|---|
| 16 | . 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)
|
|---|
| 17 | . Q:ENLOC=ENOLDLOC
|
|---|
| 18 | . I ENOLDLOC["e" S ENOLDLOC=$TR(ENOLDLOC,"e","E")
|
|---|
| 19 | S DIE="^ENG(6914,",DA=ENEQ
|
|---|
| 20 | I ENLOC]"" D
|
|---|
| 21 | . I $D(^ENG("SP","B",ENLOC)) S DR="24///^S X=ENLOC" D ^DIE Q
|
|---|
| 22 | . I ENLOC["E" D
|
|---|
| 23 | .. 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
|
|---|
| 24 | .. I $D(^ENG("SP","B",ENLOC(0))) S DR="24///^S X=ENLOC(0)" D ^DIE
|
|---|
| 25 | .. Q
|
|---|
| 26 | S:ENSTDT="" ENSTDT=DT S DR="23///^S X=ENSTDT" D ^DIE
|
|---|
| 27 | L -^ENG(6914,ENEQ)
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | XCPTN ;Print Exception Messages
|
|---|
| 31 | I 'ENPAPER D:ENY=0!(ENY>(IOSL-6)) HDR
|
|---|
| 32 | U IO W !,ENMSG,! W:$D(ENLBL) " Control Number: ",ENLBL W:$D(ENLOC) " Location: ",ENLOC S ENY=ENY+3
|
|---|
| 33 | I $D(ENMSG(0)) D
|
|---|
| 34 | . F I=0:0 S I=$O(ENMSG(0,I)) Q:I'=+I W !,ENMSG(0,I) S ENY=ENY+1
|
|---|
| 35 | . W ! S ENY=ENY+1
|
|---|
| 36 | K ENMSG
|
|---|
| 37 | Q
|
|---|
| 38 | HDR ;New page for exception printing
|
|---|
| 39 | I $E(IOST,1,2)="C-",ENY>0 D HOLD
|
|---|
| 40 | U IO I ENPG!($E(IOST,1,2)="C-") W @IOF
|
|---|
| 41 | S ENPG=ENPG+1 W "MedTester EXCEPTION MESSAGES",?(IOM-15),ENDATE
|
|---|
| 42 | W !," Uploaded by: ",$S($D(DUZ):$P(^VA(200,DUZ,0),U),1:"UNIDENTIFIED USER"),?(IOM-15),"Page ",ENPG
|
|---|
| 43 | K % S $P(%,"-",(IOM-1))="-" W !,%
|
|---|
| 44 | S ENY=4
|
|---|
| 45 | Q
|
|---|
| 46 | HOLD W !,"Press RETURN to continue..." R X:DTIME
|
|---|
| 47 | Q
|
|---|
| 48 | ;ENSA2
|
|---|
