MCARAM2 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;2/13/98 09:12
;;2.3;Medicine;**16**;09/13/1996
;
;
;Modules to return lab data in a local array
; USAGE: S X=$$L#^MCARAM2(.A,B) , where # = integer from 7 to 12
; WHERE: .A=local array into which data is placed
; B=1 line of lab data
; if unsuccessful, returns an error message
; if successful, returns a function value of 0 and a value array:
; MCA(field #) = value of field
; MCA("CONT") = diagnosis line # in alphabetic form
; MCA("DX,#") = line of diagnosis data
; MCA("DT") = date/time in FM format
;
L7(MCA,MCD) ;Returns "DT" = date/time in FM format
; "DX,G" = 7th line of diagnosis
N MCERR,Y
S MCERR=$$AR^MCARAM4(.MCA,"DAY",MCD,11,22) Q:+MCERR=2 $$LOG^MCARAM7("51-Date is a null data field") I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"TM",MCD,23,31) Q:+MCERR=2 $$LOG^MCARAM7("51-Time is a null data field") I +MCERR>50 Q MCERR
S X=MCA("DAY")_"@"_MCA("TM")
I X?2N1"-"3A1"-"2N1"@"2N1":"2N Q $$LOG^MCARAM7("52-Date/Time not DD-MMM-YYYY@HH:MM")
I X'?2N1"-"3A1"-"4N1"@"2N1":"2N Q $$LOG^MCARAM7("52-Date/Time not DD-MMM-YYYY@HH:MM")
S %DT="RX" D ^%DT I Y'>0 Q $$LOG^MCARAM7("53-Date/Time rejected by %DT")
S:Y>0 MCA("DT")=Y
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
L8(MCA,MCD) ;Returns Field 3 = vent. rate, "DX,H" = 8th line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,3,MCD,11,18,1)
I +MCERR=2 K MCA(3) S MCERR=$$LOG^MCARAM7("2-Vent. rate is a null data field")
I +MCERR=1 K MCA(3) S MCERR=$$LOG^MCARAM7("1-Vent. rate not numeric")
I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
L9(MCA,MCD) ;Returns Field 4 = PR interval, "DX,I" = 9th line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,4,MCD,12,18,1)
I +MCERR=2 K MCA(4) S MCERR=$$LOG^MCARAM7("2-PR interval is a null data field")
I +MCERR=1 K MCA(4) S MCERR=$$LOG^MCARAM7("1-PR interval not numeric")
I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
L10(MCA,MCD) ;Returns Field 5 = QRS duration, "DX,J" =10th line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,5,MCD,13,18,1)
I +MCERR=2 K MCA(5) S MCERR=$$LOG^MCARAM7("2-QRS duration is a null data field")
I +MCERR=1 K MCA(5) S MCERR=$$LOG^MCARAM7("1-QRS duration not numeric")
I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
L11(MCA,MCD) ;Returns Field 6 = QT, 7 = QTc, "DX,K"=11th line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,6,MCD,7,14,1)
I +MCERR=2 K MCA(6) S MCERR=$$LOG^MCARAM7("2-QT is a null data field")
I +MCERR=1 K MCA(6) S MCERR=$$LOG^MCARAM7("1-QT not numeric")
I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,7,MCD,16,18,1)
I +MCERR=2 K MCA(7) S MCERR=$$LOG^MCARAM7("2-QTc is a null data field")
I +MCERR=1 K MCA(7) S MCERR=$$LOG^MCARAM7("1-QTc not numeric")
I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
KNMK ; Kill name check variables
K MCNAM,MCFNAM,MCLNAM,MC12NAM,MC12FNAM,MC12LNAM,MCA12 Q
;
ERR ;Error return
Q MCERR
DATE(MCDATE) ; Get the two digit century for the date
N MCMTH,A1,A2,A3,SD
S SD=$P(MCDATE,"@",1),A2=0
S A1=$P(SD,"-",2) G:A1'?3A EXIT
S A1=$TR(A1,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
S A2=$S(A1="JAN":1,A1="FEB":2,A1="MAR":3,A1="APR":4,A1="MAY":5,A1="JUN":6,A1="JUL":7,A1="AUG":8,A1="SEP":9,A1="OCT":10,A1="NOV":11,A1="DEC":12,1:0) G:'A2 EXIT
EXIT Q $E(MCDATE,1,7)_1700+$S(A2&(A2>$E(DT,4,5)):1700+$E(DT,1)_$E(MCDATE,8,15))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM2 3687 printed Oct 16, 2024@18:12:40 Page 2
MCARAM2 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;2/13/98 09:12
+1 ;;2.3;Medicine;**16**;09/13/1996
+2 ;
+3 ;
+4 ;Modules to return lab data in a local array
+5 ; USAGE: S X=$$L#^MCARAM2(.A,B) , where # = integer from 7 to 12
+6 ; WHERE: .A=local array into which data is placed
+7 ; B=1 line of lab data
+8 ; if unsuccessful, returns an error message
+9 ; if successful, returns a function value of 0 and a value array:
+10 ; MCA(field #) = value of field
+11 ; MCA("CONT") = diagnosis line # in alphabetic form
+12 ; MCA("DX,#") = line of diagnosis data
+13 ; MCA("DT") = date/time in FM format
+14 ;
L7(MCA,MCD) ;Returns "DT" = date/time in FM format
+1 ; "DX,G" = 7th line of diagnosis
+2 NEW MCERR,Y
+3 SET MCERR=$$AR^MCARAM4(.MCA,"DAY",MCD,11,22)
if +MCERR=2
QUIT $$LOG^MCARAM7("51-Date is a null data field")
IF +MCERR>50
QUIT MCERR
+4 SET MCERR=$$AR^MCARAM4(.MCA,"TM",MCD,23,31)
if +MCERR=2
QUIT $$LOG^MCARAM7("51-Time is a null data field")
IF +MCERR>50
QUIT MCERR
+5 SET X=MCA("DAY")_"@"_MCA("TM")
+6 IF X?2N1"-"3A1"-"2N1"@"2N1":"2N
QUIT $$LOG^MCARAM7("52-Date/Time not DD-MMM-YYYY@HH:MM")
+7 IF X'?2N1"-"3A1"-"4N1"@"2N1":"2N
QUIT $$LOG^MCARAM7("52-Date/Time not DD-MMM-YYYY@HH:MM")
+8 SET %DT="RX"
DO ^%DT
IF Y'>0
QUIT $$LOG^MCARAM7("53-Date/Time rejected by %DT")
+9 if Y>0
SET MCA("DT")=Y
+10 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+11 QUIT 0
+12 ;
L8(MCA,MCD) ;Returns Field 3 = vent. rate, "DX,H" = 8th line of diagnosis
+1 NEW MCERR
+2 SET MCERR=$$AR^MCARAM4(.MCA,3,MCD,11,18,1)
+3 IF +MCERR=2
KILL MCA(3)
SET MCERR=$$LOG^MCARAM7("2-Vent. rate is a null data field")
+4 IF +MCERR=1
KILL MCA(3)
SET MCERR=$$LOG^MCARAM7("1-Vent. rate not numeric")
+5 IF +MCERR>50
QUIT MCERR
+6 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+7 QUIT 0
+8 ;
L9(MCA,MCD) ;Returns Field 4 = PR interval, "DX,I" = 9th line of diagnosis
+1 NEW MCERR
+2 SET MCERR=$$AR^MCARAM4(.MCA,4,MCD,12,18,1)
+3 IF +MCERR=2
KILL MCA(4)
SET MCERR=$$LOG^MCARAM7("2-PR interval is a null data field")
+4 IF +MCERR=1
KILL MCA(4)
SET MCERR=$$LOG^MCARAM7("1-PR interval not numeric")
+5 IF +MCERR>50
QUIT MCERR
+6 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+7 QUIT 0
+8 ;
L10(MCA,MCD) ;Returns Field 5 = QRS duration, "DX,J" =10th line of diagnosis
+1 NEW MCERR
+2 SET MCERR=$$AR^MCARAM4(.MCA,5,MCD,13,18,1)
+3 IF +MCERR=2
KILL MCA(5)
SET MCERR=$$LOG^MCARAM7("2-QRS duration is a null data field")
+4 IF +MCERR=1
KILL MCA(5)
SET MCERR=$$LOG^MCARAM7("1-QRS duration not numeric")
+5 IF +MCERR>50
QUIT MCERR
+6 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+7 QUIT 0
+8 ;
L11(MCA,MCD) ;Returns Field 6 = QT, 7 = QTc, "DX,K"=11th line of diagnosis
+1 NEW MCERR
+2 SET MCERR=$$AR^MCARAM4(.MCA,6,MCD,7,14,1)
+3 IF +MCERR=2
KILL MCA(6)
SET MCERR=$$LOG^MCARAM7("2-QT is a null data field")
+4 IF +MCERR=1
KILL MCA(6)
SET MCERR=$$LOG^MCARAM7("1-QT not numeric")
+5 IF +MCERR>50
QUIT MCERR
+6 SET MCERR=$$AR^MCARAM4(.MCA,7,MCD,16,18,1)
+7 IF +MCERR=2
KILL MCA(7)
SET MCERR=$$LOG^MCARAM7("2-QTc is a null data field")
+8 IF +MCERR=1
KILL MCA(7)
SET MCERR=$$LOG^MCARAM7("1-QTc not numeric")
+9 IF +MCERR>50
QUIT MCERR
+10 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+11 QUIT 0
+12 ;
KNMK ; Kill name check variables
+1 KILL MCNAM,MCFNAM,MCLNAM,MC12NAM,MC12FNAM,MC12LNAM,MCA12
QUIT
+2 ;
ERR ;Error return
+1 QUIT MCERR
DATE(MCDATE) ; Get the two digit century for the date
+1 NEW MCMTH,A1,A2,A3,SD
+2 SET SD=$PIECE(MCDATE,"@",1)
SET A2=0
+3 SET A1=$PIECE(SD,"-",2)
if A1'?3A
GOTO EXIT
+4 SET A1=$TRANSLATE(A1,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+5 SET A2=$SELECT(A1="JAN":1,A1="FEB":2,A1="MAR":3,A1="APR":4,A1="MAY":5,A1="JUN":6,A1="JUL":7,A1="AUG":8,A1="SEP":9,A1="OCT":10,A1="NOV":11,A1="DEC":12,1:0)
if 'A2
GOTO EXIT
EXIT QUIT $EXTRACT(MCDATE,1,7)_1700+$SELECT(A2&(A2>$EXTRACT(DT,4,5)):1700+$EXTRACT(DT,1)_$EXTRACT(MCDATE,8,15))
