MCARAM ;WASH ISC/JKL-MUSE AUTO INSTRUMENT DATA LOAD INTO DHCP ;5/28/96 14:53
;;2.3;Medicine;;09/13/1996
;
;
START ; Driver for MUSE-run by task manager
; WHERE: LANM,TSK,MCINST,T are required for MCARASE
; LANM = routine name, T and TSK = auto instrument IEN,
; MCINST = auto instrument name
; MCL = data type line number, MCLT = data transmission line number
; MCD = one line of lab data, MCA = array of local data,
; MCE = internal record number of EKG file where data is stored
; MCRD = attempts to read lab data
; MCCD= current data transmission number
; MCPRO= EKG procedure number from Procedure/Subspecialty file
N LANM,TSK,MCINST,T,MCL,MCLT,MCA,MCCD,MCCNT,MCE,MCERR,MCRD,MCPRO,MCPRNM
N MCS,MCTOT,MCTYPE,MCZ,MCREC
S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)),U="^" I TSK="" Q
; Quit if no MUSE data
I '$D(^LA(TSK,"I",0)) Q
S MCINST=$P(^LAB(62.4,TSK,0),U) D ^MCARASE I 'TSK Q
S @TRAP
;initial error condition
S MCA("ERR")=0
;get EKG procedure number from Procedure/Subspecialty file
S MCPRO=$O(^MCAR(697.2,"C","MCAR(691.5",0))
;print name for ECG procedure, type of transmission
S MCPRNM=$$ORPRM(MCPRO),MCTYPE="M"
;delay process until record data is complete
D DELPRO
;
READ S MCRD=0,MCL=0,MCCD=-1,MCA("CONT")="@"
I ^LA(TSK,"I",0)'=0 S MCLT=^LA(TSK,"I",0)+1,MCCD=MCLT-1
D IN G QUIT
IN S MCLT=^LA(TSK,"I",0)+1 I '$D(^(MCLT)) S MCRD=MCRD+1 Q:MCRD>6 H 8 G IN
S ^LA(TSK,"I",0)=MCLT,MCRD=0,MCERR=0
I '$D(MCREC) F MCZ=1:1 D:'$D(^LA(TSK,"I",MCLT+MCZ)) DELPRO I ($D(^LA(TSK,"I",MCLT+MCZ))#2),((^LA(TSK,"I",MCLT+MCZ)["EOR")!(^LA(TSK,"I",MCLT+MCZ)["ERR")!(^LA(TSK,"I",MCLT+MCZ)["BYE")) S MCREC="" Q
I '$D(MCA("ERR")) S MCA("ERR")=0
;ignore set if retransmit set of data lines
I $D(^LA(TSK,"I",MCLT+3)),^LA(TSK,"I",MCLT+3)=^LA(TSK,"I",MCLT),^LA(TSK,"I",MCLT)?.E1.A.E S MCCD=MCCD+3,^LA(TSK,"I",0)=MCLT+2 G IN
;check for start of transmission-suppressed H
I $E(^LA(TSK,"I",MCLT),1,5)="HELLO" S MCCD=MCLT-3
;check for start of transmission-IRM
I $E(^LA(TSK,"I",MCLT),1,3)="IRM" S MCCD=MCLT-3
;transfer one line of lab data to local array
I MCCD+3=MCLT S MCERR=$$RLAB^MCARAM(.MCA,.MCL,MCLT)
;transmission error
I +MCERR=5 K MCA,MCERR,MCREC N MCA,MCERR G IN
;transfer local array data into DHCP
;record successful or unsuccessful data transfer attempt
I +MCERR=10 S:$$GRERR^MCARAM7(.MCA)=0 MCERR=$$LDHCP^MCARAM3(.MCA,.MCE) S MCERR=$$KPERR^MCARAM7(.MCA,.MCS) K MCA,MCERR,MCE,MCS,MCREC N MCA,MCERR,MCE,MCS
G IN
;
DELPRO ;delay process until record data is complete
S MCCNT=0
DELP I $D(^LA(TSK,"I")) S MCTOT=^LA(TSK,"I"),MCCNT=MCCNT+1 H 15 I MCTOT=^LA(TSK,"I"),MCCNT<7 G DELP
K MCTOT,MCCNT
Q
;
;
OUT S MCLT=^LA(TSK,"O")+1,^("O")=MCLT,^("O",MCLT)=OUT
L +^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=TSK L -^LA("Q") Q
Q
;
;
RLAB(MCA,MCL,MCLT) ; Read Lab data and place in local array
; USAGE: S X=$$RLAB^MCARAM(.A,.B,C)
; WHERE: .A=Array into which data is placed
; .B=Data type line number
; C=Data transmission line number
;
;lab data
S MCD=^LA(TSK,"I",MCLT)
I ($E(MCD,1,5)="HELLO")!($E(MCD,1,3)="EOT") S MCL=0,MCA("CONT")="@",MCCD=MCLT-1 Q 0
I $E(MCD,1,3)="BYE" S MCL=0,MCA("CONT")="@",MCCD=MCLT-2 Q 0
I $E(MCD,1,3)="IRM" S MCL=0,MCA("CONT")="@",MCCD=MCLT Q 0
I $E(MCD,1,3)="EOR" S MCERR="10-End of record" S MCCD=MCLT Q MCERR
I $E(MCD,1,3)="ERR" S MCERR="5-Transmission error-expect retry of record" S MCL=0,MCA("CONT")="@",MCCD=MCLT-1 Q MCERR
S MCL=MCL+1,MCA("CONT")=$C($A(MCA("CONT"))+1)
;transfer lab data to local
I MCL<13 S MCTR=$S(MCL<7:"S MCERR=$$L"_MCL_"^MCARAM1(.MCA,MCD)",MCL=12:"S MCERR=$$L"_MCL_"^MCARAM3(.MCA,MCD)",MCL>6:"S MCERR=$$L"_MCL_"^MCARAM2(.MCA,MCD)") X MCTR S MCCD=MCLT Q:+MCERR>0 MCERR Q 0
;fill diagnosis array
I MCL>12 S MCERR=$$DGCT^MCARAM4(.MCA,MCD,MCL),MCCD=MCLT I +MCERR>0 Q MCERR
Q 0
;
TRAP ;entry from MCARASE
K ^LA("LOCK",TSK) S T=TSK D SET^MCARASE
S ^LA(TSK,"Q")=0 D ERROR^MCARASE
G @(U_LANM)
;
ORPRM(MCPRO) ;Get print name for ECG procedure
;USAGE: S X=$$ORPRM(MCPRO)
;WHERE: X = print name for ECG procedure/subspecialty
; MCPRO = EKG procedure number from Procedure/Subspecialty file
I '$D(MCOEON) D ORDER^MCPARAM I '$D(MCOEON) Q ""
Q $P(^MCAR(697.2,MCPRO,0),U,8)
;
HSHAKE ; MUSE dialog, called by LAB which executes HANDSHAKE fld of AI file
; Does checksum on MUSE input, sets OUT to ACK or NAK
I IN="BYE" S OUT="" K MCSM Q
I IN="HELLO" S T=T-BASE,OUT="ACK" K MCSM
I IN?.E1.A.E N MCI S MCSM=0 F MCI=1:1:$L(IN) S MCSM=MCSM+$A(IN,MCI)
I IN?1.5N,$D(MCSM) S T=T-BASE S:MCSM'=IN OUT="NAK" S:MCSM=IN OUT="ACK" K MCSM
K MCI Q
QUIT L +^LA(TSK) H 1
K ^LA(TSK)
L -^LA(TSK)
K ^LA("LOCK",TSK)
D DQ^%ZTLOAD
S:$D(ZTQUEUED) ZTREQ="@" K ZTSK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM 4785 printed Apr 09, 2024@21:18:13 Page 2
MCARAM ;WASH ISC/JKL-MUSE AUTO INSTRUMENT DATA LOAD INTO DHCP ;5/28/96 14:53
+1 ;;2.3;Medicine;;09/13/1996
+2 ;
+3 ;
START ; Driver for MUSE-run by task manager
+1 ; WHERE: LANM,TSK,MCINST,T are required for MCARASE
+2 ; LANM = routine name, T and TSK = auto instrument IEN,
+3 ; MCINST = auto instrument name
+4 ; MCL = data type line number, MCLT = data transmission line number
+5 ; MCD = one line of lab data, MCA = array of local data,
+6 ; MCE = internal record number of EKG file where data is stored
+7 ; MCRD = attempts to read lab data
+8 ; MCCD= current data transmission number
+9 ; MCPRO= EKG procedure number from Procedure/Subspecialty file
+10 NEW LANM,TSK,MCINST,T,MCL,MCLT,MCA,MCCD,MCCNT,MCE,MCERR,MCRD,MCPRO,MCPRNM
+11 NEW MCS,MCTOT,MCTYPE,MCZ,MCREC
+12 SET LANM=$TEXT(+0)
SET TSK=$ORDER(^LAB(62.4,"C",LANM,0))
SET U="^"
IF TSK=""
QUIT
+13 ; Quit if no MUSE data
+14 IF '$DATA(^LA(TSK,"I",0))
QUIT
+15 SET MCINST=$PIECE(^LAB(62.4,TSK,0),U)
DO ^MCARASE
IF 'TSK
QUIT
+16 SET @TRAP
+17 ;initial error condition
+18 SET MCA("ERR")=0
+19 ;get EKG procedure number from Procedure/Subspecialty file
+20 SET MCPRO=$ORDER(^MCAR(697.2,"C","MCAR(691.5",0))
+21 ;print name for ECG procedure, type of transmission
+22 SET MCPRNM=$$ORPRM(MCPRO)
SET MCTYPE="M"
+23 ;delay process until record data is complete
+24 DO DELPRO
+25 ;
READ SET MCRD=0
SET MCL=0
SET MCCD=-1
SET MCA("CONT")="@"
+1 IF ^LA(TSK,"I",0)'=0
SET MCLT=^LA(TSK,"I",0)+1
SET MCCD=MCLT-1
+2 DO IN
GOTO QUIT
IN SET MCLT=^LA(TSK,"I",0)+1
IF '$DATA(^(MCLT))
SET MCRD=MCRD+1
if MCRD>6
QUIT
HANG 8
GOTO IN
+1 SET ^LA(TSK,"I",0)=MCLT
SET MCRD=0
SET MCERR=0
+2 IF '$DATA(MCREC)
FOR MCZ=1:1
if '$DATA(^LA(TSK,"I",MCLT+MCZ))
DO DELPRO
IF ($DATA(^LA(TSK,"I",MCLT+MCZ))#2)
IF ((^LA(TSK,"I",MCLT+MCZ)["EOR")!(^LA(TSK,"I",MCLT+MCZ)["ERR")!(^LA(TSK,"I",MCLT+MCZ)["BYE"))
SET MCREC=""
QUIT
+3 IF '$DATA(MCA("ERR"))
SET MCA("ERR")=0
+4 ;ignore set if retransmit set of data lines
+5 IF $DATA(^LA(TSK,"I",MCLT+3))
IF ^LA(TSK,"I",MCLT+3)=^LA(TSK,"I",MCLT)
IF ^LA(TSK,"I",MCLT)?.E1.A.E
SET MCCD=MCCD+3
SET ^LA(TSK,"I",0)=MCLT+2
GOTO IN
+6 ;check for start of transmission-suppressed H
+7 IF $EXTRACT(^LA(TSK,"I",MCLT),1,5)="HELLO"
SET MCCD=MCLT-3
+8 ;check for start of transmission-IRM
+9 IF $EXTRACT(^LA(TSK,"I",MCLT),1,3)="IRM"
SET MCCD=MCLT-3
+10 ;transfer one line of lab data to local array
+11 IF MCCD+3=MCLT
SET MCERR=$$RLAB^MCARAM(.MCA,.MCL,MCLT)
+12 ;transmission error
+13 IF +MCERR=5
KILL MCA,MCERR,MCREC
NEW MCA,MCERR
GOTO IN
+14 ;transfer local array data into DHCP
+15 ;record successful or unsuccessful data transfer attempt
+16 IF +MCERR=10
if $$GRERR^MCARAM7(.MCA)=0
SET MCERR=$$LDHCP^MCARAM3(.MCA,.MCE)
SET MCERR=$$KPERR^MCARAM7(.MCA,.MCS)
KILL MCA,MCERR,MCE,MCS,MCREC
NEW MCA,MCERR,MCE,MCS
+17 GOTO IN
+18 ;
DELPRO ;delay process until record data is complete
+1 SET MCCNT=0
DELP IF $DATA(^LA(TSK,"I"))
SET MCTOT=^LA(TSK,"I")
SET MCCNT=MCCNT+1
HANG 15
IF MCTOT=^LA(TSK,"I")
IF MCCNT<7
GOTO DELP
+1 KILL MCTOT,MCCNT
+2 QUIT
+3 ;
+4 ;
OUT SET MCLT=^LA(TSK,"O")+1
SET ^("O")=MCLT
SET ^("O",MCLT)=OUT
+1 LOCK +^LA("Q")
SET Q=^LA("Q")+1
SET ^("Q")=Q
SET ^("Q",Q)=TSK
LOCK -^LA("Q")
QUIT
+2 QUIT
+3 ;
+4 ;
RLAB(MCA,MCL,MCLT) ; Read Lab data and place in local array
+1 ; USAGE: S X=$$RLAB^MCARAM(.A,.B,C)
+2 ; WHERE: .A=Array into which data is placed
+3 ; .B=Data type line number
+4 ; C=Data transmission line number
+5 ;
+6 ;lab data
+7 SET MCD=^LA(TSK,"I",MCLT)
+8 IF ($EXTRACT(MCD,1,5)="HELLO")!($EXTRACT(MCD,1,3)="EOT")
SET MCL=0
SET MCA("CONT")="@"
SET MCCD=MCLT-1
QUIT 0
+9 IF $EXTRACT(MCD,1,3)="BYE"
SET MCL=0
SET MCA("CONT")="@"
SET MCCD=MCLT-2
QUIT 0
+10 IF $EXTRACT(MCD,1,3)="IRM"
SET MCL=0
SET MCA("CONT")="@"
SET MCCD=MCLT
QUIT 0
+11 IF $EXTRACT(MCD,1,3)="EOR"
SET MCERR="10-End of record"
SET MCCD=MCLT
QUIT MCERR
+12 IF $EXTRACT(MCD,1,3)="ERR"
SET MCERR="5-Transmission error-expect retry of record"
SET MCL=0
SET MCA("CONT")="@"
SET MCCD=MCLT-1
QUIT MCERR
+13 SET MCL=MCL+1
SET MCA("CONT")=$CHAR($ASCII(MCA("CONT"))+1)
+14 ;transfer lab data to local
+15 IF MCL<13
SET MCTR=$SELECT(MCL<7:"S MCERR=$$L"_MCL_"^MCARAM1(.MCA,MCD)",MCL=12:"S MCERR=$$L"_MCL_"^MCARAM3(.MCA,MCD)",MCL>6:"S MCERR=$$L"_MCL_"^MCARAM2(.MCA,MCD)")
XECUTE MCTR
SET MCCD=MCLT
if +MCERR>0
QUIT MCERR
QUIT 0
+16 ;fill diagnosis array
+17 IF MCL>12
SET MCERR=$$DGCT^MCARAM4(.MCA,MCD,MCL)
SET MCCD=MCLT
IF +MCERR>0
QUIT MCERR
+18 QUIT 0
+19 ;
TRAP ;entry from MCARASE
+1 KILL ^LA("LOCK",TSK)
SET T=TSK
DO SET^MCARASE
+2 SET ^LA(TSK,"Q")=0
DO ERROR^MCARASE
+3 GOTO @(U_LANM)
+4 ;
ORPRM(MCPRO) ;Get print name for ECG procedure
+1 ;USAGE: S X=$$ORPRM(MCPRO)
+2 ;WHERE: X = print name for ECG procedure/subspecialty
+3 ; MCPRO = EKG procedure number from Procedure/Subspecialty file
+4 IF '$DATA(MCOEON)
DO ORDER^MCPARAM
IF '$DATA(MCOEON)
QUIT ""
+5 QUIT $PIECE(^MCAR(697.2,MCPRO,0),U,8)
+6 ;
HSHAKE ; MUSE dialog, called by LAB which executes HANDSHAKE fld of AI file
+1 ; Does checksum on MUSE input, sets OUT to ACK or NAK
+2 IF IN="BYE"
SET OUT=""
KILL MCSM
QUIT
+3 IF IN="HELLO"
SET T=T-BASE
SET OUT="ACK"
KILL MCSM
+4 IF IN?.E1.A.E
NEW MCI
SET MCSM=0
FOR MCI=1:1:$LENGTH(IN)
SET MCSM=MCSM+$ASCII(IN,MCI)
+5 IF IN?1.5N
IF $DATA(MCSM)
SET T=T-BASE
if MCSM'=IN
SET OUT="NAK"
if MCSM=IN
SET OUT="ACK"
KILL MCSM
+6 KILL MCI
QUIT
QUIT LOCK +^LA(TSK)
HANG 1
+1 KILL ^LA(TSK)
+2 LOCK -^LA(TSK)
+3 KILL ^LA("LOCK",TSK)
+4 DO DQ^%ZTLOAD
+5 if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ZTSK
+6 QUIT
