LR7OR4 ;slc/dcm - Get Lab TEST Info ;8/11/97
;;5.2;LAB SERVICE;**256,356**;Sep 27, 1994;Build 8
;Entry points: EN
GET(TEST) ;Get TEST ifn
I '$D(TEST) Q ""
I TEST'?1N.N S TEST=$O(^LAB(60,"B",TEST,0)) Q:'TEST ""
I TEST?1N.N Q:'$D(^LAB(60,TEST)) ""
Q TEST
ONE(Y,TEST) ;Gets parameters for one test
N CNT
Q:'$L($G(TEST))
S CNT=0,TEST=+TEST
D EN
Q
ALL(Y,TESTS) ;Gets Lab Test ordering parameters from file 60
;TEST=Lab TEST (can be either name or internal #)
N I,CNT
Q:'$O(TESTS(0))
S (I,CNT)=0
F S I=$O(TESTS(I)) Q:'I S TEST=+TESTS(I) D EN S CNT=CNT+1,Y(CNT)="---------------------"
Q
EN Q:'$D(TEST)
N X0
S TEST=$$GET(TEST) Q:'TEST
S X0=^LAB(60,TEST,0),CNT=CNT+1,Y(CNT)=$P(X0,"^",1)
I $L($P(X0,"^",11)) S Y(CNT)=Y(CNT)_" $"_$J($P(X0,"^",11),4,2)
D URG
D GCOM
I $P(X0,"^",8),$O(^LAB(60,TEST,3,0)) S X=$G(^($O(^(0)),0)),CNT=CNT+1,Y(CNT)="Unique collection sample: "_$$SAMP(+X) ;$P($G(^LAB(62,+X,0)),"^")
I $P(X0,"^",9) S I=0 F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=+^(I,0) I X=$P(X0,"^",9) S CNT=CNT+1,Y(CNT)="Lab collect sample: "_$$SAMP(X) Q ;$P($G(^LAB(62,X,0)),"^") Q
;I $O(^LAB(60,TEST,3,0)) S X=$G(^($O(^(0)),0)),CNT=CNT+1,Y(CNT)="Default collection sample: "_$P($G(^LAB(62,+X,0)),"^")
D COLL,SUB
Q
COLL ;Get Collection Sample-Specimen data
N I,J,X,SAMP,SPEC,CHK
S I=0
F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=^(I,0) D
. S CNT=CNT+1,Y(CNT)="Collection sample: "_$$SAMP(X,$P(X0,"^",19))
. I $L($P(X,"^",2)) S CNT=CNT+1,Y(CNT)=" Form name/number: "_$P(X,"^",2)
. I $L($P(X,"^",4)) S CNT=CNT+1,Y(CNT)=" Minimum volume (in mls): "_$P(X,"^",4)
. I $L($P(X,"^",5)) S CNT=CNT+1,Y(CNT)=" Maximum order frequency: "_$P(X,"^",5)
. I $L($P(X,"^",7)) S CNT=CNT+1,Y(CNT)=" Maximum daily order frequency: "_$P(X,"^",7)
. I $O(^LAB(60,TEST,3,I,1,0)) S CNT=CNT+1,Y(CNT)=" Collection sample instructions: " D
.. S J=0 F S J=$O(^LAB(60,TEST,3,I,1,J)) Q:J<1 S CNT=CNT+1,Y(CNT)=" "_^(J,0)
;. I $O(^LAB(60,TEST,3,I,2,0)) S CNT=CNT+1,Y(CNT)=" Collection sample LAB processing instructions: " D
;.. S J=0 F S J=$O(^LAB(60,TEST,3,I,2,J)) Q:J<1 S CNT=CNT+1,Y(CNT)=" "_^(J,0)
S I=0
F S I=$O(^LAB(60,TEST,1,I)) Q:I<1 S X=^(I,0) D
. S CNT=CNT+1,Y(CNT)="Site/Specimen: "_$P($G(^LAB(61,+X,0)),"^")
. I $L($P(X,"^",2,3))>1 D CRRV("Reference range",$P(X,"^",2,3))
. I $L($P(X,"^",11,12))>1 D CRRV("Therapeutic range",$P(X,"^",11,12))
. I $L($P(X,"^",4,5))>1 D CRRV("Critical",$P(X,"^",4,5))
. I $L($P(X,"^",7)) S CNT=CNT+1,Y(CNT)=" Units: "_$P(X,"^",7)
. I $O(^LAB(60,TEST,1,I,1,0)) S CNT=CNT+1,Y(CNT)=" Interpretation: "
. S J=0 F S J=$O(^LAB(60,TEST,1,I,1,J)) Q:'J S X=^(J,0),CNT=CNT+1,Y(CNT)=" "_X
Q
URG ;Get Urgency params for TEST
N I,X,URG
I $P(X0,"^",18) S CNT=CNT+1,Y(CNT)="Default urgency: "_$P($G(^LAB(62.05,+$P(X0,"^",18),0)),"^")
I $P(X0,"^",16) S CNT=CNT+1,Y(CNT)="Highest urgency allowed: "_$P($G(^LAB(62.05,+$P(X0,"^",16),0)),"^")
Q
SAMP(X,REQ) ;Build Collection Sample data
;X=zero node from ^LAB(60,TEST,3,ifn,0) or ptr to 62
;REQ=Required comment from $P(^LAB(60,TEST,0),"^",19)
N X0,Y1
Q:'$D(^LAB(62,+X,0)) "" S X0=^(0)
;S REQ=$S($P(X,"^",6):$P(X,"^",6),$G(REQ):REQ,1:""),REQ=$S(REQ:$P($G(^LAB(62.07,REQ,0)),"^"),1:"")
;S Y1=+X_"^"_$P(X0,"^")_"^"_$P(X0,"^",2)_"^"_$P(X0,"^",3)_"^"_$P(X,"^",5)_"^"_$P(X,"^",7)_"^"_$P(X0,"^",7)_"^"_REQ
S Y1=$P(X0,"^")_" "_$P(X0,"^",3)
Q Y1
GCOM ;Get General Ward & Lab Instructions
;TEST=ptr to TEST in file 60
N I
S I=0
I $O(^LAB(60,+$G(TEST),6,0)) S CNT=CNT+1,Y(CNT)="General instructions: "
F S I=$O(^LAB(60,TEST,6,I)) Q:'I S CNT=CNT+1,Y(CNT)=" "_^(I,0)
S I=0
;I $O(^LAB(60,+$G(TEST),7,0)) S CNT=CNT+1,Y(CNT)="General LAB processing instructions: "
;F S I=$O(^LAB(60,TEST,7,I)) Q:'I S CNT=CNT+1,Y(CNT)=" "_^(I,0)
Q
SUB ;Tests in panel
N I
S I=0
I $O(^LAB(60,+$G(TEST),2,0)) S I=0,CNT=CNT+1,Y(CNT)="Tests included in panel: "
F S I=$O(^LAB(60,TEST,2,I)) Q:'I S X=^(I,0),CNT=CNT+1,Y(CNT)=" "_$P($G(^LAB(60,+X,0)),"^")
Q
;Added to support LR*5.2*356, PSI-06-025
CRRV(RT,RV) ;Convert Referance Range Values - convert embedded M code into a more readable format
;Variables passed in:
;RT - Refereance range Text
;RV - Refereance range Value
; 1st piece holds low value
; 2nd piece holds high value
;Routine variables
;Y() - The return array with the lab test information
;CNT - The counter variable used to create nodes in the Y array variable
;Local variables
;SP5 - 5 embedded spaces for output alinement
;SP10 - 10 embedded spaces for output alinement
;X - Work variable
N SP5,SP10,X
S SP5=" ",SP10=SP5_SP5,X=""
I RV'["$S(" D Q
. I $L($P(RV,"^")),'$L($P(RV,"^",2)),$P(RV,"^")?.ANP S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^")?.N:" low : "_$TR($P(RV,"^"),""""),1:" : "_$TR($P(RV,"^"),"""")) Q
. I '$L($P(RV,"^")),$L($P(RV,"^",2)),$P(RV,"^",2)?.ANP S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^",2)?.N:" high : "_$TR($P(RV,"^",2),""""),1:" : "_$TR($P(RV,"^",2),"""")) Q
. I $L($P(RV,"^")) S CNT=CNT+1,Y(CNT)=SP5_RT_" low : "_$TR($P(RV,"^"),"""")
. I $L($P(RV,"^",2)) S CNT=CNT+1,Y(CNT)=SP5_RT_" high : "_$TR($P(RV,"^",2),"""")
. ;I $L($P(RV,"^")) S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^")?.AP:" : "_$TR($P(RV,"^"),""""),1:" low : "_$TR($P(RV,"^"),""""))
. ;I $L($P(RV,"^",2)) S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^",2)?.AP:" : "_$TR($P(RV,"^",2),""""),1:" high : "_$TR($P(RV,"^",2),""""))
I RV["SEX" D Q
. I RV["AGE" S CNT=CNT+1,Y(CNT)=SP5_RT_" - Age and sex dependent range values, please contact lab for specifics." Q
. S CNT=CNT+1,Y(CNT)=SP5_RT
. I $L($$GSV($P(RV,"^"),"M")) S CNT=CNT+1,Y(CNT)=SP10_"Male "_$S($$GSV($P(RV,"^"),"M")?.AP:": "_$TR($$GSV($P(RV,"^"),"M"),""""),1:"low : "_$TR($$GSV($P(RV,"^"),"M"),""""))
. I $L($$GSV($P(RV,"^",2),"M")) S CNT=CNT+1,Y(CNT)=SP10_"Male "_$S($$GSV($P(RV,"^",2),"M")?.AP:$TR($$GSV($P(RV,"^",2),"M"),""""),1:"high : "_$TR($$GSV($P(RV,"^",2),"M"),""""))
. I $L($$GSV($P(RV,"^"),"F")) S CNT=CNT+1,Y(CNT)=SP10_"Female "_$S($$GSV($P(RV,"^"),"F")?.AP:": "_$TR($$GSV($P(RV,"^"),"F"),""""),1:"low : "_$TR($$GSV($P(RV,"^"),"F"),""""))
. I $L($$GSV($P(RV,"^",2),"F")) S CNT=CNT+1,Y(CNT)=SP10_"Female "_$S($$GSV($P(RV,"^",2),"F")?.AP:$TR($$GSV($P(RV,"^",2),"F"),""""),1:"high : "_$TR($$GSV($P(RV,"^",2),"F"),""""))
I RV["AGE" D Q
. S CNT=CNT+1,Y(CNT)=SP5_RT
. I $L($P(RV,"^")) D FAVO($P(RV,"^"),"low")
. I $L($P(RV,"^",2)) D FAVO($P(RV,"^",2),"high")
GSV(X,SEX) ;Get Sex Value
;Variables passed in:
;X - Work variable low/high range value
;SEX - Patient's sex
;Subroutine variables:
;X1 - Return value variable with the resolved low/high value
N X1
S @("X1="_$S($L(X):X,1:""""""))
Q X1
FAVO(X,HL) ;Format Age Value Output
;Variables passed in:
;X - Work variable with low/high range value
;HL - This will be for either a low or high reference range
;Subroutine variables:
;AT0 - Common text for output
;AT1 - Embedded M code tested for
;AT2 - Text description for embedded M code for output
;IO - Counter to piece the low/high range value
;I1 - Counter to reformat the embedded M code
;SP10 - 10 embedded spaces for output alinement
;X0,X1,X2 - Work variables used in converting the low/high range value
N AT0,AT1,AT2,I0,I1,SP10,X0,X1,X2
S AT0="If Age is "
S AT1="",AT1(1)="AGE<",AT1(2)="AGE>",AT1(3)="AGE'<",AT1(4)="AGE'>",AT1(5)="AGE="
S AT2="",AT2(1)="less than ",AT2(2)="greater than "
S AT2(3)="not less than ",AT2(4)="not greater than ",AT2(5)="equal to "
S SP10=" "
S X0=$E(X,4,$L(X)-1),(X1,X2)=""
F I0=1:1 S X1=$P(X0,",",I0) Q:X1="" D
. I $P(X1,":")=1 S X2=SP10_"Default "_HL_": "_$P(X1,":",2),CNT=CNT+1,Y(CNT)=$TR(X2,"""")
. E D
. . F I1=1:1:5 I $P(X1,":")[AT1(I1) S X2=SP10_AT0_AT2(I1)_$E($P(X1,":"),$L(AT1(I1))+1,$L($P(X1,":")))_" the "_HL_" is "_$P(X1,":",2),CNT=CNT+1,Y(CNT)=$TR(X2,"""")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OR4 7961 printed Oct 16, 2024@18:06:07 Page 2
LR7OR4 ;slc/dcm - Get Lab TEST Info ;8/11/97
+1 ;;5.2;LAB SERVICE;**256,356**;Sep 27, 1994;Build 8
+2 ;Entry points: EN
GET(TEST) ;Get TEST ifn
+1 IF '$DATA(TEST)
QUIT ""
+2 IF TEST'?1N.N
SET TEST=$ORDER(^LAB(60,"B",TEST,0))
if 'TEST
QUIT ""
+3 IF TEST?1N.N
if '$DATA(^LAB(60,TEST))
QUIT ""
+4 QUIT TEST
ONE(Y,TEST) ;Gets parameters for one test
+1 NEW CNT
+2 if '$LENGTH($GET(TEST))
QUIT
+3 SET CNT=0
SET TEST=+TEST
+4 DO EN
+5 QUIT
ALL(Y,TESTS) ;Gets Lab Test ordering parameters from file 60
+1 ;TEST=Lab TEST (can be either name or internal #)
+2 NEW I,CNT
+3 if '$ORDER(TESTS(0))
QUIT
+4 SET (I,CNT)=0
+5 FOR
SET I=$ORDER(TESTS(I))
if 'I
QUIT
SET TEST=+TESTS(I)
DO EN
SET CNT=CNT+1
SET Y(CNT)="---------------------"
+6 QUIT
EN if '$DATA(TEST)
QUIT
+1 NEW X0
+2 SET TEST=$$GET(TEST)
if 'TEST
QUIT
+3 SET X0=^LAB(60,TEST,0)
SET CNT=CNT+1
SET Y(CNT)=$PIECE(X0,"^",1)
+4 IF $LENGTH($PIECE(X0,"^",11))
SET Y(CNT)=Y(CNT)_" $"_$JUSTIFY($PIECE(X0,"^",11),4,2)
+5 DO URG
+6 DO GCOM
+7 ;$P($G(^LAB(62,+X,0)),"^")
IF $PIECE(X0,"^",8)
IF $ORDER(^LAB(60,TEST,3,0))
SET X=$GET(^($ORDER(^(0)),0))
SET CNT=CNT+1
SET Y(CNT)="Unique collection sample: "_$$SAMP(+X)
+8 ;$P($G(^LAB(62,X,0)),"^") Q
IF $PIECE(X0,"^",9)
SET I=0
FOR
SET I=$ORDER(^LAB(60,TEST,3,I))
if I<1
QUIT
SET X=+^(I,0)
IF X=$PIECE(X0,"^",9)
SET CNT=CNT+1
SET Y(CNT)="Lab collect sample: "_$$SAMP(X)
QUIT
+9 ;I $O(^LAB(60,TEST,3,0)) S X=$G(^($O(^(0)),0)),CNT=CNT+1,Y(CNT)="Default collection sample: "_$P($G(^LAB(62,+X,0)),"^")
+10 DO COLL
DO SUB
+11 QUIT
COLL ;Get Collection Sample-Specimen data
+1 NEW I,J,X,SAMP,SPEC,CHK
+2 SET I=0
+3 FOR
SET I=$ORDER(^LAB(60,TEST,3,I))
if I<1
QUIT
SET X=^(I,0)
Begin DoDot:1
+4 SET CNT=CNT+1
SET Y(CNT)="Collection sample: "_$$SAMP(X,$PIECE(X0,"^",19))
+5 IF $LENGTH($PIECE(X,"^",2))
SET CNT=CNT+1
SET Y(CNT)=" Form name/number: "_$PIECE(X,"^",2)
+6 IF $LENGTH($PIECE(X,"^",4))
SET CNT=CNT+1
SET Y(CNT)=" Minimum volume (in mls): "_$PIECE(X,"^",4)
+7 IF $LENGTH($PIECE(X,"^",5))
SET CNT=CNT+1
SET Y(CNT)=" Maximum order frequency: "_$PIECE(X,"^",5)
+8 IF $LENGTH($PIECE(X,"^",7))
SET CNT=CNT+1
SET Y(CNT)=" Maximum daily order frequency: "_$PIECE(X,"^",7)
+9 IF $ORDER(^LAB(60,TEST,3,I,1,0))
SET CNT=CNT+1
SET Y(CNT)=" Collection sample instructions: "
Begin DoDot:2
+10 SET J=0
FOR
SET J=$ORDER(^LAB(60,TEST,3,I,1,J))
if J<1
QUIT
SET CNT=CNT+1
SET Y(CNT)=" "_^(J,0)
End DoDot:2
End DoDot:1
+11 ;. I $O(^LAB(60,TEST,3,I,2,0)) S CNT=CNT+1,Y(CNT)=" Collection sample LAB processing instructions: " D
+12 ;.. S J=0 F S J=$O(^LAB(60,TEST,3,I,2,J)) Q:J<1 S CNT=CNT+1,Y(CNT)=" "_^(J,0)
+13 SET I=0
+14 FOR
SET I=$ORDER(^LAB(60,TEST,1,I))
if I<1
QUIT
SET X=^(I,0)
Begin DoDot:1
+15 SET CNT=CNT+1
SET Y(CNT)="Site/Specimen: "_$PIECE($GET(^LAB(61,+X,0)),"^")
+16 IF $LENGTH($PIECE(X,"^",2,3))>1
DO CRRV("Reference range",$PIECE(X,"^",2,3))
+17 IF $LENGTH($PIECE(X,"^",11,12))>1
DO CRRV("Therapeutic range",$PIECE(X,"^",11,12))
+18 IF $LENGTH($PIECE(X,"^",4,5))>1
DO CRRV("Critical",$PIECE(X,"^",4,5))
+19 IF $LENGTH($PIECE(X,"^",7))
SET CNT=CNT+1
SET Y(CNT)=" Units: "_$PIECE(X,"^",7)
+20 IF $ORDER(^LAB(60,TEST,1,I,1,0))
SET CNT=CNT+1
SET Y(CNT)=" Interpretation: "
+21 SET J=0
FOR
SET J=$ORDER(^LAB(60,TEST,1,I,1,J))
if 'J
QUIT
SET X=^(J,0)
SET CNT=CNT+1
SET Y(CNT)=" "_X
End DoDot:1
+22 QUIT
URG ;Get Urgency params for TEST
+1 NEW I,X,URG
+2 IF $PIECE(X0,"^",18)
SET CNT=CNT+1
SET Y(CNT)="Default urgency: "_$PIECE($GET(^LAB(62.05,+$PIECE(X0,"^",18),0)),"^")
+3 IF $PIECE(X0,"^",16)
SET CNT=CNT+1
SET Y(CNT)="Highest urgency allowed: "_$PIECE($GET(^LAB(62.05,+$PIECE(X0,"^",16),0)),"^")
+4 QUIT
SAMP(X,REQ) ;Build Collection Sample data
+1 ;X=zero node from ^LAB(60,TEST,3,ifn,0) or ptr to 62
+2 ;REQ=Required comment from $P(^LAB(60,TEST,0),"^",19)
+3 NEW X0,Y1
+4 if '$DATA(^LAB(62,+X,0))
QUIT ""
SET X0=^(0)
+5 ;S REQ=$S($P(X,"^",6):$P(X,"^",6),$G(REQ):REQ,1:""),REQ=$S(REQ:$P($G(^LAB(62.07,REQ,0)),"^"),1:"")
+6 ;S Y1=+X_"^"_$P(X0,"^")_"^"_$P(X0,"^",2)_"^"_$P(X0,"^",3)_"^"_$P(X,"^",5)_"^"_$P(X,"^",7)_"^"_$P(X0,"^",7)_"^"_REQ
+7 SET Y1=$PIECE(X0,"^")_" "_$PIECE(X0,"^",3)
+8 QUIT Y1
GCOM ;Get General Ward & Lab Instructions
+1 ;TEST=ptr to TEST in file 60
+2 NEW I
+3 SET I=0
+4 IF $ORDER(^LAB(60,+$GET(TEST),6,0))
SET CNT=CNT+1
SET Y(CNT)="General instructions: "
+5 FOR
SET I=$ORDER(^LAB(60,TEST,6,I))
if 'I
QUIT
SET CNT=CNT+1
SET Y(CNT)=" "_^(I,0)
+6 SET I=0
+7 ;I $O(^LAB(60,+$G(TEST),7,0)) S CNT=CNT+1,Y(CNT)="General LAB processing instructions: "
+8 ;F S I=$O(^LAB(60,TEST,7,I)) Q:'I S CNT=CNT+1,Y(CNT)=" "_^(I,0)
+9 QUIT
SUB ;Tests in panel
+1 NEW I
+2 SET I=0
+3 IF $ORDER(^LAB(60,+$GET(TEST),2,0))
SET I=0
SET CNT=CNT+1
SET Y(CNT)="Tests included in panel: "
+4 FOR
SET I=$ORDER(^LAB(60,TEST,2,I))
if 'I
QUIT
SET X=^(I,0)
SET CNT=CNT+1
SET Y(CNT)=" "_$PIECE($GET(^LAB(60,+X,0)),"^")
+5 QUIT
+6 ;Added to support LR*5.2*356, PSI-06-025
CRRV(RT,RV) ;Convert Referance Range Values - convert embedded M code into a more readable format
+1 ;Variables passed in:
+2 ;RT - Refereance range Text
+3 ;RV - Refereance range Value
+4 ; 1st piece holds low value
+5 ; 2nd piece holds high value
+6 ;Routine variables
+7 ;Y() - The return array with the lab test information
+8 ;CNT - The counter variable used to create nodes in the Y array variable
+9 ;Local variables
+10 ;SP5 - 5 embedded spaces for output alinement
+11 ;SP10 - 10 embedded spaces for output alinement
+12 ;X - Work variable
+13 NEW SP5,SP10,X
+14 SET SP5=" "
SET SP10=SP5_SP5
SET X=""
+15 IF RV'["$S("
Begin DoDot:1
+16 IF $LENGTH($PIECE(RV,"^"))
IF '$LENGTH($PIECE(RV,"^",2))
IF $PIECE(RV,"^")?.ANP
SET CNT=CNT+1
SET Y(CNT)=SP5_RT_$SELECT($PIECE(RV,"^")?.N:" low : "_$TRANSLATE($PIECE(RV,"^"),""""),1:" : "_$TRANSLATE($PIECE(RV,"^"),""""))
QUIT
+17 IF '$LENGTH($PIECE(RV,"^"))
IF $LENGTH($PIECE(RV,"^",2))
IF $PIECE(RV,"^",2)?.ANP
SET CNT=CNT+1
SET Y(CNT)=SP5_RT_$SELECT($PIECE(RV,"^",2)?.N:" high : "_$TRANSLATE($PIECE(RV,"^",2),""""),1:" : "_$TRANSLATE($PIECE(RV,"^",2),""""))
QUIT
+18 IF $LENGTH($PIECE(RV,"^"))
SET CNT=CNT+1
SET Y(CNT)=SP5_RT_" low : "_$TRANSLATE($PIECE(RV,"^"),"""")
+19 IF $LENGTH($PIECE(RV,"^",2))
SET CNT=CNT+1
SET Y(CNT)=SP5_RT_" high : "_$TRANSLATE($PIECE(RV,"^",2),"""")
+20 ;I $L($P(RV,"^")) S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^")?.AP:" : "_$TR($P(RV,"^"),""""),1:" low : "_$TR($P(RV,"^"),""""))
+21 ;I $L($P(RV,"^",2)) S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^",2)?.AP:" : "_$TR($P(RV,"^",2),""""),1:" high : "_$TR($P(RV,"^",2),""""))
End DoDot:1
QUIT
+22 IF RV["SEX"
Begin DoDot:1
+23 IF RV["AGE"
SET CNT=CNT+1
SET Y(CNT)=SP5_RT_" - Age and sex dependent range values, please contact lab for specifics."
QUIT
+24 SET CNT=CNT+1
SET Y(CNT)=SP5_RT
+25 IF $LENGTH($$GSV($PIECE(RV,"^"),"M"))
SET CNT=CNT+1
SET Y(CNT)=SP10_"Male "_$SELECT($$GSV($PIECE(RV,"^"),"M")?.AP:": "_$TRANSLATE($$GSV($PIECE(RV,"^"),"M"),""""),1:"low : "_$TRANSLATE($$GSV($PIECE(RV,"^"),"M"),""""))
+26 IF $LENGTH($$GSV($PIECE(RV,"^",2),"M"))
SET CNT=CNT+1
SET Y(CNT)=SP10_"Male "_$SELECT($$GSV($PIECE(RV,"^",2),"M")?.AP:$TRANSLATE($$GSV($PIECE(RV,"^",2),"M"),""""),1:"high : "_$TRANSLATE($$GSV($PIECE(RV,"^",2),"M"),""""))
+27 IF $LENGTH($$GSV($PIECE(RV,"^"),"F"))
SET CNT=CNT+1
SET Y(CNT)=SP10_"Female "_$SELECT($$GSV($PIECE(RV,"^"),"F")?.AP:": "_$TRANSLATE($$GSV($PIECE(RV,"^"),"F"),""""),1:"low : "_$TRANSLATE($$GSV($PIECE(RV,"^"),"F"),""""))
+28 IF $LENGTH($$GSV($PIECE(RV,"^",2),"F"))
SET CNT=CNT+1
SET Y(CNT)=SP10_"Female "_$SELECT($$GSV($PIECE(RV,"^",2),"F")?.AP:$TRANSLATE($$GSV($PIECE(RV,"^",2),"F"),""""),1:"high : "_$TRANSLATE($$GSV($PIECE(RV,"^",2),"F"),""""))
End DoDot:1
QUIT
+29 IF RV["AGE"
Begin DoDot:1
+30 SET CNT=CNT+1
SET Y(CNT)=SP5_RT
+31 IF $LENGTH($PIECE(RV,"^"))
DO FAVO($PIECE(RV,"^"),"low")
+32 IF $LENGTH($PIECE(RV,"^",2))
DO FAVO($PIECE(RV,"^",2),"high")
End DoDot:1
QUIT
GSV(X,SEX) ;Get Sex Value
+1 ;Variables passed in:
+2 ;X - Work variable low/high range value
+3 ;SEX - Patient's sex
+4 ;Subroutine variables:
+5 ;X1 - Return value variable with the resolved low/high value
+6 NEW X1
+7 SET @("X1="_$SELECT($LENGTH(X):X,1:""""""))
+8 QUIT X1
FAVO(X,HL) ;Format Age Value Output
+1 ;Variables passed in:
+2 ;X - Work variable with low/high range value
+3 ;HL - This will be for either a low or high reference range
+4 ;Subroutine variables:
+5 ;AT0 - Common text for output
+6 ;AT1 - Embedded M code tested for
+7 ;AT2 - Text description for embedded M code for output
+8 ;IO - Counter to piece the low/high range value
+9 ;I1 - Counter to reformat the embedded M code
+10 ;SP10 - 10 embedded spaces for output alinement
+11 ;X0,X1,X2 - Work variables used in converting the low/high range value
+12 NEW AT0,AT1,AT2,I0,I1,SP10,X0,X1,X2
+13 SET AT0="If Age is "
+14 SET AT1=""
SET AT1(1)="AGE<"
SET AT1(2)="AGE>"
SET AT1(3)="AGE'<"
SET AT1(4)="AGE'>"
SET AT1(5)="AGE="
+15 SET AT2=""
SET AT2(1)="less than "
SET AT2(2)="greater than "
+16 SET AT2(3)="not less than "
SET AT2(4)="not greater than "
SET AT2(5)="equal to "
+17 SET SP10=" "
+18 SET X0=$EXTRACT(X,4,$LENGTH(X)-1)
SET (X1,X2)=""
+19 FOR I0=1:1
SET X1=$PIECE(X0,",",I0)
if X1=""
QUIT
Begin DoDot:1
+20 IF $PIECE(X1,":")=1
SET X2=SP10_"Default "_HL_": "_$PIECE(X1,":",2)
SET CNT=CNT+1
SET Y(CNT)=$TRANSLATE(X2,"""")
+21 IF '$TEST
Begin DoDot:2
+22 FOR I1=1:1:5
IF $PIECE(X1,":")[AT1(I1)
SET X2=SP10_AT0_AT2(I1)_$EXTRACT($PIECE(X1,":"),$LENGTH(AT1(I1))+1,$LENGTH($PIECE(X1,":")))_" the "_HL_" is "_$PIECE(X1,":",2)
SET CNT=CNT+1
SET Y(CNT)=$TRANSLATE(X2,"""")
End DoDot:2
End DoDot:1
+23 QUIT
