RORX019 ;BPOIFO/ACS - LIVER SCORE BY RANGE ;5/18/11 12:39pm
;;1.5;CLINICAL CASE REGISTRIES;**10,13,14,15,19,21,26,31,33,34,39**;Feb 17, 2006;Build 4
;
;******************************************************************************
;******************************************************************************
; --- 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 Added APRI and FIB4 scores.
;ROR*1.5*15 MAY 2011 C RAY Modified to exclude null tests
;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
; additional identifier option selected
;ROR*1.5*26 MAY 2015 T KOPP Set up LIVPARAM so it can be called
; from other entry points/reports
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB
;ROR*1.5*33 MAY 2017 F TRAXLER Adding FUT_APPT
;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_CLIN
;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
;******************************************************************************
;******************************************************************************
Q
;
;COMPILE THE "LIVER SCORE BY RANGE" REPORT (EXTRINISIC FUNCTION)
;REPORT CODE: 019
;
;Called by entry "Liver Score 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, MELD range from 10 to 30, MELD Na range from 20 to 50:
;
; RORTSK=nnn (the task number)
; RORTSK("EP")="$$MLDRANGE^RORX019"
; RORTSK("PARAMS","DATE_RANGE_3","A","END")=3031231
; RORTSK("PARAMS","DATE_RANGE_3","A","START")=3030101
; RORTSK("PARAMS","ICDFILT","A","FILTER")="ALL"
; RORTSK("PARAMS","LRGRANGES","C",1)=""
; RORTSK("PARAMS","LRGRANGES","C",1,"H")=30
; RORTSK("PARAMS","LRGRANGES","C",1,"L")=10
; RORTSK("PARAMS","LRGRANGES","C",2)=""
; RORTSK("PARAMS","LRGRANGES","C",2,"H")=50
; RORTSK("PARAMS","LRGRANGES","C",2,"L")=20
; 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
;************************************************************************
MLDRANGE(RORTSK) ;
N RORREG ; Registry IEN
N RORSDT ; report start date
N ROREDT ; report end date
N RORDATA ; array to hold ROR data and summary totals
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,TMP,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^RORX019A(PARAMS,.RORDATA,.RORTSK) Q:RC<0 RC
;
;--- Get ULNAST value for calculations
I $D(RORTSK("PARAMS","ULNAST")) S RORDATA("ULNAST")=$G(RORTSK("PARAMS","ULNAST"))
;
;--- Put report header data into output:
;report creation date, task number, last registry update date, last
;data extraction date, and ULNAST if present, liver score by range
S RC=$$HEADER(REPORT,PARAMS) Q:RC<0 RC
;
D LIVPARAM(.RORDATA,.RORTSK,.RORLC)
;
;--- 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
;
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
;
;--- Get registry records
N RCC,FLAG,TMP,DFN,SKIP
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 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
. 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
;
K ^TMP("RORX019",$J)
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;************************************************************************
;ADD PATIENT DATA TO THE REPORT (EXTRINISIC FUNCTION)
;
;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 the scores requested by the user
I ((RORDATA("IDLST")[1)!(RORDATA("IDLST")[2)) I $$CALCMLD^RORX019A(DFN,PTAG,.RORDATA,RORPTIEN,.RORLC)<0 Q 1
I ((RORDATA("IDLST")[3)!(RORDATA("IDLST")[4)) I $$CALCFIB^RORX019A(DFN,PTAG,.RORDATA,RORPTIEN,.RORLC)<0 Q 1
I '$$INRANGE(.RORDATA) Q 1 ;exclude patient from report if ANY score is out of range
I '$$SKIP(.RORDATA) Q 1 ;exclude patient from report with null scores
;--- Get patient data and put into the report
N VADM,VA,RORDOD,MTAG,TTAG,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)
;--- MELDDATA tag
S MTAG=$$ADDVAL^RORTSK11(RORTSK,"MELDDATA",,PTAG)
I MTAG<0 Q MTAG
;--- Test Result Values
N TNAME
I ((RORDATA("IDLST")[1)!(RORDATA("IDLST")[2)) D
.F TNAME="BILI","CR","INR" D TSTRSLT(TNAME,MTAG)
.I RORDATA("IDLST")[2 D TSTRSLT("NA",MTAG)
I ((RORDATA("IDLST")[3)!(RORDATA("IDLST")[4)) D
.F TNAME="AST","PLAT" D TSTRSLT(TNAME,MTAG)
.I RORDATA("IDLST")[4 D TSTRSLT("ALT",MTAG)
;--- MELD score
I RORDATA("IDLST")[1 D ADDVAL^RORTSK11(RORTSK,"MELD",$G(RORDATA("SCORE",1)),PTAG,3)
;--- MELD-Na Score
I RORDATA("IDLST")[2 D ADDVAL^RORTSK11(RORTSK,"MELDNA",$G(RORDATA("SCORE",2)),PTAG,3)
;--- APRI Score
I RORDATA("IDLST")[3 D ADDVAL^RORTSK11(RORTSK,"APRI",$G(RORDATA("SCORE",3)),PTAG,3)
;--- FIB-4 Score
I RORDATA("IDLST")[4 D ADDVAL^RORTSK11(RORTSK,"FIB4",$G(RORDATA("SCORE",4)),PTAG,3)
I $$PARAM^RORTSK01("PATIENTS","ICN") D
. S TMP=$$ICN^RORUTL02(DFN)
. D ADDVAL^RORTSK11(RORTSK,"ICN",TMP,PTAG,1)
I $$PARAM^RORTSK01("PATIENTS","PACT") D
. S TMP=$$PACT^RORUTL02(DFN)
. D ADDVAL^RORTSK11(RORTSK,"PACT",TMP,PTAG,1)
I $$PARAM^RORTSK01("PATIENTS","PCP") D
. S TMP=$$PCP^RORUTL02(DFN)
. D ADDVAL^RORTSK11(RORTSK,"PCP",TMP,PTAG,1)
I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. S TMP=$$FUTAPPT^RORUTL02(DFN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
. D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",$P(TMP,U,1),PTAG,1)
. D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",$P(TMP,U,2),PTAG,1)
Q ($S($G(TTAG)<0:TTAG,1:1))
;
;*****************************************************
;Procedure to add test name, date and results to report
;INPUT
; TNAME Name of test
; MTAG IEN of parent record
;OUTPUT n/a
;******************************************************
TSTRSLT(TNAME,MTAG) ;
;--- Test Result Values
;--- TEST tag
N TNAMEMIX
S TTAG=$$ADDVAL^RORTSK11(RORTSK,"TEST",,MTAG)
I TTAG<0 Q
;--- Mixed case test name for GUI application
I TNAME="BILI" S TNAMEMIX="Bili"
I TNAME="CR" S TNAMEMIX="Cr"
I TNAME="INR" S TNAMEMIX="INR"
I TNAME="NA" S TNAMEMIX="Na"
I TNAME="AST" S TNAMEMIX="AST"
I TNAME="PLAT" S TNAMEMIX="Platelet"
I TNAME="ALT" S TNAMEMIX="ALT"
;--- Test Name
D ADDVAL^RORTSK11(RORTSK,"TNAME",TNAMEMIX,TTAG)
;--- Test Date
D ADDVAL^RORTSK11(RORTSK,"DATE",$P($G(RORDATA(TNAME)),U,2),TTAG)
;--- Test Result Value
D ADDVAL^RORTSK11(RORTSK,"RESULT",$P($G(RORDATA(TNAME)),U,1),TTAG)
Q
;****************************************************************
;Function
;To be included patient must have a score for at least one of
;the scores requested by the user
;
;INPUT
; RORDATA Array with ROR Data
;OUTPUT
; 1 Include
; 0 Exclude
;***************************************************************
SKIP(RORDATA) ;
;
N RETURN
S RETURN=0
I RORDATA("IDLST")[1,+$G(RORDATA("SCORE",1)) S RETURN=1
I RORDATA("IDLST")[2,+$G(RORDATA("SCORE",2)) S RETURN=1
I RORDATA("IDLST")[3,+$G(RORDATA("SCORE",3)) S RETURN=1
I RORDATA("IDLST")[4,+$G(RORDATA("SCORE",4)) S RETURN=1
Q RETURN
;************************************************************************
;DETERMINE IF THE SCORES ARE WITHIN THE REQUESTED RANGES
;-- If both tests contain ranges: scores for BOTH tests must fall in the
;ranges...treated like an 'AND'
;-- If 1 test contains a range: only patients with scores in the requested range
;will be displayed, and the test without the range will also be displayed
;with the calculated score (if applicable)
;-- If neither test contains a range: all patients and their test results
;and scores (null if they can't be calculated) are returned
;
;INPUT
; RORDATA Array with ROR data
;OUTPUT
; 1 include on report
; 0 exclude from report
;************************************************************************
INRANGE(RORDATA) ;
;include data and quit if no range was sent in
Q:($D(RORDATA("RANGE"))'>1) 1
;check scores to see if they are within the user-selected range(s)
N I,RETURN,SCORE S RETURN=1 ;default is set to 'within range'
S I=0 F S I=$O(RORDATA("RANGE",I)) Q:I="" D
. I $G(RORDATA("L",I))'="" D
.. S SCORE=$G(RORDATA("SCORE",I))
.. I $G(SCORE)="" S RETURN=0 Q
.. I SCORE<RORDATA("L",I) S RETURN=0
. I $G(RORDATA("H",I))'="" D
.. S SCORE=$G(RORDATA("SCORE",I))
.. I $G(SCORE)="" S RETURN=0 Q
.. I SCORE>$G(RORDATA("H",I)) S RETURN=0
;
Q RETURN
;
;************************************************************************
;ADD THE HEADERS TO THE REPORT (EXTRINISIC FUNCTION)
;
;INPUT
; PARTAG Reference IEN to the 'report' parent XML tag
; PARAMS Reference IEN to the 'params' parent XML tag
;
;OUTPUT
; <0 error
; >0 'Header' XML tag number or error code
;************************************************************************
N HEADER,RC,COL,COLUMNS,TMP S RC=0
;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
;manually build the table defintion(s) listed below
;PATIENTS(#,NAME,LAST4,AGE,DOD,TEST,DATE,RESULT,MELD,MELDNA,APRI,FIB4,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)
S COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
D ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
D ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
D ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
;--- Required columns
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
F COL="#","NAME","LAST4",AGETYPE,"DOD","TEST","DATE","RESULT" D
. Q:COL="ALL" ;don't add AGE/DOB to the columns if AGETYPE is set to ALL ages
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME",COL)
;--- Additional columns
I RORDATA("IDLST")[1 D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","MELD")
I RORDATA("IDLST")[2 D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. ;D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","MELDNA")
. ;note: the column name length above was causing problems in the
. ;XSL diaglog file entry 7981019.001, so we shortened it to just "NA".
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","NA")
I RORDATA("IDLST")[3 D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","APRI")
I RORDATA("IDLST")[4 D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","FIB4")
I $$PARAM^RORTSK01("PATIENTS","ICN") D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","ICN")
I $$PARAM^RORTSK01("PATIENTS","PACT") D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","PACT")
I $$PARAM^RORTSK01("PATIENTS","PCP") D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","PCP")
I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","FUT_APPT")
I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. S TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
. D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","FUT_CLIN")
;--- LOINC codes
N LTAG S LTAG=$$ADDVAL^RORTSK11(RORTSK,"LOINC_CODES",,PARTAG)
N CTAG S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","ALT: 1742-6, 16325-3")
N CTAG S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","AST: 1916-6, 1920-8, 127344-1")
N CTAG S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Billirubin: 14631-6, 1975-2")
N CTAG S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Creatinine: 15045-8, 21232-4, 2160-0")
N CTAG S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","INR: 34714-6, 6301-6")
N CTAG S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Platelets: 777-3, 778-1, 26515-7")
N CTAG S CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
D ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Sodium: 2947-0, 2951-2, 32717-1")
;
;Add ULNAST value if passed in
I $G(RORTSK("PARAMS","ULNAST")) D
. N ULNAST S ULNAST=$$ADDVAL^RORTSK11(RORTSK,"ULNAST",,PARAMS)
. D ADDATTR^RORTSK11(RORTSK,ULNAST,"VALUES",$G(RORDATA("ULNAST")))
;
Q $S(RC<0:RC,1:HEADER)
;
; Set up parameter values for liver scores
;
; Input:
; RORDATA Array with ROR data
; RORTSK Task number and task parameters
;
; Output:
; RORDATA
; RORTSK
; RORLC sub-file and LOINC codes to search for
;
LIVPARAM(RORDATA,RORTSK,RORLC) ;
;--- Get test ranges requested
;I=1 ==> report = MELD I=2 ==> report = MELD Na
;I=3 ==> report = APRI I=4 ==> report = FIB-4
N I
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 Max Date for test results OUTPUT: RORDATA("DATE")
;In the GUI, the user selects either 'most recent' or 'as of' date
S RORDATA("DATE")=$$PARAM^RORTSK01("OPTIONS","MAX_DATE")
I $G(RORDATA("DATE"))="" S RORDATA("DATE")=DT
;
;--- LOINC codes
I "1,2"[RORDATA("IDLST") D ;If MELD or MELD-NA scores requested
. ;create list for future comparison
. S RORDATA("CR_LOINC")=";15045-8;21232-4;2160-0;" ;Creatinine
. S RORDATA("BIL_LOINC")=";14631-6;1975-2;" ;Bilirubin
. S RORDATA("SOD_LOINC")=";2947-0;2951-2;32717-1;" ;Sodium
. S RORDATA("INR_LOINC")=";34714-6;6301-6;" ;INR
. ;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
. S RORLC(4)="14631-6^LN" ;Bilirubin LOINC
. S RORLC(5)="1975-2^LN" ;Bilirubin LOINC
. S RORLC(6)="2947-0^LN" ;Sodium LOINC
. S RORLC(7)="2951-2^LN" ;Sodium LOINC
. S RORLC(8)="32717-1^LN" ;Sodium LOINC
. S RORLC(9)="34714-6^LN" ;INR LOINC
. S RORLC(10)="6301-6^LN" ;INR LOINC
;
I "3,4"[RORDATA("IDLST") D ;If APRI or FIB-4 scores requested
. ;create list for future comparison
. S RORDATA("AST_LOINC")=";1916-6;1920-8;127344-1;" ;AST
. S RORDATA("PLAT_LOINC")=";777-3;778-1;26515-7;" ;Platelets
. S RORDATA("ALT_LOINC")=";1742-6;16325-3;" ;ALT
. ;set up array for future call to Lab API
. S RORLC="CH" ;chemistry sub-file to search in #63
. S RORLC(1)="1916-6^LN" ;AST LOINC
. S RORLC(2)="1920-8^LN" ;AST LOINC
. ;S RORLC(3)="127344-1^LN" ;AST LOINC
. S RORLC(4)="777-3^LN" ;Platelets LOINC
. S RORLC(5)="778-1^LN" ;Platelets LOINC
. S RORLC(6)="26515-7^LN" ;Platelets LOINC
. S RORLC(7)="1742-6^LN" ;ALT LOINC
. S RORLC(8)="16325-3^LN" ;ALT LOINC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX019 19953 printed Nov 22, 2024@16:55:03 Page 2
RORX019 ;BPOIFO/ACS - LIVER SCORE BY RANGE ;5/18/11 12:39pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**10,13,14,15,19,21,26,31,33,34,39**;Feb 17, 2006;Build 4
+2 ;
+3 ;******************************************************************************
+4 ;******************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- ---------- ----------- ----------------------------------------
+9 ;ROR*1.5*10 MAR 2010 A SAUNDERS Routine created
+10 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+11 ; clinics, or divisions for the report.
+12 ; Modified XML tags for sort.
+13 ;ROR*1.5*14 APR 2011 A SAUNDERS Added APRI and FIB4 scores.
+14 ;ROR*1.5*15 MAY 2011 C RAY Modified to exclude null tests
+15 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System
+16 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+17 ; additional identifier option selected
+18 ;ROR*1.5*26 MAY 2015 T KOPP Set up LIVPARAM so it can be called
+19 ; from other entry points/reports
+20 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT ,PCP,and AGE/DOB
+21 ;ROR*1.5*33 MAY 2017 F TRAXLER Adding FUT_APPT
+22 ;ROR*1.5*34 SEP 2018 F TRAXLER Adding FUT_CLIN
+23 ;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
+24 ;******************************************************************************
+25 ;******************************************************************************
+26 QUIT
+27 ;
+28 ;COMPILE THE "LIVER SCORE BY RANGE" REPORT (EXTRINISIC FUNCTION)
+29 ;REPORT CODE: 019
+30 ;
+31 ;Called by entry "Liver Score by Range" in ROR REPORT PARAMETERS (#799.34)
+32 ;
+33 ;INPUT
+34 ; RORTSK Task number and task parameters
+35 ;
+36 ;
+37 ; Below is a sample RORTSK input array for utilization in 2003, most recent
+38 ; scores, MELD range from 10 to 30, MELD Na range from 20 to 50:
+39 ;
+40 ; RORTSK=nnn (the task number)
+41 ; RORTSK("EP")="$$MLDRANGE^RORX019"
+42 ; RORTSK("PARAMS","DATE_RANGE_3","A","END")=3031231
+43 ; RORTSK("PARAMS","DATE_RANGE_3","A","START")=3030101
+44 ; RORTSK("PARAMS","ICDFILT","A","FILTER")="ALL"
+45 ; RORTSK("PARAMS","LRGRANGES","C",1)=""
+46 ; RORTSK("PARAMS","LRGRANGES","C",1,"H")=30
+47 ; RORTSK("PARAMS","LRGRANGES","C",1,"L")=10
+48 ; RORTSK("PARAMS","LRGRANGES","C",2)=""
+49 ; RORTSK("PARAMS","LRGRANGES","C",2,"H")=50
+50 ; RORTSK("PARAMS","LRGRANGES","C",2,"L")=20
+51 ; RORTSK("PARAMS","OPTIONS","A","COMPLETE")=1
+52 ; RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
+53 ; RORTSK("PARAMS","PATIENTS","A","DE_AFTER")=1
+54 ; RORTSK("PARAMS","PATIENTS","A","DE_BEFORE")=1
+55 ; RORTSK("PARAMS","PATIENTS","A","DE_DURING")=1
+56 ; RORTSK("PARAMS","REGIEN")=1
+57 ;
+58 ; If the user selected an 'as of' date = 12/31/2005:
+59 ; RORTSK("PARAMS","OPTIONS","A","MOST_RECENT")=1
+60 ; is replaced with:
+61 ; RORTSK("PARAMS","OPTIONS","A","MAX_DATE")=3051231
+62 ;
+63 ;
+64 ;OUTPUT
+65 ; <0 Error code
+66 ; 0 Ok
+67 ;************************************************************************
MLDRANGE(RORTSK) ;
+1 ; Registry IEN
NEW RORREG
+2 ; report start date
NEW RORSDT
+3 ; report end date
NEW ROREDT
+4 ; array to hold ROR data and summary totals
NEW RORDATA
+5 ; IEN of patient in the ROR registry
NEW RORPTIEN
+6 ; DFN of patient in the PATIENT file (#2)
NEW DFN
+7 ; sub-file and array of LOINC codes to search Lab data
NEW RORLC
+8 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+9 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+10 ; End date for clinic/division utilization search
NEW RORCDENDT
+11 ;
+12 NEW REPORT,RC,I,TMP,SFLAGS,PARAMS
+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^RORX019A(PARAMS,.RORDATA,.RORTSK)
if RC<0
QUIT RC
+27 ;
+28 ;--- Get ULNAST value for calculations
+29 IF $DATA(RORTSK("PARAMS","ULNAST"))
SET RORDATA("ULNAST")=$GET(RORTSK("PARAMS","ULNAST"))
+30 ;
+31 ;--- Put report header data into output:
+32 ;report creation date, task number, last registry update date, last
+33 ;data extraction date, and ULNAST if present, liver score by range
+34 SET RC=$$HEADER(REPORT,PARAMS)
if RC<0
QUIT RC
+35 ;
+36 DO LIVPARAM(.RORDATA,.RORTSK,.RORLC)
+37 ;
+38 ;--- Create 'patients' table
+39 NEW RORBODY
SET RORBODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+40 DO ADDATTR^RORTSK11(RORTSK,RORBODY,"TABLE","PATIENTS")
+41 ;
+42 ;--- Check utilization
+43 NEW CNT,ECNT,UTSDT,UTEDT,SKIPSDT,SKIPEDT
+44 SET (CNT,ECNT,RC)=0
SET SKIPEDT=ROREDT
SET SKIPSDT=RORSDT
+45 ; Utilization date range is always sent
+46 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
+47 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
+48 ; Combined date range
+49 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,$GET(UTSDT))
+50 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,$GET(UTEDT))
+51 ;
+52 ;--- Number of patients in the registry - used for calculating the
+53 ;task progress percentage (shown on the GUI screen)
+54 NEW RORPTCNT
SET RORPTCNT=$$REGSIZE^RORUTL02(+RORREG)
if RORPTCNT<0
SET RORPTCNT=0
+55 ;
+56 ;
+57 ;=== Set up Clinic/Division list parameters
+58 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
+59 ;
+60 ;--- Get registry records
+61 NEW RCC,FLAG,TMP,DFN,SKIP
+62 SET (CNT,RORPTIEN,RC)=0
+63 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+64 FOR
SET RORPTIEN=$ORDER(^RORDATA(798,"AC",RORREG,RORPTIEN))
if RORPTIEN'>0
QUIT
Begin DoDot:1
+65 ;--- Calculate 'progress' for the GUI display
+66 SET TMP=$SELECT(RORPTCNT>0:CNT/RORPTCNT,1:"")
+67 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+68 SET CNT=CNT+1
+69 ;--- Get patient DFN
+70 SET DFN=$$PTIEN^RORUTL01(RORPTIEN)
if DFN'>0
QUIT
+71 ;check for patient list and quit if not on list
+72 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",DFN))
QUIT
+73 ;--- Check if the patient should be skipped
+74 if $$SKIP^RORXU005(RORPTIEN,SFLAGS,SKIPSDT,SKIPEDT)
QUIT
+75 ;--- Check if patient has passed the ICD filter
+76 SET RCC=0
+77 IF FLAG'="ALL"
Begin DoDot:2
+78 SET RCC=$$ICD^RORXU010(DFN)
End DoDot:2
+79 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+80 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+81 ;
+82 ;--- Check for Clinic or Division list and quit if not in list
+83 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT)
QUIT
+84 ;
+85 ;--- Check for any utilization in the corresponding date range
+86 SET SKIP=0
IF $GET(UTSDT)>0
Begin DoDot:2
+87 NEW UTIL
KILL TMP
SET TMP("ALL")=1
+88 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,DFN,.TMP)
+89 if 'UTIL
SET SKIP=1
End DoDot:2
+90 ;--- Skip the patient if they have no utilization in the range
+91 IF $GET(SKIP)
QUIT
+92 ;
+93 ;--- For each patient, process the registry record and create report
+94 ;error count
IF $$PATIENT(DFN,RORBODY,.RORDATA,RORPTIEN,.RORLC)<0
SET ECNT=ECNT+1
End DoDot:1
if RC<0
QUIT
+95 ;
+96 KILL ^TMP("RORX019",$JOB)
+97 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+98 ;
+99 ;************************************************************************
+100 ;ADD PATIENT DATA TO THE REPORT (EXTRINISIC FUNCTION)
+101 ;
+102 ;INPUT
+103 ; DFN Patient DFN in PATIENT file (#2)
+104 ; PTAG Reference IEN to the 'body' parent XML tag
+105 ; RORDATA Array with ROR data
+106 ; RORPTIEN Patient IEN in the ROR registry
+107 ; RORLC sub-file and LOINC codes to search for
+108 ;
+109 ;OUTPUT
+110 ; 1 ok
+111 ; <0 error
+112 ;************************************************************************
PATIENT(DFN,PTAG,RORDATA,RORPTIEN,RORLC) ;
+1 ;Calculate the scores requested by the user
+2 IF ((RORDATA("IDLST")[1)!(RORDATA("IDLST")[2))
IF $$CALCMLD^RORX019A(DFN,PTAG,.RORDATA,RORPTIEN,.RORLC)<0
QUIT 1
+3 IF ((RORDATA("IDLST")[3)!(RORDATA("IDLST")[4))
IF $$CALCFIB^RORX019A(DFN,PTAG,.RORDATA,RORPTIEN,.RORLC)<0
QUIT 1
+4 ;exclude patient from report if ANY score is out of range
IF '$$INRANGE(.RORDATA)
QUIT 1
+5 ;exclude patient from report with null scores
IF '$$SKIP(.RORDATA)
QUIT 1
+6 ;--- Get patient data and put into the report
+7 NEW VADM,VA,RORDOD,MTAG,TTAG,AGETYPE,AGE
+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 ;--- Patient Name
+13 DO ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
+14 ;--- Last 4 digits of the SSN
+15 DO ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
+16 ;--- Age/DOB
+17 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:1
+18 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
+19 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
End DoDot:1
+20 ;--- Date of death
+21 SET RORDOD=$$DATE^RORXU002($PIECE(VADM(6),U)\1)
+22 DO ADDVAL^RORTSK11(RORTSK,"DOD",$GET(RORDOD),PTAG,1)
+23 ;--- MELDDATA tag
+24 SET MTAG=$$ADDVAL^RORTSK11(RORTSK,"MELDDATA",,PTAG)
+25 IF MTAG<0
QUIT MTAG
+26 ;--- Test Result Values
+27 NEW TNAME
+28 IF ((RORDATA("IDLST")[1)!(RORDATA("IDLST")[2))
Begin DoDot:1
+29 FOR TNAME="BILI","CR","INR"
DO TSTRSLT(TNAME,MTAG)
+30 IF RORDATA("IDLST")[2
DO TSTRSLT("NA",MTAG)
End DoDot:1
+31 IF ((RORDATA("IDLST")[3)!(RORDATA("IDLST")[4))
Begin DoDot:1
+32 FOR TNAME="AST","PLAT"
DO TSTRSLT(TNAME,MTAG)
+33 IF RORDATA("IDLST")[4
DO TSTRSLT("ALT",MTAG)
End DoDot:1
+34 ;--- MELD score
+35 IF RORDATA("IDLST")[1
DO ADDVAL^RORTSK11(RORTSK,"MELD",$GET(RORDATA("SCORE",1)),PTAG,3)
+36 ;--- MELD-Na Score
+37 IF RORDATA("IDLST")[2
DO ADDVAL^RORTSK11(RORTSK,"MELDNA",$GET(RORDATA("SCORE",2)),PTAG,3)
+38 ;--- APRI Score
+39 IF RORDATA("IDLST")[3
DO ADDVAL^RORTSK11(RORTSK,"APRI",$GET(RORDATA("SCORE",3)),PTAG,3)
+40 ;--- FIB-4 Score
+41 IF RORDATA("IDLST")[4
DO ADDVAL^RORTSK11(RORTSK,"FIB4",$GET(RORDATA("SCORE",4)),PTAG,3)
+42 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:1
+43 SET TMP=$$ICN^RORUTL02(DFN)
+44 DO ADDVAL^RORTSK11(RORTSK,"ICN",TMP,PTAG,1)
End DoDot:1
+45 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:1
+46 SET TMP=$$PACT^RORUTL02(DFN)
+47 DO ADDVAL^RORTSK11(RORTSK,"PACT",TMP,PTAG,1)
End DoDot:1
+48 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:1
+49 SET TMP=$$PCP^RORUTL02(DFN)
+50 DO ADDVAL^RORTSK11(RORTSK,"PCP",TMP,PTAG,1)
End DoDot:1
+51 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:1
+52 SET TMP=$$FUTAPPT^RORUTL02(DFN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
+53 DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",$PIECE(TMP,U,1),PTAG,1)
+54 DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",$PIECE(TMP,U,2),PTAG,1)
End DoDot:1
+55 QUIT ($SELECT($GET(TTAG)<0:TTAG,1:1))
+56 ;
+57 ;*****************************************************
+58 ;Procedure to add test name, date and results to report
+59 ;INPUT
+60 ; TNAME Name of test
+61 ; MTAG IEN of parent record
+62 ;OUTPUT n/a
+63 ;******************************************************
TSTRSLT(TNAME,MTAG) ;
+1 ;--- Test Result Values
+2 ;--- TEST tag
+3 NEW TNAMEMIX
+4 SET TTAG=$$ADDVAL^RORTSK11(RORTSK,"TEST",,MTAG)
+5 IF TTAG<0
QUIT
+6 ;--- Mixed case test name for GUI application
+7 IF TNAME="BILI"
SET TNAMEMIX="Bili"
+8 IF TNAME="CR"
SET TNAMEMIX="Cr"
+9 IF TNAME="INR"
SET TNAMEMIX="INR"
+10 IF TNAME="NA"
SET TNAMEMIX="Na"
+11 IF TNAME="AST"
SET TNAMEMIX="AST"
+12 IF TNAME="PLAT"
SET TNAMEMIX="Platelet"
+13 IF TNAME="ALT"
SET TNAMEMIX="ALT"
+14 ;--- Test Name
+15 DO ADDVAL^RORTSK11(RORTSK,"TNAME",TNAMEMIX,TTAG)
+16 ;--- Test Date
+17 DO ADDVAL^RORTSK11(RORTSK,"DATE",$PIECE($GET(RORDATA(TNAME)),U,2),TTAG)
+18 ;--- Test Result Value
+19 DO ADDVAL^RORTSK11(RORTSK,"RESULT",$PIECE($GET(RORDATA(TNAME)),U,1),TTAG)
+20 QUIT
+21 ;****************************************************************
+22 ;Function
+23 ;To be included patient must have a score for at least one of
+24 ;the scores requested by the user
+25 ;
+26 ;INPUT
+27 ; RORDATA Array with ROR Data
+28 ;OUTPUT
+29 ; 1 Include
+30 ; 0 Exclude
+31 ;***************************************************************
SKIP(RORDATA) ;
+1 ;
+2 NEW RETURN
+3 SET RETURN=0
+4 IF RORDATA("IDLST")[1
IF +$GET(RORDATA("SCORE",1))
SET RETURN=1
+5 IF RORDATA("IDLST")[2
IF +$GET(RORDATA("SCORE",2))
SET RETURN=1
+6 IF RORDATA("IDLST")[3
IF +$GET(RORDATA("SCORE",3))
SET RETURN=1
+7 IF RORDATA("IDLST")[4
IF +$GET(RORDATA("SCORE",4))
SET RETURN=1
+8 QUIT RETURN
+9 ;************************************************************************
+10 ;DETERMINE IF THE SCORES ARE WITHIN THE REQUESTED RANGES
+11 ;-- If both tests contain ranges: scores for BOTH tests must fall in the
+12 ;ranges...treated like an 'AND'
+13 ;-- If 1 test contains a range: only patients with scores in the requested range
+14 ;will be displayed, and the test without the range will also be displayed
+15 ;with the calculated score (if applicable)
+16 ;-- If neither test contains a range: all patients and their test results
+17 ;and scores (null if they can't be calculated) are returned
+18 ;
+19 ;INPUT
+20 ; RORDATA Array with ROR data
+21 ;OUTPUT
+22 ; 1 include on report
+23 ; 0 exclude from report
+24 ;************************************************************************
INRANGE(RORDATA) ;
+1 ;include data and quit if no range was sent in
+2 if ($DATA(RORDATA("RANGE"))'>1)
QUIT 1
+3 ;check scores to see if they are within the user-selected range(s)
+4 ;default is set to 'within range'
NEW I,RETURN,SCORE
SET RETURN=1
+5 SET I=0
FOR
SET I=$ORDER(RORDATA("RANGE",I))
if I=""
QUIT
Begin DoDot:1
+6 IF $GET(RORDATA("L",I))'=""
Begin DoDot:2
+7 SET SCORE=$GET(RORDATA("SCORE",I))
+8 IF $GET(SCORE)=""
SET RETURN=0
QUIT
+9 IF SCORE<RORDATA("L",I)
SET RETURN=0
End DoDot:2
+10 IF $GET(RORDATA("H",I))'=""
Begin DoDot:2
+11 SET SCORE=$GET(RORDATA("SCORE",I))
+12 IF $GET(SCORE)=""
SET RETURN=0
QUIT
+13 IF SCORE>$GET(RORDATA("H",I))
SET RETURN=0
End DoDot:2
End DoDot:1
+14 ;
+15 QUIT RETURN
+16 ;
+17 ;************************************************************************
+18 ;ADD THE HEADERS TO THE REPORT (EXTRINISIC FUNCTION)
+19 ;
+20 ;INPUT
+21 ; PARTAG Reference IEN to the 'report' parent XML tag
+22 ; PARAMS Reference IEN to the 'params' parent XML tag
+23 ;
+24 ;OUTPUT
+25 ; <0 error
+26 ; >0 'Header' XML tag number or error code
+27 ;************************************************************************
+1 NEW HEADER,RC,COL,COLUMNS,TMP
SET RC=0
+2 ;call to $$HEADER^RORXU002 will populate the report created date, task number,
+3 ;last registry update, and last data extraction.
+4 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+5 if HEADER<0
QUIT HEADER
+6 ;manually build the table defintion(s) listed below
+7 ;PATIENTS(#,NAME,LAST4,AGE,DOD,TEST,DATE,RESULT,MELD,MELDNA,APRI,FIB4,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)
+8 SET COLUMNS=$$ADDVAL^RORTSK11(RORTSK,"TBLDEF",,HEADER)
+9 DO ADDATTR^RORTSK11(RORTSK,COLUMNS,"NAME","PATIENTS")
+10 DO ADDATTR^RORTSK11(RORTSK,COLUMNS,"HEADER","1")
+11 DO ADDATTR^RORTSK11(RORTSK,COLUMNS,"FOOTER","1")
+12 ;--- Required columns
+13 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+14 FOR COL="#","NAME","LAST4",AGETYPE,"DOD","TEST","DATE","RESULT"
Begin DoDot:1
+15 ;don't add AGE/DOB to the columns if AGETYPE is set to ALL ages
if COL="ALL"
QUIT
+16 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+17 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME",COL)
End DoDot:1
+18 ;--- Additional columns
+19 IF RORDATA("IDLST")[1
Begin DoDot:1
+20 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+21 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","MELD")
End DoDot:1
+22 IF RORDATA("IDLST")[2
Begin DoDot:1
+23 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+24 ;D ADDATTR^RORTSK11(RORTSK,TMP,"NAME","MELDNA")
+25 ;note: the column name length above was causing problems in the
+26 ;XSL diaglog file entry 7981019.001, so we shortened it to just "NA".
+27 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","NA")
End DoDot:1
+28 IF RORDATA("IDLST")[3
Begin DoDot:1
+29 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+30 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","APRI")
End DoDot:1
+31 IF RORDATA("IDLST")[4
Begin DoDot:1
+32 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+33 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","FIB4")
End DoDot:1
+34 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:1
+35 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+36 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","ICN")
End DoDot:1
+37 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:1
+38 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+39 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","PACT")
End DoDot:1
+40 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:1
+41 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+42 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","PCP")
End DoDot:1
+43 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:1
+44 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+45 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","FUT_APPT")
End DoDot:1
+46 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:1
+47 SET TMP=$$ADDVAL^RORTSK11(RORTSK,"COLUMN",,COLUMNS)
+48 DO ADDATTR^RORTSK11(RORTSK,TMP,"NAME","FUT_CLIN")
End DoDot:1
+49 ;--- LOINC codes
+50 NEW LTAG
SET LTAG=$$ADDVAL^RORTSK11(RORTSK,"LOINC_CODES",,PARTAG)
+51 NEW CTAG
SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+52 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","ALT: 1742-6, 16325-3")
+53 NEW CTAG
SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+54 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","AST: 1916-6, 1920-8, 127344-1")
+55 NEW CTAG
SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+56 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Billirubin: 14631-6, 1975-2")
+57 NEW CTAG
SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+58 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Creatinine: 15045-8, 21232-4, 2160-0")
+59 NEW CTAG
SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+60 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","INR: 34714-6, 6301-6")
+61 NEW CTAG
SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+62 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Platelets: 777-3, 778-1, 26515-7")
+63 NEW CTAG
SET CTAG=$$ADDVAL^RORTSK11(RORTSK,"CODE",,LTAG)
+64 DO ADDATTR^RORTSK11(RORTSK,CTAG,"CODE","Sodium: 2947-0, 2951-2, 32717-1")
+65 ;
+66 ;Add ULNAST value if passed in
+67 IF $GET(RORTSK("PARAMS","ULNAST"))
Begin DoDot:1
+68 NEW ULNAST
SET ULNAST=$$ADDVAL^RORTSK11(RORTSK,"ULNAST",,PARAMS)
+69 DO ADDATTR^RORTSK11(RORTSK,ULNAST,"VALUES",$GET(RORDATA("ULNAST")))
End DoDot:1
+70 ;
+71 QUIT $SELECT(RC<0:RC,1:HEADER)
+72 ;
+73 ; Set up parameter values for liver scores
+74 ;
+75 ; Input:
+76 ; RORDATA Array with ROR data
+77 ; RORTSK Task number and task parameters
+78 ;
+79 ; Output:
+80 ; RORDATA
+81 ; RORTSK
+82 ; RORLC sub-file and LOINC codes to search for
+83 ;
LIVPARAM(RORDATA,RORTSK,RORLC) ;
+1 ;--- Get test ranges requested
+2 ;I=1 ==> report = MELD I=2 ==> report = MELD Na
+3 ;I=3 ==> report = APRI I=4 ==> report = FIB-4
+4 NEW I
+5 SET I=0
FOR
SET I=$ORDER(RORTSK("PARAMS","LRGRANGES","C",I))
if I=""
QUIT
Begin DoDot:1
+6 ;low range
SET RORDATA("L",I)=$GET(RORTSK("PARAMS","LRGRANGES","C",I,"L"))
+7 ;high range
SET RORDATA("H",I)=$GET(RORTSK("PARAMS","LRGRANGES","C",I,"H"))
End DoDot:1
+8 ;
+9 ;--- Get Max Date for test results OUTPUT: RORDATA("DATE")
+10 ;In the GUI, the user selects either 'most recent' or 'as of' date
+11 SET RORDATA("DATE")=$$PARAM^RORTSK01("OPTIONS","MAX_DATE")
+12 IF $GET(RORDATA("DATE"))=""
SET RORDATA("DATE")=DT
+13 ;
+14 ;--- LOINC codes
+15 ;If MELD or MELD-NA scores requested
IF "1,2"[RORDATA("IDLST")
Begin DoDot:1
+16 ;create list for future comparison
+17 ;Creatinine
SET RORDATA("CR_LOINC")=";15045-8;21232-4;2160-0;"
+18 ;Bilirubin
SET RORDATA("BIL_LOINC")=";14631-6;1975-2;"
+19 ;Sodium
SET RORDATA("SOD_LOINC")=";2947-0;2951-2;32717-1;"
+20 ;INR
SET RORDATA("INR_LOINC")=";34714-6;6301-6;"
+21 ;set up array for future call to Lab API
+22 ;chemistry sub-file to search in #63
SET RORLC="CH"
+23 ;Creatinine LOINC
SET RORLC(1)="15045-8^LN"
+24 ;Creatinine LOINC
SET RORLC(2)="21232-4^LN"
+25 ;Creatinine LOINC
SET RORLC(3)="2160-0^LN"
+26 ;Bilirubin LOINC
SET RORLC(4)="14631-6^LN"
+27 ;Bilirubin LOINC
SET RORLC(5)="1975-2^LN"
+28 ;Sodium LOINC
SET RORLC(6)="2947-0^LN"
+29 ;Sodium LOINC
SET RORLC(7)="2951-2^LN"
+30 ;Sodium LOINC
SET RORLC(8)="32717-1^LN"
+31 ;INR LOINC
SET RORLC(9)="34714-6^LN"
+32 ;INR LOINC
SET RORLC(10)="6301-6^LN"
End DoDot:1
+33 ;
+34 ;If APRI or FIB-4 scores requested
IF "3,4"[RORDATA("IDLST")
Begin DoDot:1
+35 ;create list for future comparison
+36 ;AST
SET RORDATA("AST_LOINC")=";1916-6;1920-8;127344-1;"
+37 ;Platelets
SET RORDATA("PLAT_LOINC")=";777-3;778-1;26515-7;"
+38 ;ALT
SET RORDATA("ALT_LOINC")=";1742-6;16325-3;"
+39 ;set up array for future call to Lab API
+40 ;chemistry sub-file to search in #63
SET RORLC="CH"
+41 ;AST LOINC
SET RORLC(1)="1916-6^LN"
+42 ;AST LOINC
SET RORLC(2)="1920-8^LN"
+43 ;S RORLC(3)="127344-1^LN" ;AST LOINC
+44 ;Platelets LOINC
SET RORLC(4)="777-3^LN"
+45 ;Platelets LOINC
SET RORLC(5)="778-1^LN"
+46 ;Platelets LOINC
SET RORLC(6)="26515-7^LN"
+47 ;ALT LOINC
SET RORLC(7)="1742-6^LN"
+48 ;ALT LOINC
SET RORLC(8)="16325-3^LN"
End DoDot:1
+49 QUIT
