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