MCARAM1 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;4/27/99 09:50
;;2.3;Medicine;**23**;09/13/1996
;
;
;Modules to return lab data in a local array
; USAGE: S X=$$L#^MCARAM1(.A,B) , where # = integer from 1 to 6
; 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")= line # of diagnosis in alphabetic form
; MCA("DX,#") = line of diagnosis data
; MCA("RX,#")=parsed medication line
; MCA("NAME") = patient name, MCA("AGE")= patient age
; MCA("RACE") = patient race, MCA("SEX")= patient sex
L1(MCA,MCD) ;Returns "DX,A" = 1st line of diagnosis, Field 2=Type of EKG
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,84) I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,2,MCD,85,134) I +MCERR>50 Q MCERR
S MCA(2)=$S(MCA(2)["STAT":"S",MCA(2)["ROUT":"R",MCA(2)["ORIG":"O",1:"")
I MCA(2)="" K MCA(2) Q $$LOG^MCARAM7("2-EKG Type is a null data field")
Q 0
;
L2(MCA,MCD) ;Returns "NAME" = patient name, "DX,B" = 2nd line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,"NAME",MCD,1,31) Q:+MCERR>50 MCERR I +MCERR=2 S MCA("NAME")="No patient name" Q $$LOG^MCARAM7("57-Name is a null data field")
S:MCA("NAME")[", " MCA("NAME")=$P(MCA("NAME"),", ")_","_$P(MCA("NAME"),", ",2)
S MCA("NAME")=$$UP^XLFSTR(MCA("NAME"))
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
L3(MCA,MCD) ;Returns Field .02=Social Security number
; Field 18=Ward/Clinic, "DX,C" = 3rd line of diagnosis
N MCERR,MCI
S MCA(.02)=$E(MCD,4,12),MCERR=$$DFCK^MCARAM4(MCA(.02),1) Q:+MCERR>50 MCERR Q:+MCERR=1 $$LOG^MCARAM7("54-Social Security Number is not numeric") I +MCERR=2 Q $$LOG^MCARAM7("54-Social Security Number is a null data field")
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,18,MCD,18,31) I +MCERR>50 Q MCERR
I +MCERR=2 K MCA(18) S MCERR=$$LOG^MCARAM7("2-Ward/Clinic is a null data field") Q MCERR
S MCI=MCA(18) K MCA(18)
I $D(^SC("B",MCI))!$D(^SC("C",MCI)) S MCA(18)=$O(^(MCI,0))
I '$D(MCA(18)) S MCERR=$$LOG^MCARAM7("1-Undefined Ward/Clinic")
Q 0
;
L4(MCA,MCD) ;Returns "AGE"=patient age, Field .08=height, .07=weight
; "RACE"=race, "SEX"=patient sex, "DX,D" = 4th line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,"AGE",MCD,1,5,1) I +MCERR>50 Q MCERR
I +MCERR=2 K MCA("AGE") S MCERR=$$LOG^MCARAM7("2-Age is a null data field")
I +MCERR=1 K MCA("AGE") S MCERR=$$LOG^MCARAM7("1-Age is not a numerical data field")
S MCERR=$$AR^MCARAM4(.MCA,.08,MCD,8,11,1) I +MCERR>50 Q MCERR
I +MCERR=2 K MCA(.08) S MCERR=$$LOG^MCARAM7("2-Height is a null data field")
I +MCERR=1 K MCA(.08) S MCERR=$$LOG^MCARAM7("1-Height is not a numerical data field")
S MCERR=$$AR^MCARAM4(.MCA,.07,MCD,14,17,1) I +MCERR>50 Q MCERR
I +MCERR=2 K MCA(.07) S MCERR=$$LOG^MCARAM7("2-Weight is a null data field")
I +MCERR=1 K MCA(.07) S MCERR=$$LOG^MCARAM7("2-Weight is not a numerical data field")
S MCERR=$$AR^MCARAM4(.MCA,"RACE",MCD,21,24) I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"SEX",MCD,25,31) I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
L5(MCA,MCD) ;Returns "RX", #s = data for each medication
; "DX,E" = 5th line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,"RX,0",MCD,5,31) I +MCERR>50 Q MCERR
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
L6(MCA,MCD) ;Returns Field 16=systolic bp, 15=diastolic bp,
; "DX,F" = 6th line of diagnosis
N MCERR
S MCERR=$$AR^MCARAM4(.MCA,16,MCD,11,13,1) Q:+MCERR>50 MCERR I +MCERR=2 K MCA(16) S MCERR=$$LOG^MCARAM7("2-Systolic bp is a null data field")
I +MCERR=1 K MCA(16) S MCERR=$$LOG^MCARAM7("2-Systolic bp is not a numerical data field")
S MCERR=$$AR^MCARAM4(.MCA,15,MCD,15,17,1) Q:+MCERR>50 MCERR I +MCERR=2 K MCA(15) S MCERR=$$LOG^MCARAM7("2-Diastolic bp is a null data field")
I +MCERR=1 K MCA(15) S MCERR=$$LOG^MCARAM7("2-Diastolic bp is not a numerical data field")
S MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134) I +MCERR>50 Q MCERR
Q 0
;
;
ERR ;Error return
Q MCERR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM1 4338 printed Apr 09, 2024@21:16:59 Page 2
MCARAM1 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;4/27/99 09:50
+1 ;;2.3;Medicine;**23**;09/13/1996
+2 ;
+3 ;
+4 ;Modules to return lab data in a local array
+5 ; USAGE: S X=$$L#^MCARAM1(.A,B) , where # = integer from 1 to 6
+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")= line # of diagnosis in alphabetic form
+12 ; MCA("DX,#") = line of diagnosis data
+13 ; MCA("RX,#")=parsed medication line
+14 ; MCA("NAME") = patient name, MCA("AGE")= patient age
+15 ; MCA("RACE") = patient race, MCA("SEX")= patient sex
L1(MCA,MCD) ;Returns "DX,A" = 1st line of diagnosis, Field 2=Type of EKG
+1 NEW MCERR
+2 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,84)
IF +MCERR>50
QUIT MCERR
+3 SET MCERR=$$AR^MCARAM4(.MCA,2,MCD,85,134)
IF +MCERR>50
QUIT MCERR
+4 SET MCA(2)=$SELECT(MCA(2)["STAT":"S",MCA(2)["ROUT":"R",MCA(2)["ORIG":"O",1:"")
+5 IF MCA(2)=""
KILL MCA(2)
QUIT $$LOG^MCARAM7("2-EKG Type is a null data field")
+6 QUIT 0
+7 ;
L2(MCA,MCD) ;Returns "NAME" = patient name, "DX,B" = 2nd line of diagnosis
+1 NEW MCERR
+2 SET MCERR=$$AR^MCARAM4(.MCA,"NAME",MCD,1,31)
if +MCERR>50
QUIT MCERR
IF +MCERR=2
SET MCA("NAME")="No patient name"
QUIT $$LOG^MCARAM7("57-Name is a null data field")
+3 if MCA("NAME")[", "
SET MCA("NAME")=$PIECE(MCA("NAME"),", ")_","_$PIECE(MCA("NAME"),", ",2)
+4 SET MCA("NAME")=$$UP^XLFSTR(MCA("NAME"))
+5 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+6 QUIT 0
+7 ;
L3(MCA,MCD) ;Returns Field .02=Social Security number
+1 ; Field 18=Ward/Clinic, "DX,C" = 3rd line of diagnosis
+2 NEW MCERR,MCI
+3 SET MCA(.02)=$EXTRACT(MCD,4,12)
SET MCERR=$$DFCK^MCARAM4(MCA(.02),1)
if +MCERR>50
QUIT MCERR
if +MCERR=1
QUIT $$LOG^MCARAM7("54-Social Security Number is not numeric")
IF +MCERR=2
QUIT $$LOG^MCARAM7("54-Social Security Number is a null data field")
+4 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+5 SET MCERR=$$AR^MCARAM4(.MCA,18,MCD,18,31)
IF +MCERR>50
QUIT MCERR
+6 IF +MCERR=2
KILL MCA(18)
SET MCERR=$$LOG^MCARAM7("2-Ward/Clinic is a null data field")
QUIT MCERR
+7 SET MCI=MCA(18)
KILL MCA(18)
+8 IF $DATA(^SC("B",MCI))!$DATA(^SC("C",MCI))
SET MCA(18)=$ORDER(^(MCI,0))
+9 IF '$DATA(MCA(18))
SET MCERR=$$LOG^MCARAM7("1-Undefined Ward/Clinic")
+10 QUIT 0
+11 ;
L4(MCA,MCD) ;Returns "AGE"=patient age, Field .08=height, .07=weight
+1 ; "RACE"=race, "SEX"=patient sex, "DX,D" = 4th line of diagnosis
+2 NEW MCERR
+3 SET MCERR=$$AR^MCARAM4(.MCA,"AGE",MCD,1,5,1)
IF +MCERR>50
QUIT MCERR
+4 IF +MCERR=2
KILL MCA("AGE")
SET MCERR=$$LOG^MCARAM7("2-Age is a null data field")
+5 IF +MCERR=1
KILL MCA("AGE")
SET MCERR=$$LOG^MCARAM7("1-Age is not a numerical data field")
+6 SET MCERR=$$AR^MCARAM4(.MCA,.08,MCD,8,11,1)
IF +MCERR>50
QUIT MCERR
+7 IF +MCERR=2
KILL MCA(.08)
SET MCERR=$$LOG^MCARAM7("2-Height is a null data field")
+8 IF +MCERR=1
KILL MCA(.08)
SET MCERR=$$LOG^MCARAM7("1-Height is not a numerical data field")
+9 SET MCERR=$$AR^MCARAM4(.MCA,.07,MCD,14,17,1)
IF +MCERR>50
QUIT MCERR
+10 IF +MCERR=2
KILL MCA(.07)
SET MCERR=$$LOG^MCARAM7("2-Weight is a null data field")
+11 IF +MCERR=1
KILL MCA(.07)
SET MCERR=$$LOG^MCARAM7("2-Weight is not a numerical data field")
+12 SET MCERR=$$AR^MCARAM4(.MCA,"RACE",MCD,21,24)
IF +MCERR>50
QUIT MCERR
+13 SET MCERR=$$AR^MCARAM4(.MCA,"SEX",MCD,25,31)
IF +MCERR>50
QUIT MCERR
+14 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+15 QUIT 0
+16 ;
L5(MCA,MCD) ;Returns "RX", #s = data for each medication
+1 ; "DX,E" = 5th line of diagnosis
+2 NEW MCERR
+3 SET MCERR=$$AR^MCARAM4(.MCA,"RX,0",MCD,5,31)
IF +MCERR>50
QUIT MCERR
+4 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+5 QUIT 0
+6 ;
L6(MCA,MCD) ;Returns Field 16=systolic bp, 15=diastolic bp,
+1 ; "DX,F" = 6th line of diagnosis
+2 NEW MCERR
+3 SET MCERR=$$AR^MCARAM4(.MCA,16,MCD,11,13,1)
if +MCERR>50
QUIT MCERR
IF +MCERR=2
KILL MCA(16)
SET MCERR=$$LOG^MCARAM7("2-Systolic bp is a null data field")
+4 IF +MCERR=1
KILL MCA(16)
SET MCERR=$$LOG^MCARAM7("2-Systolic bp is not a numerical data field")
+5 SET MCERR=$$AR^MCARAM4(.MCA,15,MCD,15,17,1)
if +MCERR>50
QUIT MCERR
IF +MCERR=2
KILL MCA(15)
SET MCERR=$$LOG^MCARAM7("2-Diastolic bp is a null data field")
+6 IF +MCERR=1
KILL MCA(15)
SET MCERR=$$LOG^MCARAM7("2-Diastolic bp is not a numerical data field")
+7 SET MCERR=$$AR^MCARAM4(.MCA,"DX,"_MCA("CONT"),MCD,32,134)
IF +MCERR>50
QUIT MCERR
+8 QUIT 0
+9 ;
+10 ;
ERR ;Error return
+1 QUIT MCERR
