RORX018A ;BPOIFO/SJA - BMI BY RANGE REPORT (CONT.) ;07/26/17
;;1.5;CLINICAL CASE REGISTRIES;**31,33**;Feb 17, 2006;Build 81
;
;
;OUTPUT THE REPORT 'RANGE' PARAMETERS
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;*****************************************************************************
PARAMS(PARTAG,RORDATA) ;
N PARAMS,TMP,RC S RC=0
S RORDATA("RANGE")=0 ;initialize to 'no range passed in'
;--- Lab test ranges
I $D(RORTSK("PARAMS","LRGRANGES","C"))>1 D Q:RC<0 RC
. N GRC,ELEMENT,NODE,RTAG,RANGE
. S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
. S RTAG=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARTAG)
. S (GRC,RC)=0
. F S GRC=$O(@NODE@(GRC)) Q:GRC'>0 D Q:RC<0
. . S RANGE=0,TMP=$$RTEXT^RORX018(GRC)
. . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",TMP,RTAG)
. . I ELEMENT<0 S RC=ELEMENT Q
. . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",GRC)
. . ;--- Process the range values
. . S TMP=$G(@NODE@(GRC,"L"))
. . I TMP'="" D S RANGE=1
. . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP)
. . S TMP=$G(@NODE@(GRC,"H"))
. . I TMP'="" D S RANGE=1
. . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP)
. . I RANGE D
. . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
. . . S RORDATA("RANGE")=1 ;range exists
;--- Success
Q RC
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX018A 1367 printed Nov 22, 2024@16:55:02 Page 2
RORX018A ;BPOIFO/SJA - BMI BY RANGE REPORT (CONT.) ;07/26/17
+1 ;;1.5;CLINICAL CASE REGISTRIES;**31,33**;Feb 17, 2006;Build 81
+2 ;
+3 ;
+4 ;OUTPUT THE REPORT 'RANGE' PARAMETERS
+5 ;
+6 ; PARTAG Reference (IEN) to the parent tag
+7 ;
+8 ; Return Values:
+9 ; <0 Error code
+10 ; 0 Ok
+11 ;*****************************************************************************
PARAMS(PARTAG,RORDATA) ;
+1 NEW PARAMS,TMP,RC
SET RC=0
+2 ;initialize to 'no range passed in'
SET RORDATA("RANGE")=0
+3 ;--- Lab test ranges
+4 IF $DATA(RORTSK("PARAMS","LRGRANGES","C"))>1
Begin DoDot:1
+5 NEW GRC,ELEMENT,NODE,RTAG,RANGE
+6 SET NODE=$NAME(RORTSK("PARAMS","LRGRANGES","C"))
+7 SET RTAG=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARTAG)
+8 SET (GRC,RC)=0
+9 FOR
SET GRC=$ORDER(@NODE@(GRC))
if GRC'>0
QUIT
Begin DoDot:2
+10 SET RANGE=0
SET TMP=$$RTEXT^RORX018(GRC)
+11 SET ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",TMP,RTAG)
+12 IF ELEMENT<0
SET RC=ELEMENT
QUIT
+13 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",GRC)
+14 ;--- Process the range values
+15 SET TMP=$GET(@NODE@(GRC,"L"))
+16 IF TMP'=""
Begin DoDot:3
+17 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP)
End DoDot:3
SET RANGE=1
+18 SET TMP=$GET(@NODE@(GRC,"H"))
+19 IF TMP'=""
Begin DoDot:3
+20 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP)
End DoDot:3
SET RANGE=1
+21 IF RANGE
Begin DoDot:3
+22 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
+23 ;range exists
SET RORDATA("RANGE")=1
End DoDot:3
End DoDot:2
if RC<0
QUIT
End DoDot:1
if RC<0
QUIT RC
+24 ;--- Success
+25 QUIT RC
+26 ;
