- 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 Mar 13, 2025@20:49:29 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 ;
