- 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 Feb 18, 2025@23:31:15 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
