ENSA1 ;(WASH ISC)/DH-MedTester Interface ;12/21/2000
;;7.0;ENGINEERING;**9,14,21,45,48,54,67**;Aug 17, 1993
UPLD ;Read from ESU
K ^ENG("TMP",ENTID)
W !!,"Enter the device to which the MedTester is connected.",! D ^%ZIS Q:POP
S ENCTEON=^%ZOSF("EON"),ENCTEOFF=^%ZOSF("EOFF"),ENCTTYPE=^%ZOSF("TYPE-AHEAD"),ENCTOPEN=$G(^%ZIS(2,IOST(0),10)),ENCTCLOS=$G(^%ZIS(2,IOST(0),11))
U IO D OFF W !,"...OK, use the MedTester 'PALL' function to send the data. Please",!,"be sure that you are connected to a MedTester COMM port and that the",!,"MedTester PRINTER port is OFF."
D ON R X:60 I '$T D OFF W !!,"Data transmission failure.",*7 D HOLD G EXIT
S X=$TR(X,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)) ;strip control chars
; next 4 lines will cause routine to ignore blank lines (Open-M) problem
F Q:$E(X)'=" " S X=$E(X,2,245)
S I=0 I X]"" S I=I+1,^ENG("TMP",ENTID,I)=X
F R X:10 Q:'$T I X]"" S X=$TR(X,$C(10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27)) D I X]"" S I=I+1,^ENG("TMP",ENTID,I)=X D:'(I#5) MARK
. F Q:$E(X)'=" " S X=$E(X,2,245)
R %:1 ;clear buffer
D OFF
D ^%ZISC
Q ;Data upload finished
;
MARK I IO=IO(0) D OFF
U IO(0) W "." U IO
I IO=IO(0) D ON
Q
;
ON X ENCTOPEN U IO X ENCTEOFF,ENCTTYPE
Q
;
OFF X ENCTCLOS,ENCTEON U IO(0)
Q
;
PROCS ;Process test results
K ^TMP($J)
N PMTOT S ENBRANCH="RECNUM^DATE^OPCODE^DEVICE^COMNTS^OTHER"
S (ENREC,ENEQ,ENLOC,ENEMP,ENTEC,ENSTDT,ENSN,ENMOD,ENWP,ENTIME,ENTEST)="",(ENFAIL,ENFLG,ENPG,ENY)=0 K ENLBL
READ S ENSA1=0 F S ENSA1=$O(^ENG("TMP",ENTID,ENSA1)) Q:'ENSA1 D MEDCHK
I $D(ENLBL) D UPDT
I $D(PMTOT) D ^ENBCPM8
Q ;Return control to ENSA
;
MEDCHK S X=^ENG("TMP",ENTID,ENSA1) F Q:$E(X)'=$C(32) S X=$E(X,2,245)
I X["MedTester" S X="MedTester REC #"_$P(X," REC #",2)
S ENX=X,X1=$S($E(X,1,9)="MedTester":1,$E(X,1,9)="SEQUENCE:":2,$E(X,1,14)="OPERATOR CODE:":3,$E(X,1,8)="OP CODE:":3,$E(X,1,18)="DEVICE INFORMATION":4,$E(X,1,9)="COMMENTS:":5,1:6)
D @($P(ENBRANCH,U,X1))
Q
;
RECNUM D:$D(ENLBL) UPDT K ENLBL ; post data (if any) from last test
; init variables for this test
K ENSN,ENMOD,ENPMN,ENSTDT,ENPMWO(0)
S (ENEQ,ENLOC,ENEMP,ENTEC,ENSTDT,ENSN,ENMOD,ENWP,ENTIME,ENTEST)="",(ENFAIL,ENFLG)=0
S X=$TR($P(ENX,"REC #",2),$C(32))
S ENREC=X D:ENPAPER LNPRNT^ENSA7
Q
DATE ;Date of ESA
N DELYR ; for Y2K
S X=^ENG("TMP",ENTID,ENSA1),X=$P(X,"DATE:",2),X1=$P(X,"TIME:",1)
S X1=$TR(X1,$C(10,32))
S XM=$P(X1,"/",1),XD=$P(X1,"/",2),XY=$P(X1,"/",3)
S:$L(XM)<2 XM="0"_XM
S:$L(XD)<2 XD="0"_XD
S:$L(XY)<2 XY="0"_XY ; added by *67 for non-y2k compliant Medtesters
S DELYR=$E(DT,2,3)-XY
S ENSTDT=$E(DT)+$S(DELYR>79:1,DELYR<-20:-1,1:0)_XY_XM_XD
I ENSTDT'?7N S ENSTDT="" ; result was an invalid date format
K XM,XD,XY
I ENPAPER D LNPRNT^ENSA7
Q
OPCODE ;Operator
S (ENTEC,ENEMP)="",X=$TR($P(X,":",2),$C(32))
I X]"" D
. I X=+X S ENTEC=X,ENEMP=$S($D(^ENG("EMP",X,0)):$P(^(0),U),1:"") Q
. I $D(^ENG("EMP","B",X)) S ENEMP=X,ENTEC=$O(^(X,0)) Q
. S X(1)=$L(X),X(2)=$O(^ENG("EMP","B",X)) I $E(X(2),1,X(1))=X D
.. I $E($O(^ENG("EMP","B",X(2))),1,X(1))=X Q
.. S ENTEC=$O(^ENG("EMP","B",X(2),0)),ENEMP=$P(^ENG("EMP",ENTEC,0),U)
D:ENPAPER LNPRNT^ENSA7
Q
DEVICE ;Equipment id
F J=1,2 S ENSA1=$O(^ENG("TMP",ENTID,ENSA1)),X(J)=^ENG("TMP",ENTID,ENSA1)
S X(3)="",X=$G(^ENG("TMP",ENTID,ENSA1+1)) F Q:$E(X)'=" " S X=$E(X,2,30)
I $E(X,1,7)="CONTROL" D ; accomodate MedTester 5000C
. S ENSA1=ENSA1+1,X(3)=$TR($P(X,":",2),$C(10)) F Q:$E(X(3))'=" " S X(3)=$E(X(3),2,50)
. S I=$L(X(3)) F Q:$E(X(3),I)'=" "!(I<1) S I=I-1,X(3)=$E(X(3),1,I)
S X=$P(X(1),"LOC:",2) F J=0:0 Q:$E(X)'=" " S X=$E(X,2,30)
S ENLOC=X I $E(ENLOC,1,2)="SP" S ENLOC=$E(ENLOC,3,30)
I ENLOC[" " S ENLOC=$P(ENLOC," ")
S X=$L(ENLOC) I $E(ENLOC,X)=" " S ENLOC=$E(ENLOC,1,(X-1))
S X=$P(X(2),":",2)
S X=$S($E(X,$L(X)-1,$L(X))="SN":$E(X,1,$L(X)-2),$E(X,$L(X)-7,$L(X))="SERIAL #":$E(X,1,$L(X)-8),1:X)
S X=$TR(X,$C(32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47))
S ENMOD(0)=$E(X,1,16)
S X=$P(X(2),":",3)
S X=$S($E(X,$L(X)-1,$L(X))="CN":$E(X,1,$L(X)-2),$E(X,$L(X)-8,$L(X))="CONTROL #":$E(X,1,$L(X)-9),1:X)
S X=$TR(X,$C(10,32))
S ENSN(0)=$E(X,1,16)
I X(3)]"" S X=X(3)
E D
. S X=$TR($P(X(2),":",4),$C(10)) F Q:$E(X)'=" " S X=$E(X,2,30)
. S I=$L(X) F Q:$E(X,I)'=" "!(I<1) S I=I-1,X=$E(X,1,I)
S ENLBL=X,ENEQ="" D DEVICE^ENSA7
K X Q
COMNTS ;MedTester comments
S X=$TR($E(X,11,128),$C(10))
S ENWP=X_" MedTester" S:$E(X)="#" ENFAIL=1
I ENPAPER D LNPRNT^ENSA7
Q
OTHER ;All other, mainly specific test results
I $E(X,1,10)="USER TIME:" S ENTIME=+$TR($P(X,":",2)," ")
;
; distinguish between EKG and DEFIB tests and hope that we're not
; missing other flavors of MedTester procedures
;
; if line has text indicating start of a test results section then
; set ENFLG = 1 (true) so subsequent lines will be checked for
; presence of '#' which indicates a test failure
;
I $E(X,1,12)="LINE VOLTAGE" S ENFLG=1,ENTEST="EKG" ; for esa test
I $E(X,1,5)="DEFIB" S ENFLG=1,ENTEST="DEFIB" ; for defib test
;
; if line has text indicating section after test results then
; set ENFLG = 0 (false) so subsequent lines will not be checked for
; presence of '#'
;
I $E(X,1,11)="PERFORMANCE" S ENFLG=0 ; for any test
;
; if ENFLG true then check for failure unless line starts STEP#
; since defib tests use 'STEP #' as a column header
;
I ENFLG,$E(X,1,4)'="STEP",X["#" S ENFAIL=1
;
I ENPAPER D LNPRNT^ENSA7
Q
;
UPDT ;Update Equipment File
S ENEQ(0)=1 I ENEQ]"" D UPDATE^ENSA2 D:$D(^ENG(6914,ENEQ,0)) POST^ENSA4
I ENEQ(0),ENLBL?4N1"-"4N0.1A D PMN^ENSA2 I ENEQ]"",$D(^ENG(6914,ENEQ,0)) D POST^ENSA4
I ENEQ(0) D NOLBL^ENSA3
I $D(ENXP("?")) D DEVCK3^ENSA7 K ENXP("?")
Q
;
HOLD W !,"Press <RETURN> to continue..." R X:DTIME
Q
EXIT G EXIT^ENSA3
;ENSA1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSA1 5928 printed Dec 13, 2024@01:55:29 Page 2
ENSA1 ;(WASH ISC)/DH-MedTester Interface ;12/21/2000
+1 ;;7.0;ENGINEERING;**9,14,21,45,48,54,67**;Aug 17, 1993
UPLD ;Read from ESU
+1 KILL ^ENG("TMP",ENTID)
+2 WRITE !!,"Enter the device to which the MedTester is connected.",!
DO ^%ZIS
if POP
QUIT
+3 SET ENCTEON=^%ZOSF("EON")
SET ENCTEOFF=^%ZOSF("EOFF")
SET ENCTTYPE=^%ZOSF("TYPE-AHEAD")
SET ENCTOPEN=$GET(^%ZIS(2,IOST(0),10))
SET ENCTCLOS=$GET(^%ZIS(2,IOST(0),11))
+4 USE IO
DO OFF
WRITE !,"...OK, use the MedTester 'PALL' function to send the data. Please",!,"be sure that you are connected to a MedTester COMM port and that the",!,"MedTester PRINTER port is OFF."
+5 DO ON
READ X:60
IF '$TEST
DO OFF
WRITE !!,"Data transmission failure.",*7
DO HOLD
GOTO EXIT
+6 ;strip control chars
SET X=$TRANSLATE(X,$CHAR(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))
+7 ; next 4 lines will cause routine to ignore blank lines (Open-M) problem
+8 FOR
if $EXTRACT(X)'=" "
QUIT
SET X=$EXTRACT(X,2,245)
+9 SET I=0
IF X]""
SET I=I+1
SET ^ENG("TMP",ENTID,I)=X
+10 FOR
READ X:10
if '$TEST
QUIT
IF X]""
SET X=$TRANSLATE(X,$CHAR(10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27))
Begin DoDot:1
+11 FOR
if $EXTRACT(X)'=" "
QUIT
SET X=$EXTRACT(X,2,245)
End DoDot:1
IF X]""
SET I=I+1
SET ^ENG("TMP",ENTID,I)=X
if '(I#5)
DO MARK
+12 ;clear buffer
READ %:1
+13 DO OFF
+14 DO ^%ZISC
+15 ;Data upload finished
QUIT
+16 ;
MARK IF IO=IO(0)
DO OFF
+1 USE IO(0)
WRITE "."
USE IO
+2 IF IO=IO(0)
DO ON
+3 QUIT
+4 ;
ON XECUTE ENCTOPEN
USE IO
XECUTE ENCTEOFF
XECUTE ENCTTYPE
+1 QUIT
+2 ;
OFF XECUTE ENCTCLOS
XECUTE ENCTEON
USE IO(0)
+1 QUIT
+2 ;
PROCS ;Process test results
+1 KILL ^TMP($JOB)
+2 NEW PMTOT
SET ENBRANCH="RECNUM^DATE^OPCODE^DEVICE^COMNTS^OTHER"
+3 SET (ENREC,ENEQ,ENLOC,ENEMP,ENTEC,ENSTDT,ENSN,ENMOD,ENWP,ENTIME,ENTEST)=""
SET (ENFAIL,ENFLG,ENPG,ENY)=0
KILL ENLBL
READ SET ENSA1=0
FOR
SET ENSA1=$ORDER(^ENG("TMP",ENTID,ENSA1))
if 'ENSA1
QUIT
DO MEDCHK
+1 IF $DATA(ENLBL)
DO UPDT
+2 IF $DATA(PMTOT)
DO ^ENBCPM8
+3 ;Return control to ENSA
QUIT
+4 ;
MEDCHK SET X=^ENG("TMP",ENTID,ENSA1)
FOR
if $EXTRACT(X)'=$CHAR(32)
QUIT
SET X=$EXTRACT(X,2,245)
+1 IF X["MedTester"
SET X="MedTester REC #"_$PIECE(X," REC #",2)
+2 SET ENX=X
SET X1=$SELECT($EXTRACT(X,1,9)="MedTester":1,$EXTRACT(X,1,9)="SEQUENCE:":2,$EXTRACT(X,1,14)="OPERATOR CODE:":3,$EXTRACT(X,1,8)="OP CODE:":3,$EXTRACT(X,1,18)="DEVICE INFORMATION":4,$EXTRACT(X,1,9)="COMMENTS:":5,1:6)
+3 DO @($PIECE(ENBRANCH,U,X1))
+4 QUIT
+5 ;
RECNUM ; post data (if any) from last test
if $DATA(ENLBL)
DO UPDT
KILL ENLBL
+1 ; init variables for this test
+2 KILL ENSN,ENMOD,ENPMN,ENSTDT,ENPMWO(0)
+3 SET (ENEQ,ENLOC,ENEMP,ENTEC,ENSTDT,ENSN,ENMOD,ENWP,ENTIME,ENTEST)=""
SET (ENFAIL,ENFLG)=0
+4 SET X=$TRANSLATE($PIECE(ENX,"REC #",2),$CHAR(32))
+5 SET ENREC=X
if ENPAPER
DO LNPRNT^ENSA7
+6 QUIT
DATE ;Date of ESA
+1 ; for Y2K
NEW DELYR
+2 SET X=^ENG("TMP",ENTID,ENSA1)
SET X=$PIECE(X,"DATE:",2)
SET X1=$PIECE(X,"TIME:",1)
+3 SET X1=$TRANSLATE(X1,$CHAR(10,32))
+4 SET XM=$PIECE(X1,"/",1)
SET XD=$PIECE(X1,"/",2)
SET XY=$PIECE(X1,"/",3)
+5 if $LENGTH(XM)<2
SET XM="0"_XM
+6 if $LENGTH(XD)<2
SET XD="0"_XD
+7 ; added by *67 for non-y2k compliant Medtesters
if $LENGTH(XY)<2
SET XY="0"_XY
+8 SET DELYR=$EXTRACT(DT,2,3)-XY
+9 SET ENSTDT=$EXTRACT(DT)+$SELECT(DELYR>79:1,DELYR<-20:-1,1:0)_XY_XM_XD
+10 ; result was an invalid date format
IF ENSTDT'?7N
SET ENSTDT=""
+11 KILL XM,XD,XY
+12 IF ENPAPER
DO LNPRNT^ENSA7
+13 QUIT
OPCODE ;Operator
+1 SET (ENTEC,ENEMP)=""
SET X=$TRANSLATE($PIECE(X,":",2),$CHAR(32))
+2 IF X]""
Begin DoDot:1
+3 IF X=+X
SET ENTEC=X
SET ENEMP=$SELECT($DATA(^ENG("EMP",X,0)):$PIECE(^(0),U),1:"")
QUIT
+4 IF $DATA(^ENG("EMP","B",X))
SET ENEMP=X
SET ENTEC=$ORDER(^(X,0))
QUIT
+5 SET X(1)=$LENGTH(X)
SET X(2)=$ORDER(^ENG("EMP","B",X))
IF $EXTRACT(X(2),1,X(1))=X
Begin DoDot:2
+6 IF $EXTRACT($ORDER(^ENG("EMP","B",X(2))),1,X(1))=X
QUIT
+7 SET ENTEC=$ORDER(^ENG("EMP","B",X(2),0))
SET ENEMP=$PIECE(^ENG("EMP",ENTEC,0),U)
End DoDot:2
End DoDot:1
+8 if ENPAPER
DO LNPRNT^ENSA7
+9 QUIT
DEVICE ;Equipment id
+1 FOR J=1,2
SET ENSA1=$ORDER(^ENG("TMP",ENTID,ENSA1))
SET X(J)=^ENG("TMP",ENTID,ENSA1)
+2 SET X(3)=""
SET X=$GET(^ENG("TMP",ENTID,ENSA1+1))
FOR
if $EXTRACT(X)'=" "
QUIT
SET X=$EXTRACT(X,2,30)
+3 ; accomodate MedTester 5000C
IF $EXTRACT(X,1,7)="CONTROL"
Begin DoDot:1
+4 SET ENSA1=ENSA1+1
SET X(3)=$TRANSLATE($PIECE(X,":",2),$CHAR(10))
FOR
if $EXTRACT(X(3))'=" "
QUIT
SET X(3)=$EXTRACT(X(3),2,50)
+5 SET I=$LENGTH(X(3))
FOR
if $EXTRACT(X(3),I)'=" "!(I<1)
QUIT
SET I=I-1
SET X(3)=$EXTRACT(X(3),1,I)
End DoDot:1
+6 SET X=$PIECE(X(1),"LOC:",2)
FOR J=0:0
if $EXTRACT(X)'=" "
QUIT
SET X=$EXTRACT(X,2,30)
+7 SET ENLOC=X
IF $EXTRACT(ENLOC,1,2)="SP"
SET ENLOC=$EXTRACT(ENLOC,3,30)
+8 IF ENLOC[" "
SET ENLOC=$PIECE(ENLOC," ")
+9 SET X=$LENGTH(ENLOC)
IF $EXTRACT(ENLOC,X)=" "
SET ENLOC=$EXTRACT(ENLOC,1,(X-1))
+10 SET X=$PIECE(X(2),":",2)
+11 SET X=$SELECT($EXTRACT(X,$LENGTH(X)-1,$LENGTH(X))="SN":$EXTRACT(X,1,$LENGTH(X)-2),$EXTRACT(X,$LENGTH(X)-7,$LENGTH(X))="SERIAL #":$EXTRACT(X,1,$LENGTH(X)-8),1:X)
+12 SET X=$TRANSLATE(X,$CHAR(32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47))
+13 SET ENMOD(0)=$EXTRACT(X,1,16)
+14 SET X=$PIECE(X(2),":",3)
+15 SET X=$SELECT($EXTRACT(X,$LENGTH(X)-1,$LENGTH(X))="CN":$EXTRACT(X,1,$LENGTH(X)-2),$EXTRACT(X,$LENGTH(X)-8,$LENGTH(X))="CONTROL #":$EXTRACT(X,1,$LENGTH(X)-9),1:X)
+16 SET X=$TRANSLATE(X,$CHAR(10,32))
+17 SET ENSN(0)=$EXTRACT(X,1,16)
+18 IF X(3)]""
SET X=X(3)
+19 IF '$TEST
Begin DoDot:1
+20 SET X=$TRANSLATE($PIECE(X(2),":",4),$CHAR(10))
FOR
if $EXTRACT(X)'=" "
QUIT
SET X=$EXTRACT(X,2,30)
+21 SET I=$LENGTH(X)
FOR
if $EXTRACT(X,I)'=" "!(I<1)
QUIT
SET I=I-1
SET X=$EXTRACT(X,1,I)
End DoDot:1
+22 SET ENLBL=X
SET ENEQ=""
DO DEVICE^ENSA7
+23 KILL X
QUIT
COMNTS ;MedTester comments
+1 SET X=$TRANSLATE($EXTRACT(X,11,128),$CHAR(10))
+2 SET ENWP=X_" MedTester"
if $EXTRACT(X)="#"
SET ENFAIL=1
+3 IF ENPAPER
DO LNPRNT^ENSA7
+4 QUIT
OTHER ;All other, mainly specific test results
+1 IF $EXTRACT(X,1,10)="USER TIME:"
SET ENTIME=+$TRANSLATE($PIECE(X,":",2)," ")
+2 ;
+3 ; distinguish between EKG and DEFIB tests and hope that we're not
+4 ; missing other flavors of MedTester procedures
+5 ;
+6 ; if line has text indicating start of a test results section then
+7 ; set ENFLG = 1 (true) so subsequent lines will be checked for
+8 ; presence of '#' which indicates a test failure
+9 ;
+10 ; for esa test
IF $EXTRACT(X,1,12)="LINE VOLTAGE"
SET ENFLG=1
SET ENTEST="EKG"
+11 ; for defib test
IF $EXTRACT(X,1,5)="DEFIB"
SET ENFLG=1
SET ENTEST="DEFIB"
+12 ;
+13 ; if line has text indicating section after test results then
+14 ; set ENFLG = 0 (false) so subsequent lines will not be checked for
+15 ; presence of '#'
+16 ;
+17 ; for any test
IF $EXTRACT(X,1,11)="PERFORMANCE"
SET ENFLG=0
+18 ;
+19 ; if ENFLG true then check for failure unless line starts STEP#
+20 ; since defib tests use 'STEP #' as a column header
+21 ;
+22 IF ENFLG
IF $EXTRACT(X,1,4)'="STEP"
IF X["#"
SET ENFAIL=1
+23 ;
+24 IF ENPAPER
DO LNPRNT^ENSA7
+25 QUIT
+26 ;
UPDT ;Update Equipment File
+1 SET ENEQ(0)=1
IF ENEQ]""
DO UPDATE^ENSA2
if $DATA(^ENG(6914,ENEQ,0))
DO POST^ENSA4
+2 IF ENEQ(0)
IF ENLBL?4N1"-"4N0.1A
DO PMN^ENSA2
IF ENEQ]""
IF $DATA(^ENG(6914,ENEQ,0))
DO POST^ENSA4
+3 IF ENEQ(0)
DO NOLBL^ENSA3
+4 IF $DATA(ENXP("?"))
DO DEVCK3^ENSA7
KILL ENXP("?")
+5 QUIT
+6 ;
HOLD WRITE !,"Press <RETURN> to continue..."
READ X:DTIME
+1 QUIT
EXIT GOTO EXIT^ENSA3
+1 ;ENSA1
