- 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 Feb 18, 2025@23:21:54 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