RORX018 ;BPOIFO/ACS - BMI BY RANGE REPORT ;11/1/09
;;1.5;CLINICAL CASE REGISTRIES;**10,13,19,21,31,33,34,39**;Feb 17, 2006;Build 4
;
;
; This routine uses the following IAs:
;
; #4290 ^PXRMINDX(120.5 (controlled)
; #3647 $$EN^GMVPXRM (controlled)
; #5047 $$GETIEN^GMVGETVT (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*10 MAR 2010 A SAUNDERS Routine created
;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
; clinics, or divisions for the report.
; Modified XML tags for sort.
;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
; requested.
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
; identifiers.
;ROR*1.5*33 JAN 2018 M FERRARESE Adding Future Appointment date/time
;
;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
;******************************************************************************
;******************************************************************************
Q
;*****************************************************************************
;COMPILE THE "BMI BY RANGE" REPORT
;REPORT CODE: 018
;
;Called by entry "BMI by Range" in ROR REPORT PARAMETERS (#799.34)
;
;INPUT
; RORTSK Task number and task parameters
;
; Below is a sample RORTSK input array for utilization in 2003, most recent
; scores, BMI range from 30 to 45:
;
; RORTSK=nnn (task number)
; RORTSK("EP")="$$BMIRANGE^RORX018"
; RORTSK("PARAMS","AGE_RANGE","A","TYPE")=ALL
; RORTSK("PARAMS","AGE_RANGE","A","TYPE")=DOB
; RORTSK("PARAMS","AGE_RANGE","A","END")=3031231
; RORTSK("PARAMS","AGE_RANGE","A","START")=3030101
; RORTSK("PARAMS","AGE_RANGE","A","TYPE")=AGE
; RORTSK("PARAMS","AGE_RANGE","A","END")=3031231
; RORTSK("PARAMS","AGE_RANGE","A","START")=3030101
; RORTSK("PARAMS","DATE_RANGE_3","A","END")=3031231
; RORTSK("PARAMS","DATE_RANGE_3","A","START")=3030101
; RORTSK("PARAMS","ICD9FILT","A","FILTER")="ALL"
; RORTSK("PARAMS","LRGRANGES","C",1)=""
; RORTSK("PARAMS","LRGRANGES","C",1,"H")=45
; RORTSK("PARAMS","LRGRANGES","C",1,"L")=30
; RORTSK("PARAMS","OPTIONS","A","COMPLETE")=1
; RORTSK("PARAMS","OPTIONS","A","FUT_APPT")=365 PATCH 33
; RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
; RORTSK("PARAMS","PATIENTS","A","DE_AFTER")=1
; RORTSK("PARAMS","PATIENTS","A","DE_BEFORE")=1
; RORTSK("PARAMS","PATIENTS","A","DE_DURING")=1
; RORTSK("PARAMS","REGIEN")=1
;
; If the user selected an 'as of' date = 12/31/2005:
; RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
; is replaced with:
; RORTSK("PARAMS","OPTIONS","A","MAX_DATE")=3051231
;
;OUTPUT
; <0 Error code
; 0 Ok
;*****************************************************************************
BMIRANGE(RORTSK) ;
N RORDATA ; array to hold ROR data and summary totals
N RORREG ; Registry IEN
N RORSDT ; report start date
N ROREDT ; report end date
N RORPTIEN ; IEN of patient in the ROR registry
N DFN ; DFN of patient in the PATIENT file (#2)
N RORCDLIST ; Flag to indicate whether a clinic or division list exists
N RORCDSTDT ; Start date for clinic/division utilization search
N RORCDENDT ; End date for clinic/division utilization search
;
N REPORT,PARAMS,SFLAGS,RC,CNT,ECNT,UTSDT,UTEDT,SKIPSDT,SKIPEDT,RORBODY,RORPTN
N RCC,FLAG,TMP,DFN,SKIP
;--- Establish the root XML Node of the report and put into output
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
;--- Get registry IEN
S RORREG=$$PARAM^RORTSK01("REGIEN") ; Registry IEN
;
;--- Set standard report parameters data into output:
;registry, comment, patients (before, during, after), options (summary vs.
;complete), other registries, and other diagnoses
S PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORSDT,.ROREDT,.SFLAGS) Q:PARAMS<0 PARAMS
;
;--- Add range parameters to output
S RC=$$PARAMS^RORX018A(PARAMS,.RORDATA) Q:RC<0 RC
;
;--- Put report header data into output:
;report creation date, task number, last registry update date, and
;last data extraction date
S RC=$$HEADER(REPORT) Q:RC<0 RC
;
;--- Set the number of BMI ranges and initialize their values to 0
S RORDATA("RCNT")=6 D INIT(.RORDATA)
;
;--- Get GMRV VITAL TYPE pointer for HEIGHT and WEIGHT
S RORDATA("HGTP")=$$GETIEN^GMVGETVT("HEIGHT",1)
S RORDATA("WGTP")=$$GETIEN^GMVGETVT("WEIGHT",1)
I '$G(RORDATA("HGTP")) Q -1
I '$G(RORDATA("WGTP")) Q -1
;
;--- 'Most recent' vs. max date requested
S RORDATA("DATE")=0
I $$PARAM^RORTSK01("OPTIONS","MOST_RECENT") S RORDATA("DATE")=DT_.9
I '$G(RORDATA("DATE")) S RORDATA("DATE")=$$PARAM^RORTSK01("OPTIONS","MAX_DATE")_.9
;
;--- Summary vs. complete report requested
S RORDATA("SUMMARY")=0
I $$PARAM^RORTSK01("OPTIONS","SUMMARY") S RORDATA("SUMMARY")=1
;
;--- Future Appointments patch 33
S RORDATA("DAYS")=0
I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") S RORDATA("DAYS")=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
;
;--- Get BMI range requested (there is currently only 1 BMI test)
S I=0 F S I=$O(RORTSK("PARAMS","LRGRANGES","C",I)) Q:I="" D
. S RORDATA("L",I)=$G(RORTSK("PARAMS","LRGRANGES","C",I,"L")) ;low BMI range
. S RORDATA("H",I)=$G(RORTSK("PARAMS","LRGRANGES","C",I,"H")) ;high BMI range
;
;--- Create 'patients' table
S RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
D ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
;
;--- Get utilization date range (always sent in)
S (CNT,ECNT,RC)=0,SKIPEDT=ROREDT,SKIPSDT=RORSDT
S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
; Combined date range
S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,$G(UTSDT))
S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,$G(UTEDT))
;
;--- Number of patients in the registry - used for calculating the
;task progress percentage - shown on the GUI screen
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
;
;--- Get registry records
S (CNT,RORPTIEN,RC)=0
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
F S RORPTIEN=$O(^RORDATA(798,"AC",RORREG,RORPTIEN)) Q:RORPTIEN'>0 D Q:RC<0
. ;--- Calculate 'progress' for the GUI display
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S CNT=CNT+1
. ;--- Get patient DFN
. S DFN=$$PTIEN^RORUTL01(RORPTIEN) Q:DFN'>0
. ;check for patient list and quit if not on list
. I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",DFN)) Q
. ;--- Check if the patient should be skipped
. Q:$$SKIP^RORXU005(RORPTIEN,SFLAGS,SKIPSDT,SKIPEDT)
. ;--- Check if patient has passed the ICD filter
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(DFN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
. ;
. ;--- Check for Clinic or Division list and quit if not in list
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT) Q
. ;
. ;--- Check for any utilization in the corresponding date range
. S SKIP=0 I $G(UTSDT)>0 D
.. N UTIL K TMP S TMP("ALL")=1
.. S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,DFN,.TMP)
.. S:'UTIL SKIP=1
. ;--- Skip the patient if they have no utilization in the range
. Q:$G(SKIP)
. ;
. ;--- For each patient, process the registry record
. I $$PATIENT(DFN,RORBODY,.RORDATA)<0 S ECNT=ECNT+1 ;error count
;
;--- Always create BMI summary report
S RC=$$SUMMARY(RORTSK,REPORT,.RORDATA) Q:RC<0 RC
K ^TMP("RORX018",$J)
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;*****************************************************************************
;ADD THE PATIENT DATA TO THE REPORT
;
;INPUT
; DFN Patient DFN in PATIENT file (#2)
; PTAG Reference IEN to the 'body' parent XML tag
; RORDATA Array with ROR data
;
;OUTPUT
; 1 ok
; <0 error
;*****************************************************************************
PATIENT(DFN,PTAG,RORDATA) ;
I $$CALCBMI(DFN,PTAG,.RORDATA)<0 Q 0 ;calculate the BMI
I '$$INRANGE(.RORDATA) Q 0 ;if range sent, BMI must be in the requested range
D BMICAT(.RORDATA) ;add 1 to appropriate category count
Q:RORDATA("SUMMARY") 1 ;stop if only the 'summary' report was requested
;
;--- Get patient data and put into the report
N VADM,VA,RORDOD,BTAG,HTAG,WTAG,AGE,AGETYPE
D VADEM^RORUTL05(DFN,1) S VA("BID")="0000"
;--- The <PATIENT> tag
S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTAG,,DFN)
I PTAG<0 Q PTAG
;
;
;--- Patient Name
D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
;
;--- Last 4 digits of the SSN
D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
;
;--- Patient age/DOB
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
. D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
;
;--- Date of death
S RORDOD=$$DATE^RORXU002($P(VADM(6),U)\1)
D ADDVAL^RORTSK11(RORTSK,"DOD",$G(RORDOD),PTAG,1)
;--- 'BMIDATA' tag
S BTAG=$$ADDVAL^RORTSK11(RORTSK,"BMIDATA",,PTAG)
Q:BTAG<0 BTAG
;--- Height tag
S HTAG=$$ADDVAL^RORTSK11(RORTSK,"HEIGHT",,BTAG)
Q:HTAG<0 HTAG
;--- Date Height Taken
D ADDVAL^RORTSK11(RORTSK,"DATE",$G(RORDATA("HDATE")),HTAG)
;--- Height value
D ADDVAL^RORTSK11(RORTSK,"RESULT",$G(RORDATA("HGT")),HTAG)
;--- Weight tag
S WTAG=$$ADDVAL^RORTSK11(RORTSK,"WEIGHT",,BTAG)
Q:WTAG<0 WTAG
;--- Date Weight Taken
D ADDVAL^RORTSK11(RORTSK,"DATE",$G(RORDATA("WDATE")),WTAG)
;--- Weight value
D ADDVAL^RORTSK11(RORTSK,"RESULT",$G(RORDATA("WGT")),WTAG)
;--- Calculated BMI value goes on PATIENT tag
D ADDVAL^RORTSK11(RORTSK,"BMI",$G(RORDATA("SCORE",1)),PTAG,3)
; --- ICN if selected must be last column on report
I $$PARAM^RORTSK01("PATIENTS","ICN") D ICNDATA^RORXU006(.RORTSK,DFN,PTAG)
;
; --- PACT if selected may be one of the last columns on report
I $$PARAM^RORTSK01("PATIENTS","PACT") D PACTDATA^RORXU006(.RORTSK,DFN,PTAG)
;
; --- PCP if selected may be one of the last columns on report
I $$PARAM^RORTSK01("PATIENTS","PCP") D PCPDATA^RORXU006(.RORTSK,DFN,PTAG)
;
;--- If only patients with future appointments ; PATCH 33
I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D FUTAPPT^RORXU006(.RORTSK,DFN,RORDATA("DAYS"),PTAG)
Q 1
;
;*****************************************************************************
;CALCULATE THE BMI FOR CURRENT PATIENT
;
;INPUT
; DFN Patient DFN in PATIENT file (#2)
; PTAG Reference IEN to the 'body' parent XML tag
; RORDATA Array with ROR data
;
;OUTPUT
; 1 BMI calculated successfully
; -1 Patient does not have vital measurements or BMI is out of range
; RORDATA Array with ROR data:
; RORDATA("WGT") - weight measurement
; RORDATA("WDATE") - date of weight measurement
; RORDATA("HGT") - height measurement
; RORDATA("HDATE") - date of height measurement
; RORDATA("SCORE",N) - calculated BMI value for test N
;*****************************************************************************
CALCBMI(DFN,PTAG,RORDATA) ;
;-- get vital measurements for BMI calculation
S RORDATA("CALC")=1 ;default - the score for this patient should be calculated
N RORDATE,I,RORVMDT,RORVMIEN,RORARY,TMP1,TMP2,TMP3
K RORDATA("HGT"),RORDATA("WGT"),RORDATA("SCORE",1)
S RORDATE=RORDATA("DATE")
F I="HGTP","WGTP" D ;height and weight pointers
. ;get vital measurement date and IEN
. S RORVMDT=$O(^PXRMINDX(120.5,"PI",DFN,RORDATA(I),RORDATE),-1) ;vm date
. Q:$G(RORVMDT)=""
. S RORVMIEN=$O(^PXRMINDX(120.5,"PI",DFN,RORDATA(I),RORVMDT,0)) ;vm IEN
. Q:$G(RORVMIEN)=""
. ;call API to get patient's vital measurement value
. K RORARY D EN^GMVPXRM(.RORARY,RORVMIEN,"I")
. ; set values into RORDATA("WGT"), ("HGT"), ("WDATE"), & ("HDATE")
. S RORDATA($E(I,1,3))=$G(RORARY(7)),RORDATA($E(I,1)_"DATE")=$P(RORVMDT,".",1)
;quit if height or weight is not > 0
I (($G(RORDATA("HGT"))'>0)!($G(RORDATA("WGT"))'>0)) Q -1
;strip out characters "IN", ",E"
I ((RORDATA("HGT")["IN")!(RORDATA("HGT")[",E")) S RORDATA("HGT")=+RORDATA("HGT")
;mark as 'invalid' if height not between 36 and 96 inches
I ((RORDATA("HGT")<36)!(RORDATA("HGT")>96)) D Q 1
. S RORDATA("CALC")=0 ;no score calculations can be done on 'invalid' data
. S RORDATA("HGT")=RORDATA("HGT")_"*"
;mark as 'invalid' if height contains "CM", or "'" or double quote
I ((RORDATA("HGT")["CM")!(RORDATA("HGT")["'")!(RORDATA("HGT")["""")) D Q 1
. S RORDATA("CALC")=0 ;no score calculations can be done on 'invalid' data
. S RORDATA("HGT")=RORDATA("HGT")_"*"
;
;BMI calculation: (weight * 703) / (height*height)
S TMP1=703*($G(RORDATA("WGT")))
S TMP2=$G(RORDATA("HGT"))*($G(RORDATA("HGT")))
S TMP3=TMP1/TMP2
S RORDATA("SCORE",1)=$J(TMP3,0,1) ;round to 1 decimal point
Q 1
;
;************************************************************************
;DETERMINE IF THE SCORE IS WITHIN THE REQUESTED RANGE
;
;INPUT:
; RORDATA RORDATA("SCORE",I) contains computed test score for test ID 'I'
;
;OUTPUT:
; 1 computed test score in range
; 0 computed test score not in range
;************************************************************************
INRANGE(RORDATA) ;
;if range exists for the test, and any result is considered 'invalid',
;then skip the range check and exclude data from report
I $G(RORDATA("RANGE")),'$G(RORDATA("CALC")) Q 0
;if range does not exist for test, and any result is considered 'invalid',
;then skip the range check and include data in the report
I '$G(RORDATA("RANGE")),'$G(RORDATA("CALC")) Q 1
;
N I,RETURN S RETURN=1 ;default is set to 'within range'
S I=0
F S I=$O(RORDATA("SCORE",I)) Q:I="" D
. I $G(RORDATA("L",I))'="" D
.. I $G(RORDATA("SCORE",I))<RORDATA("L",I) S RETURN=0
. I $G(RORDATA("H",I))'="" D
.. I $G(RORDATA("SCORE",I))>RORDATA("H",I) S RETURN=0
Q RETURN
;
;*****************************************************************************
;ADD 1 TO APPROPRIATE BMI CATEGORY
;
;INPUT
; RORDATA Array with ROR data
; RORDATA("SCORE",N) - calculated BMI value for test N
;OUTPUT
; RORDATA("NP",N) - incremented by 1 if BMI in Nth range
;
;*****************************************************************************
BMICAT(RORDATA) ;
I '$G(RORDATA("SCORE",1)) Q
I $G(RORDATA("SCORE",1))<18.5 S RORDATA("NP",1)=$G(RORDATA("NP",1))+1 Q
I $G(RORDATA("SCORE",1))<25 S RORDATA("NP",2)=$G(RORDATA("NP",2))+1 Q
I $G(RORDATA("SCORE",1))<30 S RORDATA("NP",3)=$G(RORDATA("NP",3))+1 Q
I $G(RORDATA("SCORE",1))<35 S RORDATA("NP",4)=$G(RORDATA("NP",4))+1 Q
I $G(RORDATA("SCORE",1))<40 S RORDATA("NP",5)=$G(RORDATA("NP",5))+1 Q
I $G(RORDATA("SCORE",1))>39 S RORDATA("NP",6)=$G(RORDATA("NP",6))+1 Q
Q
;
;*****************************************************************************
;ADD THE SUMMARY DATA TO THE REPORT
;
;INPUT
; RORTSK Task number and task parameters
; REPORT 'Report' XML tag number
; RORDATA Array with summary data:
; RORDATA("NP",N) - total count of patients in Nth range
;
;OUTPUT
; DATA 'Data' XML tag number or error code
;*****************************************************************************
SUMMARY(RORTSK,REPORT,RORDATA) ; Add the summary values to the report
N SUMMARY,I,STAG,RORCATNUM,RORNAME,RORRANGE
S SUMMARY=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
Q:SUMMARY<0 SUMMARY
;add data for the summary entries
F I=1:1:RORDATA("RCNT") D Q:STAG<0
. S STAG=$$ADDVAL^RORTSK11(RORTSK,"DATA",,SUMMARY)
. Q:STAG<0
. ;get each value
. S RORCATNUM="S"_I S RORNAME=$P($T(@RORCATNUM),";;",2)
. S RORRANGE=$P($T(@RORCATNUM),";;",3)
. D ADDVAL^RORTSK11(RORTSK,"DESC",$G(RORNAME),STAG) ;severity
. D ADDVAL^RORTSK11(RORTSK,"VALUES",$G(RORRANGE),STAG) ;range
. D ADDVAL^RORTSK11(RORTSK,"NP",$G(RORDATA("NP",I)),STAG) ;count
Q STAG
;
;*****************************************************************************
;RETURN RANGE TEXT
;
; GRC Test ID
;
; Return Values:
; Description - <range>
;*****************************************************************************
RTEXT(GRC) ;
N RANGE,TMP
S RANGE=""
;--- Range
I $D(RORTSK("PARAMS","LRGRANGES","C",GRC))>1 D
. ;--- Low
. S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC,"L"))
. S:TMP'="" RANGE=RANGE_" not less than "_TMP
. ;--- High
. S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC,"H"))
. I TMP'="" D:RANGE'="" S RANGE=RANGE_" not greater than "_TMP
. . S RANGE=RANGE_" and"
;--- Description
S TMP=$G(RORTSK("PARAMS","LRGRANGES","C",GRC))
S:TMP="" TMP="Unknown ("_GRC_")"
Q TMP_" - "_$S(RANGE'="":"numeric results"_RANGE,1:"all results")
;
;*****************************************************************************
;ADD THE HEADERS TO THE REPORT
;
;INPUT
; PARTAG Reference IEN to the 'report' parent XML tag
;
;OUTPUT
; <0 error
; >0 'Header' XML tag number or error code
;*****************************************************************************
;;PATIENTS(#,NAME,LAST4,AGE,DOD,VITAL,DATE,RESULT,BMI,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,DOD,VITAL,DATE,RESULT,BMI,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;PATIENTS(#,NAME,LAST4,DOD,VITAL,DATE,RESULT,BMI,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;
N HEADER,RC
;call to $$HEADER^RORXU002 will populate the report created date, task number,
;last registry update, and last data extraction.
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
;automatically build the table defintion(s) listed under the header tag above
S RC=$$TBLDEF^RORXU002("HEADER^RORX018",HEADER)
Q $S(RC<0:RC,1:HEADER)
;
;*****************************************************************************
;INITIALIZE THE NUMBER OF PATIENTS IN EACH CATEGORY TO 0
;
;INPUT
; RORDATA Array with ROR data
; RORDATA("RCNT") Number of categories to initialize
;*****************************************************************************
INIT(RORDATA) ;
I $G(RORDATA("RCNT"))="" Q
F I=1:1:RORDATA("RCNT") D
. S RORDATA("NP",I)=0
Q
;
;*****************************************************************************
;BMI Categories and Values for the summary table.
;NOTE: the number of entries below must match the value of RORDATA("RCNT")
;*****************************************************************************
S1 ;;Underweight;;<18.5
S2 ;;Normal weight;;18.5-24.9
S3 ;;Overweight;;25.0-29.99
S4 ;;Class I Obesity;;30.0-34.9
S5 ;;Class II Obesity;;35-39.9
S6 ;;Class III Obesity;;>=40
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX018 19819 printed Sep 23, 2025@19:20:48 Page 2
RORX018 ;BPOIFO/ACS - BMI BY RANGE REPORT ;11/1/09
+1 ;;1.5;CLINICAL CASE REGISTRIES;**10,13,19,21,31,33,34,39**;Feb 17, 2006;Build 4
+2 ;
+3 ;
+4 ; This routine uses the following IAs:
+5 ;
+6 ; #4290 ^PXRMINDX(120.5 (controlled)
+7 ; #3647 $$EN^GMVPXRM (controlled)
+8 ; #5047 $$GETIEN^GMVGETVT (supported)
+9 ;
+10 ;******************************************************************************
+11 ;******************************************************************************
+12 ; --- ROUTINE MODIFICATION LOG ---
+13 ;
+14 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+15 ;----------- ---------- ----------- ----------------------------------------
+16 ;ROR*1.5*10 MAR 2010 A SAUNDERS Routine created
+17 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+18 ; clinics, or divisions for the report.
+19 ; Modified XML tags for sort.
+20 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+21 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+22 ; requested.
+23 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+24 ; identifiers.
+25 ;ROR*1.5*33 JAN 2018 M FERRARESE Adding Future Appointment date/time
+26 ;
+27 ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
+28 ;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
+29 ;******************************************************************************
+30 ;******************************************************************************
+31 QUIT
+32 ;*****************************************************************************
+33 ;COMPILE THE "BMI BY RANGE" REPORT
+34 ;REPORT CODE: 018
+35 ;
+36 ;Called by entry "BMI by Range" in ROR REPORT PARAMETERS (#799.34)
+37 ;
+38 ;INPUT
+39 ; RORTSK Task number and task parameters
+40 ;
+41 ; Below is a sample RORTSK input array for utilization in 2003, most recent
+42 ; scores, BMI range from 30 to 45:
+43 ;
+44 ; RORTSK=nnn (task number)
+45 ; RORTSK("EP")="$$BMIRANGE^RORX018"
+46 ; RORTSK("PARAMS","AGE_RANGE","A","TYPE")=ALL
+47 ; RORTSK("PARAMS","AGE_RANGE","A","TYPE")=DOB
+48 ; RORTSK("PARAMS","AGE_RANGE","A","END")=3031231
+49 ; RORTSK("PARAMS","AGE_RANGE","A","START")=3030101
+50 ; RORTSK("PARAMS","AGE_RANGE","A","TYPE")=AGE
+51 ; RORTSK("PARAMS","AGE_RANGE","A","END")=3031231
+52 ; RORTSK("PARAMS","AGE_RANGE","A","START")=3030101
+53 ; RORTSK("PARAMS","DATE_RANGE_3","A","END")=3031231
+54 ; RORTSK("PARAMS","DATE_RANGE_3","A","START")=3030101
+55 ; RORTSK("PARAMS","ICD9FILT","A","FILTER")="ALL"
+56 ; RORTSK("PARAMS","LRGRANGES","C",1)=""
+57 ; RORTSK("PARAMS","LRGRANGES","C",1,"H")=45
+58 ; RORTSK("PARAMS","LRGRANGES","C",1,"L")=30
+59 ; RORTSK("PARAMS","OPTIONS","A","COMPLETE")=1
+60 ; RORTSK("PARAMS","OPTIONS","A","FUT_APPT")=365 PATCH 33
+61 ; RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
+62 ; RORTSK("PARAMS","PATIENTS","A","DE_AFTER")=1
+63 ; RORTSK("PARAMS","PATIENTS","A","DE_BEFORE")=1
+64 ; RORTSK("PARAMS","PATIENTS","A","DE_DURING")=1
+65 ; RORTSK("PARAMS","REGIEN")=1
+66 ;
+67 ; If the user selected an 'as of' date = 12/31/2005:
+68 ; RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
+69 ; is replaced with:
+70 ; RORTSK("PARAMS","OPTIONS","A","MAX_DATE")=3051231
+71 ;
+72 ;OUTPUT
+73 ; <0 Error code
+74 ; 0 Ok
+75 ;*****************************************************************************
BMIRANGE(RORTSK) ;
+1 ; array to hold ROR data and summary totals
NEW RORDATA
+2 ; Registry IEN
NEW RORREG
+3 ; report start date
NEW RORSDT
+4 ; report end date
NEW ROREDT
+5 ; IEN of patient in the ROR registry
NEW RORPTIEN
+6 ; DFN of patient in the PATIENT file (#2)
NEW DFN
+7 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+8 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+9 ; End date for clinic/division utilization search
NEW RORCDENDT
+10 ;
+11 NEW REPORT,PARAMS,SFLAGS,RC,CNT,ECNT,UTSDT,UTEDT,SKIPSDT,SKIPEDT,RORBODY,RORPTN
+12 NEW RCC,FLAG,TMP,DFN,SKIP
+13 ;--- Establish the root XML Node of the report and put into output
+14 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+15 if REPORT<0
QUIT REPORT
+16 ;
+17 ;--- Get registry IEN
+18 ; Registry IEN
SET RORREG=$$PARAM^RORTSK01("REGIEN")
+19 ;
+20 ;--- Set standard report parameters data into output:
+21 ;registry, comment, patients (before, during, after), options (summary vs.
+22 ;complete), other registries, and other diagnoses
+23 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORSDT,.ROREDT,.SFLAGS)
if PARAMS<0
QUIT PARAMS
+24 ;
+25 ;--- Add range parameters to output
+26 SET RC=$$PARAMS^RORX018A(PARAMS,.RORDATA)
if RC<0
QUIT RC
+27 ;
+28 ;--- Put report header data into output:
+29 ;report creation date, task number, last registry update date, and
+30 ;last data extraction date
+31 SET RC=$$HEADER(REPORT)
if RC<0
QUIT RC
+32 ;
+33 ;--- Set the number of BMI ranges and initialize their values to 0
+34 SET RORDATA("RCNT")=6
DO INIT(.RORDATA)
+35 ;
+36 ;--- Get GMRV VITAL TYPE pointer for HEIGHT and WEIGHT
+37 SET RORDATA("HGTP")=$$GETIEN^GMVGETVT("HEIGHT",1)
+38 SET RORDATA("WGTP")=$$GETIEN^GMVGETVT("WEIGHT",1)
+39 IF '$GET(RORDATA("HGTP"))
QUIT -1
+40 IF '$GET(RORDATA("WGTP"))
QUIT -1
+41 ;
+42 ;--- 'Most recent' vs. max date requested
+43 SET RORDATA("DATE")=0
+44 IF $$PARAM^RORTSK01("OPTIONS","MOST_RECENT")
SET RORDATA("DATE")=DT_.9
+45 IF '$GET(RORDATA("DATE"))
SET RORDATA("DATE")=$$PARAM^RORTSK01("OPTIONS","MAX_DATE")_.9
+46 ;
+47 ;--- Summary vs. complete report requested
+48 SET RORDATA("SUMMARY")=0
+49 IF $$PARAM^RORTSK01("OPTIONS","SUMMARY")
SET RORDATA("SUMMARY")=1
+50 ;
+51 ;--- Future Appointments patch 33
+52 SET RORDATA("DAYS")=0
+53 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
SET RORDATA("DAYS")=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
+54 ;
+55 ;--- Get BMI range requested (there is currently only 1 BMI test)
+56 SET I=0
FOR
SET I=$ORDER(RORTSK("PARAMS","LRGRANGES","C",I))
if I=""
QUIT
Begin DoDot:1
+57 ;low BMI range
SET RORDATA("L",I)=$GET(RORTSK("PARAMS","LRGRANGES","C",I,"L"))
+58 ;high BMI range
SET RORDATA("H",I)=$GET(RORTSK("PARAMS","LRGRANGES","C",I,"H"))
End DoDot:1
+59 ;
+60 ;--- Create 'patients' table
+61 SET RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+62 DO ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
+63 ;
+64 ;--- Get utilization date range (always sent in)
+65 SET (CNT,ECNT,RC)=0
SET SKIPEDT=ROREDT
SET SKIPSDT=RORSDT
+66 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
+67 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
+68 ; Combined date range
+69 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,$GET(UTSDT))
+70 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,$GET(UTEDT))
+71 ;
+72 ;--- Number of patients in the registry - used for calculating the
+73 ;task progress percentage - shown on the GUI screen
+74 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+75 ;
+76 ;=== Set up Clinic/Division list parameters
+77 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
+78 ;
+79 ;--- Get registry records
+80 SET (CNT,RORPTIEN,RC)=0
+81 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+82 FOR
SET RORPTIEN=$ORDER(^RORDATA(798,"AC",RORREG,RORPTIEN))
if RORPTIEN'>0
QUIT
Begin DoDot:1
+83 ;--- Calculate 'progress' for the GUI display
+84 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+85 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+86 SET CNT=CNT+1
+87 ;--- Get patient DFN
+88 SET DFN=$$PTIEN^RORUTL01(RORPTIEN)
if DFN'>0
QUIT
+89 ;check for patient list and quit if not on list
+90 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",DFN))
QUIT
+91 ;--- Check if the patient should be skipped
+92 if $$SKIP^RORXU005(RORPTIEN,SFLAGS,SKIPSDT,SKIPEDT)
QUIT
+93 ;--- Check if patient has passed the ICD filter
+94 SET RCC=0
+95 IF FLAG'="ALL"
Begin DoDot:2
+96 SET RCC=$$ICD^RORXU010(DFN)
End DoDot:2
+97 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+98 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+99 ;
+100 ;--- Check for Clinic or Division list and quit if not in list
+101 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT)
QUIT
+102 ;
+103 ;--- Check for any utilization in the corresponding date range
+104 SET SKIP=0
IF $GET(UTSDT)>0
Begin DoDot:2
+105 NEW UTIL
KILL TMP
SET TMP("ALL")=1
+106 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,DFN,.TMP)
+107 if 'UTIL
SET SKIP=1
End DoDot:2
+108 ;--- Skip the patient if they have no utilization in the range
+109 if $GET(SKIP)
QUIT
+110 ;
+111 ;--- For each patient, process the registry record
+112 ;error count
IF $$PATIENT(DFN,RORBODY,.RORDATA)<0
SET ECNT=ECNT+1
End DoDot:1
if RC<0
QUIT
+113 ;
+114 ;--- Always create BMI summary report
+115 SET RC=$$SUMMARY(RORTSK,REPORT,.RORDATA)
if RC<0
QUIT RC
+116 KILL ^TMP("RORX018",$JOB)
+117 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+118 ;
+119 ;*****************************************************************************
+120 ;ADD THE PATIENT DATA TO THE REPORT
+121 ;
+122 ;INPUT
+123 ; DFN Patient DFN in PATIENT file (#2)
+124 ; PTAG Reference IEN to the 'body' parent XML tag
+125 ; RORDATA Array with ROR data
+126 ;
+127 ;OUTPUT
+128 ; 1 ok
+129 ; <0 error
+130 ;*****************************************************************************
PATIENT(DFN,PTAG,RORDATA) ;
+1 ;calculate the BMI
IF $$CALCBMI(DFN,PTAG,.RORDATA)<0
QUIT 0
+2 ;if range sent, BMI must be in the requested range
IF '$$INRANGE(.RORDATA)
QUIT 0
+3 ;add 1 to appropriate category count
DO BMICAT(.RORDATA)
+4 ;stop if only the 'summary' report was requested
if RORDATA("SUMMARY")
QUIT 1
+5 ;
+6 ;--- Get patient data and put into the report
+7 NEW VADM,VA,RORDOD,BTAG,HTAG,WTAG,AGE,AGETYPE
+8 DO VADEM^RORUTL05(DFN,1)
SET VA("BID")="0000"
+9 ;--- The <PATIENT> tag
+10 SET PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTAG,,DFN)
+11 IF PTAG<0
QUIT PTAG
+12 ;
+13 ;
+14 ;--- Patient Name
+15 DO ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
+16 ;
+17 ;--- Last 4 digits of the SSN
+18 DO ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
+19 ;
+20 ;--- Patient age/DOB
+21 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:1
+22 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
+23 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
End DoDot:1
+24 ;
+25 ;--- Date of death
+26 SET RORDOD=$$DATE^RORXU002($PIECE(VADM(6),U)\1)
+27 DO ADDVAL^RORTSK11(RORTSK,"DOD",$GET(RORDOD),PTAG,1)
+28 ;--- 'BMIDATA' tag
+29 SET BTAG=$$ADDVAL^RORTSK11(RORTSK,"BMIDATA",,PTAG)
+30 if BTAG<0
QUIT BTAG
+31 ;--- Height tag
+32 SET HTAG=$$ADDVAL^RORTSK11(RORTSK,"HEIGHT",,BTAG)
+33 if HTAG<0
QUIT HTAG
+34 ;--- Date Height Taken
+35 DO ADDVAL^RORTSK11(RORTSK,"DATE",$GET(RORDATA("HDATE")),HTAG)
+36 ;--- Height value
+37 DO ADDVAL^RORTSK11(RORTSK,"RESULT",$GET(RORDATA("HGT")),HTAG)
+38 ;--- Weight tag
+39 SET WTAG=$$ADDVAL^RORTSK11(RORTSK,"WEIGHT",,BTAG)
+40 if WTAG<0
QUIT WTAG
+41 ;--- Date Weight Taken
+42 DO ADDVAL^RORTSK11(RORTSK,"DATE",$GET(RORDATA("WDATE")),WTAG)
+43 ;--- Weight value
+44 DO ADDVAL^RORTSK11(RORTSK,"RESULT",$GET(RORDATA("WGT")),WTAG)
+45 ;--- Calculated BMI value goes on PATIENT tag
+46 DO ADDVAL^RORTSK11(RORTSK,"BMI",$GET(RORDATA("SCORE",1)),PTAG,3)
+47 ; --- ICN if selected must be last column on report
+48 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ICNDATA^RORXU006(.RORTSK,DFN,PTAG)
+49 ;
+50 ; --- PACT if selected may be one of the last columns on report
+51 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO PACTDATA^RORXU006(.RORTSK,DFN,PTAG)
+52 ;
+53 ; --- PCP if selected may be one of the last columns on report
+54 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO PCPDATA^RORXU006(.RORTSK,DFN,PTAG)
+55 ;
+56 ;--- If only patients with future appointments ; PATCH 33
+57 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
DO FUTAPPT^RORXU006(.RORTSK,DFN,RORDATA("DAYS"),PTAG)
+58 QUIT 1
+59 ;
+60 ;*****************************************************************************
+61 ;CALCULATE THE BMI FOR CURRENT PATIENT
+62 ;
+63 ;INPUT
+64 ; DFN Patient DFN in PATIENT file (#2)
+65 ; PTAG Reference IEN to the 'body' parent XML tag
+66 ; RORDATA Array with ROR data
+67 ;
+68 ;OUTPUT
+69 ; 1 BMI calculated successfully
+70 ; -1 Patient does not have vital measurements or BMI is out of range
+71 ; RORDATA Array with ROR data:
+72 ; RORDATA("WGT") - weight measurement
+73 ; RORDATA("WDATE") - date of weight measurement
+74 ; RORDATA("HGT") - height measurement
+75 ; RORDATA("HDATE") - date of height measurement
+76 ; RORDATA("SCORE",N) - calculated BMI value for test N
+77 ;*****************************************************************************
CALCBMI(DFN,PTAG,RORDATA) ;
+1 ;-- get vital measurements for BMI calculation
+2 ;default - the score for this patient should be calculated
SET RORDATA("CALC")=1
+3 NEW RORDATE,I,RORVMDT,RORVMIEN,RORARY,TMP1,TMP2,TMP3
+4 KILL RORDATA("HGT"),RORDATA("WGT"),RORDATA("SCORE",1)
+5 SET RORDATE=RORDATA("DATE")
+6 ;height and weight pointers
FOR I="HGTP","WGTP"
Begin DoDot:1
+7 ;get vital measurement date and IEN
+8 ;vm date
SET RORVMDT=$ORDER(^PXRMINDX(120.5,"PI",DFN,RORDATA(I),RORDATE),-1)
+9 if $GET(RORVMDT)=""
QUIT
+10 ;vm IEN
SET RORVMIEN=$ORDER(^PXRMINDX(120.5,"PI",DFN,RORDATA(I),RORVMDT,0))
+11 if $GET(RORVMIEN)=""
QUIT
+12 ;call API to get patient's vital measurement value
+13 KILL RORARY
DO EN^GMVPXRM(.RORARY,RORVMIEN,"I")
+14 ; set values into RORDATA("WGT"), ("HGT"), ("WDATE"), & ("HDATE")
+15 SET RORDATA($EXTRACT(I,1,3))=$GET(RORARY(7))
SET RORDATA($EXTRACT(I,1)_"DATE")=$PIECE(RORVMDT,".",1)
End DoDot:1
+16 ;quit if height or weight is not > 0
+17 IF (($GET(RORDATA("HGT"))'>0)!($GET(RORDATA("WGT"))'>0))
QUIT -1
+18 ;strip out characters "IN", ",E"
+19 IF ((RORDATA("HGT")["IN")!(RORDATA("HGT")[",E"))
SET RORDATA("HGT")=+RORDATA("HGT")
+20 ;mark as 'invalid' if height not between 36 and 96 inches
+21 IF ((RORDATA("HGT")<36)!(RORDATA("HGT")>96))
Begin DoDot:1
+22 ;no score calculations can be done on 'invalid' data
SET RORDATA("CALC")=0
+23 SET RORDATA("HGT")=RORDATA("HGT")_"*"
End DoDot:1
QUIT 1
+24 ;mark as 'invalid' if height contains "CM", or "'" or double quote
+25 IF ((RORDATA("HGT")["CM")!(RORDATA("HGT")["'")!(RORDATA("HGT")[""""))
Begin DoDot:1
+26 ;no score calculations can be done on 'invalid' data
SET RORDATA("CALC")=0
+27 SET RORDATA("HGT")=RORDATA("HGT")_"*"
End DoDot:1
QUIT 1
+28 ;
+29 ;BMI calculation: (weight * 703) / (height*height)
+30 SET TMP1=703*($GET(RORDATA("WGT")))
+31 SET TMP2=$GET(RORDATA("HGT"))*($GET(RORDATA("HGT")))
+32 SET TMP3=TMP1/TMP2
+33 ;round to 1 decimal point
SET RORDATA("SCORE",1)=$JUSTIFY(TMP3,0,1)
+34 QUIT 1
+35 ;
+36 ;************************************************************************
+37 ;DETERMINE IF THE SCORE IS WITHIN THE REQUESTED RANGE
+38 ;
+39 ;INPUT:
+40 ; RORDATA RORDATA("SCORE",I) contains computed test score for test ID 'I'
+41 ;
+42 ;OUTPUT:
+43 ; 1 computed test score in range
+44 ; 0 computed test score not in range
+45 ;************************************************************************
INRANGE(RORDATA) ;
+1 ;if range exists for the test, and any result is considered 'invalid',
+2 ;then skip the range check and exclude data from report
+3 IF $GET(RORDATA("RANGE"))
IF '$GET(RORDATA("CALC"))
QUIT 0
+4 ;if range does not exist for test, and any result is considered 'invalid',
+5 ;then skip the range check and include data in the report
+6 IF '$GET(RORDATA("RANGE"))
IF '$GET(RORDATA("CALC"))
QUIT 1
+7 ;
+8 ;default is set to 'within range'
NEW I,RETURN
SET RETURN=1
+9 SET I=0
+10 FOR
SET I=$ORDER(RORDATA("SCORE",I))
if I=""
QUIT
Begin DoDot:1
+11 IF $GET(RORDATA("L",I))'=""
Begin DoDot:2
+12 IF $GET(RORDATA("SCORE",I))<RORDATA("L",I)
SET RETURN=0
End DoDot:2
+13 IF $GET(RORDATA("H",I))'=""
Begin DoDot:2
+14 IF $GET(RORDATA("SCORE",I))>RORDATA("H",I)
SET RETURN=0
End DoDot:2
End DoDot:1
+15 QUIT RETURN
+16 ;
+17 ;*****************************************************************************
+18 ;ADD 1 TO APPROPRIATE BMI CATEGORY
+19 ;
+20 ;INPUT
+21 ; RORDATA Array with ROR data
+22 ; RORDATA("SCORE",N) - calculated BMI value for test N
+23 ;OUTPUT
+24 ; RORDATA("NP",N) - incremented by 1 if BMI in Nth range
+25 ;
+26 ;*****************************************************************************
BMICAT(RORDATA) ;
+1 IF '$GET(RORDATA("SCORE",1))
QUIT
+2 IF $GET(RORDATA("SCORE",1))<18.5
SET RORDATA("NP",1)=$GET(RORDATA("NP",1))+1
QUIT
+3 IF $GET(RORDATA("SCORE",1))<25
SET RORDATA("NP",2)=$GET(RORDATA("NP",2))+1
QUIT
+4 IF $GET(RORDATA("SCORE",1))<30
SET RORDATA("NP",3)=$GET(RORDATA("NP",3))+1
QUIT
+5 IF $GET(RORDATA("SCORE",1))<35
SET RORDATA("NP",4)=$GET(RORDATA("NP",4))+1
QUIT
+6 IF $GET(RORDATA("SCORE",1))<40
SET RORDATA("NP",5)=$GET(RORDATA("NP",5))+1
QUIT
+7 IF $GET(RORDATA("SCORE",1))>39
SET RORDATA("NP",6)=$GET(RORDATA("NP",6))+1
QUIT
+8 QUIT
+9 ;
+10 ;*****************************************************************************
+11 ;ADD THE SUMMARY DATA TO THE REPORT
+12 ;
+13 ;INPUT
+14 ; RORTSK Task number and task parameters
+15 ; REPORT 'Report' XML tag number
+16 ; RORDATA Array with summary data:
+17 ; RORDATA("NP",N) - total count of patients in Nth range
+18 ;
+19 ;OUTPUT
+20 ; DATA 'Data' XML tag number or error code
+21 ;*****************************************************************************
SUMMARY(RORTSK,REPORT,RORDATA) ; Add the summary values to the report
+1 NEW SUMMARY,I,STAG,RORCATNUM,RORNAME,RORRANGE
+2 SET SUMMARY=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
+3 if SUMMARY<0
QUIT SUMMARY
+4 ;add data for the summary entries
+5 FOR I=1:1:RORDATA("RCNT")
Begin DoDot:1
+6 SET STAG=$$ADDVAL^RORTSK11(RORTSK,"DATA",,SUMMARY)
+7 if STAG<0
QUIT
+8 ;get each value
+9 SET RORCATNUM="S"_I
SET RORNAME=$PIECE($TEXT(@RORCATNUM),";;",2)
+10 SET RORRANGE=$PIECE($TEXT(@RORCATNUM),";;",3)
+11 ;severity
DO ADDVAL^RORTSK11(RORTSK,"DESC",$GET(RORNAME),STAG)
+12 ;range
DO ADDVAL^RORTSK11(RORTSK,"VALUES",$GET(RORRANGE),STAG)
+13 ;count
DO ADDVAL^RORTSK11(RORTSK,"NP",$GET(RORDATA("NP",I)),STAG)
End DoDot:1
if STAG<0
QUIT
+14 QUIT STAG
+15 ;
+16 ;*****************************************************************************
+17 ;RETURN RANGE TEXT
+18 ;
+19 ; GRC Test ID
+20 ;
+21 ; Return Values:
+22 ; Description - <range>
+23 ;*****************************************************************************
RTEXT(GRC) ;
+1 NEW RANGE,TMP
+2 SET RANGE=""
+3 ;--- Range
+4 IF $DATA(RORTSK("PARAMS","LRGRANGES","C",GRC))>1
Begin DoDot:1
+5 ;--- Low
+6 SET TMP=$GET(RORTSK("PARAMS","LRGRANGES","C",GRC,"L"))
+7 if TMP'=""
SET RANGE=RANGE_" not less than "_TMP
+8 ;--- High
+9 SET TMP=$GET(RORTSK("PARAMS","LRGRANGES","C",GRC,"H"))
+10 IF TMP'=""
if RANGE'=""
Begin DoDot:2
+11 SET RANGE=RANGE_" and"
End DoDot:2
SET RANGE=RANGE_" not greater than "_TMP
End DoDot:1
+12 ;--- Description
+13 SET TMP=$GET(RORTSK("PARAMS","LRGRANGES","C",GRC))
+14 if TMP=""
SET TMP="Unknown ("_GRC_")"
+15 QUIT TMP_" - "_$SELECT(RANGE'="":"numeric results"_RANGE,1:"all results")
+16 ;
+17 ;*****************************************************************************
+18 ;ADD THE HEADERS TO THE REPORT
+19 ;
+20 ;INPUT
+21 ; PARTAG Reference IEN to the 'report' parent XML tag
+22 ;
+23 ;OUTPUT
+24 ; <0 error
+25 ; >0 'Header' XML tag number or error code
+26 ;*****************************************************************************
+1 ;;PATIENTS(#,NAME,LAST4,AGE,DOD,VITAL,DATE,RESULT,BMI,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+2 ;;PATIENTS(#,NAME,LAST4,DOB,DOD,VITAL,DATE,RESULT,BMI,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+3 ;;PATIENTS(#,NAME,LAST4,DOD,VITAL,DATE,RESULT,BMI,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+4 ;
+5 NEW HEADER,RC
+6 ;call to $$HEADER^RORXU002 will populate the report created date, task number,
+7 ;last registry update, and last data extraction.
+8 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+9 if HEADER<0
QUIT HEADER
+10 ;automatically build the table defintion(s) listed under the header tag above
+11 SET RC=$$TBLDEF^RORXU002("HEADER^RORX018",HEADER)
+12 QUIT $SELECT(RC<0:RC,1:HEADER)
+13 ;
+14 ;*****************************************************************************
+15 ;INITIALIZE THE NUMBER OF PATIENTS IN EACH CATEGORY TO 0
+16 ;
+17 ;INPUT
+18 ; RORDATA Array with ROR data
+19 ; RORDATA("RCNT") Number of categories to initialize
+20 ;*****************************************************************************
INIT(RORDATA) ;
+1 IF $GET(RORDATA("RCNT"))=""
QUIT
+2 FOR I=1:1:RORDATA("RCNT")
Begin DoDot:1
+3 SET RORDATA("NP",I)=0
End DoDot:1
+4 QUIT
+5 ;
+6 ;*****************************************************************************
+7 ;BMI Categories and Values for the summary table.
+8 ;NOTE: the number of entries below must match the value of RORDATA("RCNT")
+9 ;*****************************************************************************
S1 ;;Underweight;;<18.5
S2 ;;Normal weight;;18.5-24.9
S3 ;;Overweight;;25.0-29.99
S4 ;;Class I Obesity;;30.0-34.9
S5 ;;Class II Obesity;;35-39.9
S6 ;;Class III Obesity;;>=40
