ENSA3 ;(WASH ISC)/DH-Process MedTester Data ;4.22.99
;;7.0;ENGINEERING;**14,54**;Aug 17, 1993
NOLBL ;No barcode label scanned
S EN="" I ENMOD]"",$D(^ENG(6914,"E",ENMOD)) S I=0 F J=0:0 S I=$O(^ENG(6914,"E",ENMOD,I)) Q:I'=+I I $D(^ENG(6914,I,1)),$P(^(1),U,3)=ENSN D MATCH,POST^ENSA4 Q
;If match found EN will be killed
I $D(EN) D
. S ENMSG="ITEM NOT FOUND IN DATABASE. MedTester REC # "_ENREC
. S ENMSG(0,1)="Model: "_$S(ENMOD]"":ENMOD,1:"Unknown")
. S ENMSG(0,2)="Serial Number: "_$S(ENSN]"":ENSN,1:"Unknown")
. D XCPTN^ENSA2
Q
MATCH ;Equipment unlabelled but present in 6914
S ENEQ=I D UPDATE1^ENSA2
K EN Q
;
HOLD U IO(0) W !,"Press RETURN to continue..." R X:DTIME
Q
ERR ;Error message (Forced exit)
W !!,*7,"FATAL ERROR OR USER ABORT.",*7
W !!,"Unrecoverable error has occurred. You will need to start the MedTester",!,"upload again from the beginning."
S ENY=0 D HOLD
EXIT I $E(IOST,1,2)="C-",$D(ENY),ENY>0 D HOLD
K:$D(ENTID) ^ENG("TMP",ENTID)
EXIT1 K EN,ENSA1,ENSA2,ENEQ,ENLBL,ENMSG,ENY,ENBRANCH,ENCAT,ENFAIL,ENFLG,ENMAN,ENMOD,ENMEN,ENDATE,ENSTA,ENSTAL
K ENLOC,ENOLDLOC,ENEMP,ENPM,ENPMDT,ENPMWO,ENSHABR,ENSTDT,ENSHOP,ENSHKEY,ENDTCP,ENH,ENINV,ENPG,ENWOX,ENW,ENCOST
K ENPAPER,ENPMN,ENREC,ENSN,ENTEC,ENWP,ENX,ENY,ENTID,EN1,EN2,ENAUTO,ENCTCLOS,ENCTEOFF,ENCTEON,ENCTOPEN,ENCTTYPE,ENTIME,ENTEST
K %,I,I1,J,K,DA,DIC,DIE,DR,ENDEL,X,Y,X1,X2,%DT,DNX
W @IOF I $E(IOST,1,2)="P-",'$D(ZTQUEUED) D ^%ZISC
K ^TMP($J)
Q
;ENSA3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSA3 1471 printed Dec 13, 2024@01:55:31 Page 2
ENSA3 ;(WASH ISC)/DH-Process MedTester Data ;4.22.99
+1 ;;7.0;ENGINEERING;**14,54**;Aug 17, 1993
NOLBL ;No barcode label scanned
+1 SET EN=""
IF ENMOD]""
IF $DATA(^ENG(6914,"E",ENMOD))
SET I=0
FOR J=0:0
SET I=$ORDER(^ENG(6914,"E",ENMOD,I))
if I'=+I
QUIT
IF $DATA(^ENG(6914,I,1))
IF $PIECE(^(1),U,3)=ENSN
DO MATCH
DO POST^ENSA4
QUIT
+2 ;If match found EN will be killed
+3 IF $DATA(EN)
Begin DoDot:1
+4 SET ENMSG="ITEM NOT FOUND IN DATABASE. MedTester REC # "_ENREC
+5 SET ENMSG(0,1)="Model: "_$SELECT(ENMOD]"":ENMOD,1:"Unknown")
+6 SET ENMSG(0,2)="Serial Number: "_$SELECT(ENSN]"":ENSN,1:"Unknown")
+7 DO XCPTN^ENSA2
End DoDot:1
+8 QUIT
MATCH ;Equipment unlabelled but present in 6914
+1 SET ENEQ=I
DO UPDATE1^ENSA2
+2 KILL EN
QUIT
+3 ;
HOLD USE IO(0)
WRITE !,"Press RETURN to continue..."
READ X:DTIME
+1 QUIT
ERR ;Error message (Forced exit)
+1 WRITE !!,*7,"FATAL ERROR OR USER ABORT.",*7
+2 WRITE !!,"Unrecoverable error has occurred. You will need to start the MedTester",!,"upload again from the beginning."
+3 SET ENY=0
DO HOLD
EXIT IF $EXTRACT(IOST,1,2)="C-"
IF $DATA(ENY)
IF ENY>0
DO HOLD
+1 if $DATA(ENTID)
KILL ^ENG("TMP",ENTID)
EXIT1 KILL EN,ENSA1,ENSA2,ENEQ,ENLBL,ENMSG,ENY,ENBRANCH,ENCAT,ENFAIL,ENFLG,ENMAN,ENMOD,ENMEN,ENDATE,ENSTA,ENSTAL
+1 KILL ENLOC,ENOLDLOC,ENEMP,ENPM,ENPMDT,ENPMWO,ENSHABR,ENSTDT,ENSHOP,ENSHKEY,ENDTCP,ENH,ENINV,ENPG,ENWOX,ENW,ENCOST
+2 KILL ENPAPER,ENPMN,ENREC,ENSN,ENTEC,ENWP,ENX,ENY,ENTID,EN1,EN2,ENAUTO,ENCTCLOS,ENCTEOFF,ENCTEON,ENCTOPEN,ENCTTYPE,ENTIME,ENTEST
+3 KILL %,I,I1,J,K,DA,DIC,DIE,DR,ENDEL,X,Y,X1,X2,%DT,DNX
+4 WRITE @IOF
IF $EXTRACT(IOST,1,2)="P-"
IF '$DATA(ZTQUEUED)
DO ^%ZISC
+5 KILL ^TMP($JOB)
+6 QUIT
+7 ;ENSA3
