ENSA3.m

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 ---ENSA3   1471     printed  Feb 18, 2025@23:21:55                                                                                                                                                                                                       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