Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORX020

RORX020.m

Go to the documentation of this file.
RORX020 ;BPOIFO/ACS - RENAL FUNCTION BY RANGE ;6/2/11 4:19pm
 ;;1.5;CLINICAL CASE REGISTRIES;**10,13,14,15,19,21,31,33,39**;Feb 17, 2006;Build 4
 ;
 ; This routine uses the following IAs:
 ;
 ; #4290         ^PXRMINDX(120.5 (controlled)
 ; #3647         $$EN^GMVPXRM (controlled)
 ; #10061        DEM^VADPT (supported)
 ; #10105        PWR^XLFMTH (supported)
 ; #5047         $$GETIEN^GMVGETVT (supported)
 ; #3556         GCPR^LA7QRY (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*14   APR 2011   A SAUNDERS    CALCRF: Age calculation now uses 
 ;                                      $$AGE^RORX019A.
 ;ROR*1.5*15   JUN 2011   C RAY         Added calculation for eGRF by CKD-EPI.
 ;ROR*1.5*19   FEB 2012   J SCOTT       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
 ;ROR*1.5*33   APR 2018   F TRAXLER     Add FUT_APPT column if requested
 ;ROR*1.5*39   JUN 2021   F TRAXLER     Replace real SSN with zeroes.
 ;******************************************************************************
 ;******************************************************************************
 Q
 ;
 ;************************************************************************
 ;COMPILE THE "RENAL FUNCTION BY RANGE" REPORT
 ;REPORT CODE: 020
 ;
 ;Called by entry "Renal Function 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, CrCL range from 20 to 50, eGFR range from 30 to 60:
 ;  
 ;  RORTSK=nnn   (the task number)
 ;  RORTSK("EP")="$$RFRANGE^RORX020"
 ;  RORTSK("PARAMS","DATE_RANGE_3","A","END")=3031231
 ;  RORTSK("PARAMS","DATE_RANGE_3","A","START")=3030101
 ;  RORTSK("PARAMS","IC9FILT","A","FILTER")="ALL"
 ;  RORTSK("PARAMS","LRGRANGES","C",1)=""
 ;  RORTSK("PARAMS","LRGRANGES","C",1,"H")=50
 ;  RORTSK("PARAMS","LRGRANGES","C",1,"L")=20
 ;  RORTSK("PARAMS","LRGRANGES","C",2)=""
 ;  RORTSK("PARAMS","LRGRANGES","C",2,"H")=60
 ;  RORTSK("PARAMS","LRGRANGES","C",2,"L")=30
 ;  RORTSK("PARAMS","OPTIONS","A","COMPLETE")=1
 ;  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
 ;************************************************************************
RFRANGE(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 RORLC         ; sub-file and array of LOINC codes to search Lab data
 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,RC,I,SFLAGS,PARAMS
 ;--- 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^RORX020A(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^RORX020A(REPORT,.RORTSK) Q:RC<0 RC
 ;
 ;--- Get Renal ranges requested
 ;I=1 ==> report = CrCL      I=2 ==> report = eGFR by MDRD
 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 range
 . S RORDATA("H",I)=$G(RORTSK("PARAMS","LRGRANGES","C",I,"H")) ;high range
 ;
 ;--- Get GMRV VITAL TYPE pointer for HEIGHT
 S RORDATA("HGTP")=$$GETIEN^GMVGETVT("HEIGHT",1)
 I '$G(RORDATA("HGTP")) Q -1
 ;
 ;--- Get Max Date  OUTPUT: RORDATA("DATE")  - Max Date for test scores
 S RORDATA("DATE")=$$PARAM^RORTSK01("OPTIONS","MAX_DATE")
 I $G(RORDATA("DATE"))="" S RORDATA("DATE")=DT
 ;
 ;--- Summary vs. complete report requested
 S RORDATA("COMPLETE")=0 ;default to 'summary' only
 I $$PARAM^RORTSK01("OPTIONS","COMPLETE") S RORDATA("COMPLETE")=1
 ;
 ;--- Set the number of Renal ranges and initialize their values to 0
 S RORDATA("RCNT")=5 D INIT^RORX020A(.RORDATA)
 ;
 ;--- Create 'patients' table
 N RORBODY S RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
 D ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
 ;
 ;--- Check utilization
 N CNT,ECNT,UTSDT,UTEDT,SKIPSDT,SKIPEDT
 S (CNT,ECNT,RC)=0,SKIPEDT=ROREDT,SKIPSDT=RORSDT
 ; Utilization date range is always sent
 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)
 N RORPTCNT S RORPTCNT=$$REGSIZE^RORUTL02(+RORREG) S:RORPTCNT<0 RORPTCNT=0
 ;
 ;--- LOINC codes for Creatinine
 ;create list for future comparison
 S RORDATA("LOINC")=";15045-8;21232-4;2160-0;"
 ;set up array for future call to Lab API
 S RORLC="CH" ;chemistry sub-file to search in #63
 S RORLC(1)="15045-8^LN" ;Creatinine LOINC
 S RORLC(2)="21232-4^LN" ;Creatinine LOINC
 S RORLC(3)="2160-0^LN"  ;Creatinine LOINC
 ;
 ;--- RACE code 2054-5 = 'black or african american' in RACE file (IEN=9)
 S RORDATA("BAM")=";9;"
 ;
 ;=== Set up Clinic/Division list parameters
 S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
 ;
 ;--- Get registry records
 N RCC,FLAG,SKIP,TMP
 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(RORPTCNT>0:CNT/RORPTCNT,1:"")
 . S RC=$$LOOP^RORTSK01(TMP)  Q:RC<0
 . S CNT=CNT+1
 . ;--- Get the 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 utilization in the corresponding 'utilization' 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)
 .. I 'UTIL S SKIP=1
 . ;--- Skip the patient if they have no utilization in the range
 . I $G(SKIP) Q
 . ;
 . ;--- For each patient, process the registry record and create report
 . I $$PATIENT(DFN,RORBODY,.RORDATA,RORPTIEN,.RORLC)<0 S ECNT=ECNT+1 ;error count
 ;
 ;--- If user selected eGFR by MDRD (ID=2) or eGFR by CKD-EPI (ID=3), create summary report
 I RORDATA("IDLST")[2!(RORDATA("IDLST")[3) S RC=$$SUMMARY^RORX020A(RORTSK,REPORT,.RORDATA)
 Q:RC<0 RC
 K ^TMP("RORX020",$J),^TMP("ROROUT",$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
 ;  RORPTIEN Patient IEN in the ROR registry
 ;  RORLC    sub-file and LOINC codes to search for
 ;
 ;OUTPUT
 ;  1        ok
 ; <0        error
 ;************************************************************************
PATIENT(DFN,PTAG,RORDATA,RORPTIEN,RORLC) ;
 ;calculate Renal Function scores
 I $$CALCRF^RORX020B(DFN,.RORDATA,RORPTIEN,.RORLC)<0 Q 1  ;quit if patient data not available
 I '$$INRANGE^RORX020A(.RORDATA) Q 1  ;quit if score(s) out of requested range
 ;if eGFR by MDRD requested, add 1 to appropriate category count
 I RORDATA("IDLST")[2 D MDRDCAT^RORX020A(.RORDATA)
 ;if eGFR by CKD-EPI requested, add 1 to appropriate category count
 I RORDATA("IDLST")[3 D CKDCAT^RORX020A(.RORDATA)
 Q:'RORDATA("COMPLETE") 1  ;continue only if 'complete' report is requested
 ;--- Get patient data and put into the report
 N VADM,VA,RORDOD,TTAG,RTAG,TMP,AGETYPE,AGE
 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)
 ;--- 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)
 ;--- RENAL DATA tag
 S RTAG=$$ADDVAL^RORTSK11(RORTSK,"RNLDATA",,PTAG)
 Q:RTAG<0 RTAG
 ;---  CR Test Tag
 S TTAG=$$ADDVAL^RORTSK11(RORTSK,"TEST",,RTAG)
 Q:TTAG<0 TTAG
 ;---  Date Cr Test Taken
 D ADDVAL^RORTSK11(RORTSK,"DATE",$G(RORDATA("CRDATE")),TTAG)
 ;---  Cr Test Value
 D ADDVAL^RORTSK11(RORTSK,"RESULT",$G(RORDATA("CR")),TTAG)
 ;--- Height tag
 S TTAG=$$ADDVAL^RORTSK11(RORTSK,"HEIGHT",,RTAG)
 Q:TTAG<0 TTAG
 ;---  Date Height Taken
 D ADDVAL^RORTSK11(RORTSK,"DATE",$G(RORDATA("HDATE")),TTAG)
 ;---  Height value
 D ADDVAL^RORTSK11(RORTSK,"RESULT",$G(RORDATA("HGT")),TTAG)
 ;---  Calculated CRCL
 I RORDATA("IDLST")[1 D ADDVAL^RORTSK11(RORTSK,"CRCL",$G(RORDATA("SCORE",1)),PTAG,3)
 ;---  Calculated eGFR by MDRD
 I RORDATA("IDLST")[2 D ADDVAL^RORTSK11(RORTSK,"MDRD",$G(RORDATA("SCORE",2)),PTAG,3)
 ;---  Calculated eGFR by CKD-EPI
 I RORDATA("IDLST")[3 D ADDVAL^RORTSK11(RORTSK,"CKD",$G(RORDATA("SCORE",3)),PTAG,3)
 ;--- ICN,PACT,PCP
 I $$PARAM^RORTSK01("PATIENTS","ICN") D ICNDATA^RORXU006(RORTSK,DFN,PTAG)
 I $$PARAM^RORTSK01("PATIENTS","PACT") D PACTDATA^RORXU006(RORTSK,DFN,PTAG)
 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,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"),PTAG)
 Q ($S(TTAG<0:TTAG,1:1))
 ;