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. 
  1. RORX020 ;BPOIFO/ACS - RENAL FUNCTION BY RANGE ;6/2/11 4:19pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**10,13,14,15,19,21,31,33,39**;Feb 17, 2006;Build 4
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #4290         ^PXRMINDX(120.5 (controlled)
  1.  ; #3647         $$EN^GMVPXRM (controlled)
  1.  ; #10061        DEM^VADPT (supported)
  1.  ; #10105        PWR^XLFMTH (supported)
  1.  ; #5047         $$GETIEN^GMVGETVT (supported)
  1.  ; #3556         GCPR^LA7QRY (supported)
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                 --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*10   MAR 2010   A SAUNDERS    Routine created.
  1.  ;ROR*1.5*13   DEC 2010   A SAUNDERS    User can select specific patients,
  1.  ;                                      clinics, or divisions for the report.
  1.  ;                                      Modified XML tags for sort.
  1.  ;ROR*1.5*14   APR 2011   A SAUNDERS    CALCRF: Age calculation now uses 
  1.  ;                                      $$AGE^RORX019A.
  1.  ;ROR*1.5*15   JUN 2011   C RAY         Added calculation for eGRF by CKD-EPI.
  1.  ;ROR*1.5*19   FEB 2012   J SCOTT       Support for ICD-10 Coding System.
  1.  ;ROR*1.5*21   SEP 2013   T KOPP        Add ICN column if Additional Identifier
  1.  ;                                       requested.
  1.  ;ROR*1.5*31   MAY 2017   M FERRARESE   Adding PACT ,PCP,and AGE/DOB as additional
  1.  ;ROR*1.5*33   APR 2018   F TRAXLER     Add FUT_APPT column if requested
  1.  ;ROR*1.5*39   JUN 2021   F TRAXLER     Replace real SSN with zeroes.
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ;
  1.  ;************************************************************************
  1.  ;COMPILE THE "RENAL FUNCTION BY RANGE" REPORT
  1.  ;REPORT CODE: 020
  1.  ;
  1.  ;Called by entry "Renal Function by Range" in ROR REPORT PARAMETERS (#799.34)
  1.  ;
  1.  ;INPUT
  1.  ;  RORTSK     Task number and task parameters
  1.  ;  
  1.  ;  Below is a sample RORTSK input array for utilization in 2003, most recent
  1.  ;  scores, CrCL range from 20 to 50, eGFR range from 30 to 60:
  1.  ;  
  1.  ;  RORTSK=nnn   (the task number)
  1.  ;  RORTSK("EP")="$$RFRANGE^RORX020"
  1.  ;  RORTSK("PARAMS","DATE_RANGE_3","A","END")=3031231
  1.  ;  RORTSK("PARAMS","DATE_RANGE_3","A","START")=3030101
  1.  ;  RORTSK("PARAMS","IC9FILT","A","FILTER")="ALL"
  1.  ;  RORTSK("PARAMS","LRGRANGES","C",1)=""
  1.  ;  RORTSK("PARAMS","LRGRANGES","C",1,"H")=50
  1.  ;  RORTSK("PARAMS","LRGRANGES","C",1,"L")=20
  1.  ;  RORTSK("PARAMS","LRGRANGES","C",2)=""
  1.  ;  RORTSK("PARAMS","LRGRANGES","C",2,"H")=60
  1.  ;  RORTSK("PARAMS","LRGRANGES","C",2,"L")=30
  1.  ;  RORTSK("PARAMS","OPTIONS","A","COMPLETE")=1
  1.  ;  RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
  1.  ;  RORTSK("PARAMS","PATIENTS","A","DE_AFTER")=1
  1.  ;  RORTSK("PARAMS","PATIENTS","A","DE_BEFORE")=1
  1.  ;  RORTSK("PARAMS","PATIENTS","A","DE_DURING")=1
  1.  ;  RORTSK("PARAMS","REGIEN")=1
  1.  ;  
  1.  ;  If the user selected an 'as of' date = 12/31/2005:
  1.  ;     RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
  1.  ;  is replaced with:  
  1.  ;     RORTSK("PARAMS","OPTIONS","A","MAX_DATE")=3051231
  1.  ;
  1.  ;OUTPUT
  1.  ;  <0  Error code
  1.  ;   0  Ok
  1.  ;************************************************************************
  1. RFRANGE(RORTSK) ;
  1.  N RORDATA       ; array to hold ROR data and summary totals
  1.  N RORREG        ; Registry IEN
  1.  N RORSDT        ; report start date
  1.  N ROREDT        ; report end date
  1.  N RORPTIEN      ; IEN of patient in the ROR registry
  1.  N DFN           ; DFN of patient in the PATIENT file (#2)
  1.  N RORLC         ; sub-file and array of LOINC codes to search Lab data
  1.  N RORCDLIST     ; Flag to indicate whether a clinic or division list exists
  1.  N RORCDSTDT     ; Start date for clinic/division utilization search
  1.  N RORCDENDT     ; End date for clinic/division utilization search
  1.  ;
  1.  N REPORT,RC,I,SFLAGS,PARAMS
  1.  ;--- Establish the root XML Node of the report and put into output
  1.  S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
  1.  Q:REPORT<0 REPORT
  1.  ;
  1.  ;--- Get registry IEN
  1.  S RORREG=$$PARAM^RORTSK01("REGIEN")  ; Registry IEN
  1.  ;
  1.  ;--- Set standard report parameters data into output:
  1.  ;registry, comment, patients (before, during, after), options (summary vs.
  1.  ;complete), other registries, and other diagnoses
  1.  S PARAMS=$$PARAMS^RORXU002(.RORTSK,REPORT,.RORSDT,.ROREDT,.SFLAGS) Q:PARAMS<0 PARAMS
  1.  ;
  1.  ;--- Add range parameters to output
  1.  S RC=$$PARAMS^RORX020A(PARAMS,.RORDATA) Q:RC<0 RC
  1.  ;
  1.  ;--- Put report header data into output:
  1.  ;report creation date, task number, last registry update date, and
  1.  ;last data extraction date
  1.  S RC=$$HEADER^RORX020A(REPORT,.RORTSK) Q:RC<0 RC
  1.  ;
  1.  ;--- Get Renal ranges requested
  1.  ;I=1 ==> report = CrCL      I=2 ==> report = eGFR by MDRD
  1.  S I=0 F  S I=$O(RORTSK("PARAMS","LRGRANGES","C",I)) Q:I=""  D
  1.  . S RORDATA("L",I)=$G(RORTSK("PARAMS","LRGRANGES","C",I,"L")) ;low range
  1.  . S RORDATA("H",I)=$G(RORTSK("PARAMS","LRGRANGES","C",I,"H")) ;high range
  1.  ;
  1.  ;--- Get GMRV VITAL TYPE pointer for HEIGHT
  1.  S RORDATA("HGTP")=$$GETIEN^GMVGETVT("HEIGHT",1)
  1.  I '$G(RORDATA("HGTP")) Q -1
  1.  ;
  1.  ;--- Get Max Date  OUTPUT: RORDATA("DATE")  - Max Date for test scores
  1.  S RORDATA("DATE")=$$PARAM^RORTSK01("OPTIONS","MAX_DATE")
  1.  I $G(RORDATA("DATE"))="" S RORDATA("DATE")=DT
  1.  ;
  1.  ;--- Summary vs. complete report requested
  1.  S RORDATA("COMPLETE")=0 ;default to 'summary' only
  1.  I $$PARAM^RORTSK01("OPTIONS","COMPLETE") S RORDATA("COMPLETE")=1
  1.  ;
  1.  ;--- Set the number of Renal ranges and initialize their values to 0
  1.  S RORDATA("RCNT")=5 D INIT^RORX020A(.RORDATA)
  1.  ;
  1.  ;--- Create 'patients' table
  1.  N RORBODY S RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
  1.  D ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
  1.  ;
  1.  ;--- Check utilization
  1.  N CNT,ECNT,UTSDT,UTEDT,SKIPSDT,SKIPEDT
  1.  S (CNT,ECNT,RC)=0,SKIPEDT=ROREDT,SKIPSDT=RORSDT
  1.  ; Utilization date range is always sent
  1.  S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
  1.  S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
  1.  ; Combined date range
  1.  S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,$G(UTSDT))
  1.  S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,$G(UTEDT))
  1.  ;
  1.  ;--- Number of patients in the registry - used for calculating the
  1.  ;task progress percentage (shown on the GUI screen)
  1.  N RORPTCNT S RORPTCNT=$$REGSIZE^RORUTL02(+RORREG) S:RORPTCNT<0 RORPTCNT=0
  1.  ;
  1.  ;--- LOINC codes for Creatinine
  1.  ;create list for future comparison
  1.  S RORDATA("LOINC")=";15045-8;21232-4;2160-0;"
  1.  ;set up array for future call to Lab API
  1.  S RORLC="CH" ;chemistry sub-file to search in #63
  1.  S RORLC(1)="15045-8^LN" ;Creatinine LOINC
  1.  S RORLC(2)="21232-4^LN" ;Creatinine LOINC
  1.  S RORLC(3)="2160-0^LN"  ;Creatinine LOINC
  1.  ;
  1.  ;--- RACE code 2054-5 = 'black or african american' in RACE file (IEN=9)
  1.  S RORDATA("BAM")=";9;"
  1.  ;
  1.  ;=== Set up Clinic/Division list parameters
  1.  S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
  1.  ;
  1.  ;--- Get registry records
  1.  N RCC,FLAG,SKIP,TMP
  1.  S (CNT,RORPTIEN,RC)=0
  1.  S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
  1.  F  S RORPTIEN=$O(^RORDATA(798,"AC",RORREG,RORPTIEN))  Q:RORPTIEN'>0  D  Q:RC<0
  1.  . ;--- Calculate 'progress' for the GUI display
  1.  . S TMP=$S(RORPTCNT>0:CNT/RORPTCNT,1:"")
  1.  . S RC=$$LOOP^RORTSK01(TMP)  Q:RC<0
  1.  . S CNT=CNT+1
  1.  . ;--- Get the patient DFN
  1.  . S DFN=$$PTIEN^RORUTL01(RORPTIEN)  Q:DFN'>0
  1.  . ;--- Check for patient list and quit if not on list
  1.  . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",DFN)) Q
  1.  . ;--- Check if the patient should be skipped
  1.  . Q:$$SKIP^RORXU005(RORPTIEN,SFLAGS,SKIPSDT,SKIPEDT)
  1.  . ;--- Check if patient has passed the ICD filter
  1.  . S RCC=0
  1.  . I FLAG'="ALL" D
  1.  . . S RCC=$$ICD^RORXU010(DFN)
  1.  . I (FLAG="INCLUDE")&(RCC=0) Q
  1.  . I (FLAG="EXCLUDE")&(RCC=1) Q
  1.  . ;
  1.  . ;--- Check for Clinic or Division list and quit if not in list
  1.  . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT) Q
  1.  . ;
  1.  . ;--- Check for utilization in the corresponding 'utilization' date range
  1.  . S SKIP=0 I $G(UTSDT)>0 D
  1.  .. N UTIL K TMP S TMP("ALL")=1
  1.  .. S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,DFN,.TMP)
  1.  .. I 'UTIL S SKIP=1
  1.  . ;--- Skip the patient if they have no utilization in the range
  1.  . I $G(SKIP) Q
  1.  . ;
  1.  . ;--- For each patient, process the registry record and create report
  1.  . I $$PATIENT(DFN,RORBODY,.RORDATA,RORPTIEN,.RORLC)<0 S ECNT=ECNT+1 ;error count
  1.  ;
  1.  ;--- If user selected eGFR by MDRD (ID=2) or eGFR by CKD-EPI (ID=3), create summary report
  1.  I RORDATA("IDLST")[2!(RORDATA("IDLST")[3) S RC=$$SUMMARY^RORX020A(RORTSK,REPORT,.RORDATA)
  1.  Q:RC<0 RC
  1.  K ^TMP("RORX020",$J),^TMP("ROROUT",$J)
  1.  Q $S(RC<0:RC,ECNT>0:-43,1:0)
  1.  ;
  1.  ;************************************************************************
  1.  ;ADD THE PATIENT DATA TO THE REPORT
  1.  ;
  1.  ;INPUT
  1.  ;  DFN      Patient DFN in PATIENT file (#2)
  1.  ;  PTAG     Reference IEN to the 'body' parent XML tag
  1.  ;  RORDATA  Array with ROR data
  1.  ;  RORPTIEN Patient IEN in the ROR registry
  1.  ;  RORLC    sub-file and LOINC codes to search for
  1.  ;
  1.  ;OUTPUT
  1.  ;  1        ok
  1.  ; <0        error
  1.  ;************************************************************************
  1. PATIENT(DFN,PTAG,RORDATA,RORPTIEN,RORLC) ;
  1.  ;calculate Renal Function scores
  1.  I $$CALCRF^RORX020B(DFN,.RORDATA,RORPTIEN,.RORLC)<0 Q 1  ;quit if patient data not available
  1.  I '$$INRANGE^RORX020A(.RORDATA) Q 1  ;quit if score(s) out of requested range
  1.  ;if eGFR by MDRD requested, add 1 to appropriate category count
  1.  I RORDATA("IDLST")[2 D MDRDCAT^RORX020A(.RORDATA)
  1.  ;if eGFR by CKD-EPI requested, add 1 to appropriate category count
  1.  I RORDATA("IDLST")[3 D CKDCAT^RORX020A(.RORDATA)
  1.  Q:'RORDATA("COMPLETE") 1  ;continue only if 'complete' report is requested
  1.  ;--- Get patient data and put into the report
  1.  N VADM,VA,RORDOD,TTAG,RTAG,TMP,AGETYPE,AGE
  1.  D VADEM^RORUTL05(DFN,1) S VA("BID")="0000"
  1.  ;--- The <PATIENT> tag
  1.  S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTAG,,DFN)
  1.  I PTAG<0 Q PTAG
  1.  ;--- Patient Name
  1.  D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
  1.  ;--- Last 4 digits of the SSN
  1.  D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
  1.  ;--- Age/DOB
  1.  S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
  1.  . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
  1.  . D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
  1.  ;--- Date of death
  1.  S RORDOD=$$DATE^RORXU002($P(VADM(6),U)\1)
  1.  D ADDVAL^RORTSK11(RORTSK,"DOD",$G(RORDOD),PTAG,1)
  1.  ;--- RENAL DATA tag
  1.  S RTAG=$$ADDVAL^RORTSK11(RORTSK,"RNLDATA",,PTAG)
  1.  Q:RTAG<0 RTAG
  1.  ;---  CR Test Tag
  1.  S TTAG=$$ADDVAL^RORTSK11(RORTSK,"TEST",,RTAG)
  1.  Q:TTAG<0 TTAG
  1.  ;---  Date Cr Test Taken
  1.  D ADDVAL^RORTSK11(RORTSK,"DATE",$G(RORDATA("CRDATE")),TTAG)
  1.  ;---  Cr Test Value
  1.  D ADDVAL^RORTSK11(RORTSK,"RESULT",$G(RORDATA("CR")),TTAG)
  1.  ;--- Height tag
  1.  S TTAG=$$ADDVAL^RORTSK11(RORTSK,"HEIGHT",,RTAG)
  1.  Q:TTAG<0 TTAG
  1.  ;---  Date Height Taken
  1.  D ADDVAL^RORTSK11(RORTSK,"DATE",$G(RORDATA("HDATE")),TTAG)
  1.  ;---  Height value
  1.  D ADDVAL^RORTSK11(RORTSK,"RESULT",$G(RORDATA("HGT")),TTAG)
  1.  ;---  Calculated CRCL
  1.  I RORDATA("IDLST")[1 D ADDVAL^RORTSK11(RORTSK,"CRCL",$G(RORDATA("SCORE",1)),PTAG,3)
  1.  ;---  Calculated eGFR by MDRD
  1.  I RORDATA("IDLST")[2 D ADDVAL^RORTSK11(RORTSK,"MDRD",$G(RORDATA("SCORE",2)),PTAG,3)
  1.  ;---  Calculated eGFR by CKD-EPI
  1.  I RORDATA("IDLST")[3 D ADDVAL^RORTSK11(RORTSK,"CKD",$G(RORDATA("SCORE",3)),PTAG,3)
  1.  ;--- ICN,PACT,PCP
  1.  I $$PARAM^RORTSK01("PATIENTS","ICN") D ICNDATA^RORXU006(RORTSK,DFN,PTAG)
  1.  I $$PARAM^RORTSK01("PATIENTS","PACT") D PACTDATA^RORXU006(RORTSK,DFN,PTAG)
  1.  I $$PARAM^RORTSK01("PATIENTS","PCP") D PCPDATA^RORXU006(RORTSK,DFN,PTAG)
  1.  ;--- If only patients with future appointments   ; PATCH 33
  1.  I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D FUTAPPT^RORXU006(.RORTSK,DFN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"),PTAG)
  1.  Q ($S(TTAG<0:TTAG,1:1))
  1.  ;