RORX010 ;HOIFO/SG,VAC - LAB TESTS BY RANGE REPORT ;4/7/09 2:08pm
;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,33,34,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #2056 GETS^DIQ (supported)
; #10103 FMADD^XLFDT (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
; 'include' or 'exclude'.
;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
; clinics, or divisions for the report.
;ROR*1.5*19 FEB 2012 K GUPTA 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*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional identifiers.
; Fixing the ICN and PCP at the end of the
; Highest Combined OP and IP Utilization Summary panel
;ROR*1.5*33 MAR 2018 M FERRARESE Adding FUTURE APPOINTMENT as additional identifiers.
;
;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;******************************************************************************
Q
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PTLRL(GROUP,DATE,NAME,RESULT))^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;PATIENTS(#,NAME,LAST4,AGE,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PTLRL(GROUP,DATE,NAME,RESULT))^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PTLRL(GROUP,DATE,NAME,RESULT))^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;
N COLUMNS,HEADER,LT,NAME,TMP
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
S RC=$$TBLDEF^RORXU002("HEADER^RORX010",HEADER)
Q $S(RC<0:RC,1:HEADER)
;
;***** COMPILES THE LAB TESTS BY RANGE REPORT
; REPORT CODE: 010
;
; .RORTSK Task number and task parameters
;
; The ^TMP("RORX010",$J) global node is used by this function.
;
; Return Values:
; <0 Error code
; 0 Ok
;
LRGRANGE(RORTSK) ;
N RORDST ; Callback descriptor
N ROREDT ; End date
N ROREDT1 ; End date + 1 day
N RORLTL ; Closed root of the list of lab tests to search for
N RORREG ; Registry IEN
N RORSDT ; Start date
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 BODY,CNT,ECNT,IEN,IENS,LRGLST,RC,REPORT,RORPTN,SFLAGS,TMP
N DFN,RCC,FLAG
;--- Root node of the report
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
;--- Get and prepare the report parameters
S RORREG=+$$PARAM^RORTSK01("REGIEN")
S RC=$$PARAMS(REPORT,.SFLAGS,.LRGLST) Q:RC<0 RC
;
;--- Initialize constants and variables
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1),ECNT=0
K ^TMP("RORX010",$J)
S RORLTL=$$ALLOC^RORTMP()
;
;--- Prepare the search parameters
S RORDST=$NA(^TMP("RORX010",$J))
S RORDST("RORCB")="$$LTCB^RORX010"
S RC=$$LOADTSTS^RORUTL10(RORLTL,+RORREG,LRGLST)
;
;--- Report header and list of patients
S RC=$$HEADER(REPORT) G:RC<0 ERROR
S BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
I BODY<0 S RC=+BODY G ERROR
D ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
;
;--- Browse through the registry records
S (CNT,IEN,RC)=0
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
F S IEN=$O(^RORDATA(798,"AC",RORREG,IEN)) Q:IEN'>0 D Q:RC<0
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S IENS=IEN_",",CNT=CNT+1
. ;--- Get patient DFN
. S DFN=$$PTIEN^RORUTL01(IEN) 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(IEN,SFLAGS,RORSDT,ROREDT)
. ;--- Check pateint against 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
. ;--- End of ICD Check
. ;--- Check for Clinic or Division list and quit if not in list
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT) Q
. ;--- Process the registry record
. I $$PATIENT(IENS,BODY)<0 S ECNT=ECNT+1 Q
;
ERROR ;--- Cleanup
D FREE^RORTMP(RORLTL)
K ^TMP("RORX010",$J)
Q $S(RC<0:RC,ECNT>0:-43,1:0)
;
;***** CALLBACK FUNCTION FOR LAB DATA SEARCH
LTCB(RORDST,INVDT,RESULT) ;
N GRP,NODE,RC,VAL
S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
S GRP=+$P($G(RESULT(2)),U,3)
;--- Check the result range if necessary
I $D(@NODE@(GRP))>1 S RC=1 D Q:RC RC
. S VAL=$$CLRNMVAL^RORUTL18($P($G(RESULT(1)),U,3))
. ;--- Skip a non-numeric result
. Q:'$$NUMERIC^RORUTL05(VAL)
. ;--- Check the range
. I $G(@NODE@(GRP,"L"))'="" Q:VAL<@NODE@(GRP,"L")
. I $G(@NODE@(GRP,"H"))'="" Q:VAL>@NODE@(GRP,"H")
. S RC=0
;--- Store the result
K RORDST("GRP",GRP)
S RORDST("RORPTR")=$G(RORDST("RORPTR"))+1
M @RORDST@(RORDST("RORPTR"))=RESULT
Q 0
;
;***** OUTPUTS THE REPORT PARAMETERS
;
; PARTAG Reference (IEN) to the parent tag
;
; .FLAGS Flags for the $$SKIP^RORXU005 are
; returned via this parameter
;
; .LRGLST List of lab group codes for the $$LOADTSTS^RORUTL10
;
; Return Values:
; <0 Error code
; 0 Ok
;
PARAMS(PARTAG,FLAGS,LRGLST) ;
N PARAMS,TMP
S (FLAGS,LRGLST)=""
S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.RORSDT,.ROREDT,.FLAGS)
Q:PARAMS<0 PARAMS
;--- Lab test ranges
I $D(RORTSK("PARAMS","LRGRANGES","C"))>1 D Q:RC<0 RC
. N GRC,ELEMENT,NODE,LRGELMTS,RANGE
. S NODE=$NA(RORTSK("PARAMS","LRGRANGES","C"))
. S LRGELMTS=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARAMS)
. S (GRC,RC)=0
. F S GRC=$O(@NODE@(GRC)) Q:GRC'>0 D Q:RC<0
. . S RANGE=0,TMP=$$RANGE(GRC)
. . S ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",TMP,LRGELMTS)
. . I ELEMENT<0 S RC=ELEMENT Q
. . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",GRC)
. . S LRGLST=LRGLST_$S(LRGLST'="":","_GRC,1:GRC)
. . ;--- Process the range values
. . S TMP=$G(@NODE@(GRC,"L"))
. . I TMP'="" D S RANGE=1
. . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP)
. . S TMP=$G(@NODE@(GRC,"H"))
. . I TMP'="" D S RANGE=1
. . . D ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP)
. . D:RANGE ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
;--- Success
Q PARAMS
;
;***** ADDS THE PATIENT DATA TO THE REPORT
;
; IENS IENS of the patient's record in the registry
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; 0 Ok
;
PATIENT(IENS,PARTAG) ;
N DFN,I,LABTESTS,LT,NAME,PTAG,RC,RORBUF,RORMSG,TMP,VA,VADM,RORPACT,RORPCP,AGE,AGETYPE,RORDAYS
;--- Get the data from the ROR REGISTRY RECORD file
K RORMSG D GETS^DIQ(798,IENS,".01","I","RORBUF","RORMSG")
;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
S DFN=$G(RORBUF(798,IENS,.01,"I"))
;--- Search for the lab results
K @RORDST,RORDST("RORPTR")
M RORDST("GRP")=RORTSK("PARAMS","LRGRANGES","C")
S RC=$$LTSEARCH^RORUTL10(DFN,RORLTL,.RORDST,,RORSDT,ROREDT1)
Q:RC'>0 RC
;--- Results from all groups should be present
Q:$D(RORDST("GRP"))>1 0
;--- Load the demographic data
D VADEM^RORUTL05(DFN,1)
;--- The <PATIENT> tag
S PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
Q:PTAG<0 PTAG
;--- Patient Name
D ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
;--- Last 4 digits of the SSN
S VA("BID")="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
;--- Age/DOB
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
;--- Date of death
S TMP=$$DATE^RORXU002($P(VADM(6),U)\1)
D ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
I $$PARAM^RORTSK01("PATIENTS","ICN") D
. S TMP=$$ICN^RORUTL02(DFN)
. D ADDVAL^RORTSK11(RORTSK,"ICN",TMP,PTAG,1)
I $$PARAM^RORTSK01("PATIENTS","PACT") S RORPACT="" D
. S RORPACT=$$PACT^RORUTL02(DFN) D ADDVAL^RORTSK11(RORTSK,"PACT",RORPACT,PTAG,1)
;
I $$PARAM^RORTSK01("PATIENTS","PCP") S RORPCP="" D
. S RORPCP=$$PCP^RORUTL02(DFN) D ADDVAL^RORTSK11(RORTSK,"PCP",RORPCP,PTAG,1)
;
;Future Appoinments only patch 33
I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. S RORDAYS=0
. S RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
. I RORDAYS>0 D
. .S TMP=$$FUTAPPT^RORUTL02(DFN,RORDAYS)
. .D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",$P(TMP,U),PTAG,1) ;patch 33&34
. .D ADDATTR^RORTSK11(RORTSK,$P(TMP,U),"NAME","FUT_APPT") ;patch 33&34
. .D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",$P(TMP,U,2),PTAG,1) ;patch 34
. .D ADDATTR^RORTSK11(RORTSK,$P(TMP,U,2),"NAME","FUT_CLIN") ;patch 34
;
;--- Lab results
S LABTESTS=$$ADDVAL^RORTSK11(RORTSK,"PTLRL",,PTAG)
S I=""
F S I=$O(@RORDST@(I)) Q:I="" D
. S LT=$$ADDVAL^RORTSK11(RORTSK,"LT",,LABTESTS)
. D ADDVAL^RORTSK11(RORTSK,"GROUP",$P(@RORDST@(I,2),U,4),LT,1)
. D ADDVAL^RORTSK11(RORTSK,"DATE",$P(@RORDST@(I,1),U,2),LT,1)
. D ADDVAL^RORTSK11(RORTSK,"NAME",$P(@RORDST@(I,2),U,2),LT,1)
. D ADDVAL^RORTSK11(RORTSK,"RESULT",$P(@RORDST@(I,1),U,3),LT,3)
;---
Q $S(RC<0:RC,1:0)
;
;***** PROCESSES THE RESULT RANGE OPTIONS
;
; GRC Code of a Lab Group
;
; Return Values:
; Description of the Lab results to be included in the report.
;
RANGE(GRC) ;
N RANGE,TMP
S RANGE=""
;--- Range
D:$D(RORTSK("PARAMS","LRGRANGES","C",GRC))>1
. ;--- 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")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX010 11228 printed Oct 16, 2024@17:45:25 Page 2
RORX010 ;HOIFO/SG,VAC - LAB TESTS BY RANGE REPORT ;4/7/09 2:08pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,33,34,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #2056 GETS^DIQ (supported)
+6 ; #10103 FMADD^XLFDT (supported)
+7 ;
+8 ;******************************************************************************
+9 ;******************************************************************************
+10 ; --- ROUTINE MODIFICATION LOG ---
+11 ;
+12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+13 ;----------- ---------- ----------- ----------------------------------------
+14 ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
+15 ; 'include' or 'exclude'.
+16 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+17 ; clinics, or divisions for the report.
+18 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+19 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+20 ; additional identifier option selected
+21 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional identifiers.
+22 ; Fixing the ICN and PCP at the end of the
+23 ; Highest Combined OP and IP Utilization Summary panel
+24 ;ROR*1.5*33 MAR 2018 M FERRARESE Adding FUTURE APPOINTMENT as additional identifiers.
+25 ;
+26 ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
+27 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+28 ;******************************************************************************
+29 ;******************************************************************************
+30 QUIT
+31 ;
+32 ;***** OUTPUTS THE REPORT HEADER
+33 ;
+34 ; PARTAG Reference (IEN) to the parent tag
+35 ;
+36 ; Return Values:
+37 ; <0 Error code
+38 ; 0 Ok
+39 ;
+1 ;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PTLRL(GROUP,DATE,NAME,RESULT))^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+2 ;;PATIENTS(#,NAME,LAST4,AGE,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PTLRL(GROUP,DATE,NAME,RESULT))^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+3 ;;PATIENTS(#,NAME,LAST4,DOB,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN,PTLRL(GROUP,DATE,NAME,RESULT))^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+4 ;
+5 NEW COLUMNS,HEADER,LT,NAME,TMP
+6 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+7 if HEADER<0
QUIT HEADER
+8 SET RC=$$TBLDEF^RORXU002("HEADER^RORX010",HEADER)
+9 QUIT $SELECT(RC<0:RC,1:HEADER)
+10 ;
+11 ;***** COMPILES THE LAB TESTS BY RANGE REPORT
+12 ; REPORT CODE: 010
+13 ;
+14 ; .RORTSK Task number and task parameters
+15 ;
+16 ; The ^TMP("RORX010",$J) global node is used by this function.
+17 ;
+18 ; Return Values:
+19 ; <0 Error code
+20 ; 0 Ok
+21 ;
LRGRANGE(RORTSK) ;
+1 ; Callback descriptor
NEW RORDST
+2 ; End date
NEW ROREDT
+3 ; End date + 1 day
NEW ROREDT1
+4 ; Closed root of the list of lab tests to search for
NEW RORLTL
+5 ; Registry IEN
NEW RORREG
+6 ; Start date
NEW RORSDT
+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 BODY,CNT,ECNT,IEN,IENS,LRGLST,RC,REPORT,RORPTN,SFLAGS,TMP
+12 NEW DFN,RCC,FLAG
+13 ;--- Root node of the report
+14 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+15 if REPORT<0
QUIT REPORT
+16 ;
+17 ;--- Get and prepare the report parameters
+18 SET RORREG=+$$PARAM^RORTSK01("REGIEN")
+19 SET RC=$$PARAMS(REPORT,.SFLAGS,.LRGLST)
if RC<0
QUIT RC
+20 ;
+21 ;--- Initialize constants and variables
+22 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+23 SET ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
SET ECNT=0
+24 KILL ^TMP("RORX010",$JOB)
+25 SET RORLTL=$$ALLOC^RORTMP()
+26 ;
+27 ;--- Prepare the search parameters
+28 SET RORDST=$NAME(^TMP("RORX010",$JOB))
+29 SET RORDST("RORCB")="$$LTCB^RORX010"
+30 SET RC=$$LOADTSTS^RORUTL10(RORLTL,+RORREG,LRGLST)
+31 ;
+32 ;--- Report header and list of patients
+33 SET RC=$$HEADER(REPORT)
if RC<0
GOTO ERROR
+34 SET BODY=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+35 IF BODY<0
SET RC=+BODY
GOTO ERROR
+36 DO ADDATTR^RORTSK11(RORTSK,BODY,"TABLE","PATIENTS")
+37 ;
+38 ;=== Set up Clinic/Division list parameters
+39 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
+40 ;
+41 ;--- Browse through the registry records
+42 SET (CNT,IEN,RC)=0
+43 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+44 FOR
SET IEN=$ORDER(^RORDATA(798,"AC",RORREG,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+45 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+46 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+47 SET IENS=IEN_","
SET CNT=CNT+1
+48 ;--- Get patient DFN
+49 SET DFN=$$PTIEN^RORUTL01(IEN)
if DFN'>0
QUIT
+50 ;--- Check for patient list and quit if not on list
+51 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",DFN))
QUIT
+52 ;--- Check if the patient should be skipped
+53 if $$SKIP^RORXU005(IEN,SFLAGS,RORSDT,ROREDT)
QUIT
+54 ;--- Check pateint against ICD Filter
+55 SET RCC=0
+56 IF FLAG'="ALL"
Begin DoDot:2
+57 SET RCC=$$ICD^RORXU010(DFN)
End DoDot:2
+58 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+59 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+60 ;--- End of ICD Check
+61 ;--- Check for Clinic or Division list and quit if not in list
+62 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,DFN,RORCDSTDT,RORCDENDT)
QUIT
+63 ;--- Process the registry record
+64 IF $$PATIENT(IENS,BODY)<0
SET ECNT=ECNT+1
QUIT
End DoDot:1
if RC<0
QUIT
+65 ;
ERROR ;--- Cleanup
+1 DO FREE^RORTMP(RORLTL)
+2 KILL ^TMP("RORX010",$JOB)
+3 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
+4 ;
+5 ;***** CALLBACK FUNCTION FOR LAB DATA SEARCH
LTCB(RORDST,INVDT,RESULT) ;
+1 NEW GRP,NODE,RC,VAL
+2 SET NODE=$NAME(RORTSK("PARAMS","LRGRANGES","C"))
+3 SET GRP=+$PIECE($GET(RESULT(2)),U,3)
+4 ;--- Check the result range if necessary
+5 IF $DATA(@NODE@(GRP))>1
SET RC=1
Begin DoDot:1
+6 SET VAL=$$CLRNMVAL^RORUTL18($PIECE($GET(RESULT(1)),U,3))
+7 ;--- Skip a non-numeric result
+8 if '$$NUMERIC^RORUTL05(VAL)
QUIT
+9 ;--- Check the range
+10 IF $GET(@NODE@(GRP,"L"))'=""
if VAL<@NODE@(GRP,"L")
QUIT
+11 IF $GET(@NODE@(GRP,"H"))'=""
if VAL>@NODE@(GRP,"H")
QUIT
+12 SET RC=0
End DoDot:1
if RC
QUIT RC
+13 ;--- Store the result
+14 KILL RORDST("GRP",GRP)
+15 SET RORDST("RORPTR")=$GET(RORDST("RORPTR"))+1
+16 MERGE @RORDST@(RORDST("RORPTR"))=RESULT
+17 QUIT 0
+18 ;
+19 ;***** OUTPUTS THE REPORT PARAMETERS
+20 ;
+21 ; PARTAG Reference (IEN) to the parent tag
+22 ;
+23 ; .FLAGS Flags for the $$SKIP^RORXU005 are
+24 ; returned via this parameter
+25 ;
+26 ; .LRGLST List of lab group codes for the $$LOADTSTS^RORUTL10
+27 ;
+28 ; Return Values:
+29 ; <0 Error code
+30 ; 0 Ok
+31 ;
PARAMS(PARTAG,FLAGS,LRGLST) ;
+1 NEW PARAMS,TMP
+2 SET (FLAGS,LRGLST)=""
+3 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.RORSDT,.ROREDT,.FLAGS)
+4 if PARAMS<0
QUIT PARAMS
+5 ;--- Lab test ranges
+6 IF $DATA(RORTSK("PARAMS","LRGRANGES","C"))>1
Begin DoDot:1
+7 NEW GRC,ELEMENT,NODE,LRGELMTS,RANGE
+8 SET NODE=$NAME(RORTSK("PARAMS","LRGRANGES","C"))
+9 SET LRGELMTS=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGES",,PARAMS)
+10 SET (GRC,RC)=0
+11 FOR
SET GRC=$ORDER(@NODE@(GRC))
if GRC'>0
QUIT
Begin DoDot:2
+12 SET RANGE=0
SET TMP=$$RANGE(GRC)
+13 SET ELEMENT=$$ADDVAL^RORTSK11(RORTSK,"LRGRANGE",TMP,LRGELMTS)
+14 IF ELEMENT<0
SET RC=ELEMENT
QUIT
+15 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"ID",GRC)
+16 SET LRGLST=LRGLST_$SELECT(LRGLST'="":","_GRC,1:GRC)
+17 ;--- Process the range values
+18 SET TMP=$GET(@NODE@(GRC,"L"))
+19 IF TMP'=""
Begin DoDot:3
+20 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"LOW",TMP)
End DoDot:3
SET RANGE=1
+21 SET TMP=$GET(@NODE@(GRC,"H"))
+22 IF TMP'=""
Begin DoDot:3
+23 DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"HIGH",TMP)
End DoDot:3
SET RANGE=1
+24 if RANGE
DO ADDATTR^RORTSK11(RORTSK,ELEMENT,"RANGE",1)
End DoDot:2
if RC<0
QUIT
End DoDot:1
if RC<0
QUIT RC
+25 ;--- Success
+26 QUIT PARAMS
+27 ;
+28 ;***** ADDS THE PATIENT DATA TO THE REPORT
+29 ;
+30 ; IENS IENS of the patient's record in the registry
+31 ; PARTAG Reference (IEN) to the parent tag
+32 ;
+33 ; Return Values:
+34 ; <0 Error code
+35 ; 0 Ok
+36 ;
PATIENT(IENS,PARTAG) ;
+1 NEW DFN,I,LABTESTS,LT,NAME,PTAG,RC,RORBUF,RORMSG,TMP,VA,VADM,RORPACT,RORPCP,AGE,AGETYPE,RORDAYS
+2 ;--- Get the data from the ROR REGISTRY RECORD file
+3 KILL RORMSG
DO GETS^DIQ(798,IENS,".01","I","RORBUF","RORMSG")
+4 ;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
+5 if $GET(RORMSG("DIERR"))
QUIT $$DBS^RORERR("RORMSG",-9,,,798,IENS)
+6 SET DFN=$GET(RORBUF(798,IENS,.01,"I"))
+7 ;--- Search for the lab results
+8 KILL @RORDST,RORDST("RORPTR")
+9 MERGE RORDST("GRP")=RORTSK("PARAMS","LRGRANGES","C")
+10 SET RC=$$LTSEARCH^RORUTL10(DFN,RORLTL,.RORDST,,RORSDT,ROREDT1)
+11 if RC'>0
QUIT RC
+12 ;--- Results from all groups should be present
+13 if $DATA(RORDST("GRP"))>1
QUIT 0
+14 ;--- Load the demographic data
+15 DO VADEM^RORUTL05(DFN,1)
+16 ;--- The <PATIENT> tag
+17 SET PTAG=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PARTAG,,DFN)
+18 if PTAG<0
QUIT PTAG
+19 ;--- Patient Name
+20 DO ADDVAL^RORTSK11(RORTSK,"NAME",VADM(1),PTAG,1)
+21 ;--- Last 4 digits of the SSN
+22 SET VA("BID")="0000"
DO ADDVAL^RORTSK11(RORTSK,"LAST4",VA("BID"),PTAG,2)
+23 ;--- Age/DOB
+24 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+25 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
+26 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,PTAG,1)
+27 ;--- Date of death
+28 SET TMP=$$DATE^RORXU002($PIECE(VADM(6),U)\1)
+29 DO ADDVAL^RORTSK11(RORTSK,"DOD",TMP,PTAG,1)
+30 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:1
+31 SET TMP=$$ICN^RORUTL02(DFN)
+32 DO ADDVAL^RORTSK11(RORTSK,"ICN",TMP,PTAG,1)
End DoDot:1
+33 IF $$PARAM^RORTSK01("PATIENTS","PACT")
SET RORPACT=""
Begin DoDot:1
+34 SET RORPACT=$$PACT^RORUTL02(DFN)
DO ADDVAL^RORTSK11(RORTSK,"PACT",RORPACT,PTAG,1)
End DoDot:1
+35 ;
+36 IF $$PARAM^RORTSK01("PATIENTS","PCP")
SET RORPCP=""
Begin DoDot:1
+37 SET RORPCP=$$PCP^RORUTL02(DFN)
DO ADDVAL^RORTSK11(RORTSK,"PCP",RORPCP,PTAG,1)
End DoDot:1
+38 ;
+39 ;Future Appoinments only patch 33
+40 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:1
+41 SET RORDAYS=0
+42 SET RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
+43 IF RORDAYS>0
Begin DoDot:2
+44 SET TMP=$$FUTAPPT^RORUTL02(DFN,RORDAYS)
+45 ;patch 33&34
DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",$PIECE(TMP,U),PTAG,1)
+46 ;patch 33&34
DO ADDATTR^RORTSK11(RORTSK,$PIECE(TMP,U),"NAME","FUT_APPT")
+47 ;patch 34
DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",$PIECE(TMP,U,2),PTAG,1)
+48 ;patch 34
DO ADDATTR^RORTSK11(RORTSK,$PIECE(TMP,U,2),"NAME","FUT_CLIN")
End DoDot:2
End DoDot:1
+49 ;
+50 ;--- Lab results
+51 SET LABTESTS=$$ADDVAL^RORTSK11(RORTSK,"PTLRL",,PTAG)
+52 SET I=""
+53 FOR
SET I=$ORDER(@RORDST@(I))
if I=""
QUIT
Begin DoDot:1
+54 SET LT=$$ADDVAL^RORTSK11(RORTSK,"LT",,LABTESTS)
+55 DO ADDVAL^RORTSK11(RORTSK,"GROUP",$PIECE(@RORDST@(I,2),U,4),LT,1)
+56 DO ADDVAL^RORTSK11(RORTSK,"DATE",$PIECE(@RORDST@(I,1),U,2),LT,1)
+57 DO ADDVAL^RORTSK11(RORTSK,"NAME",$PIECE(@RORDST@(I,2),U,2),LT,1)
+58 DO ADDVAL^RORTSK11(RORTSK,"RESULT",$PIECE(@RORDST@(I,1),U,3),LT,3)
End DoDot:1
+59 ;---
+60 QUIT $SELECT(RC<0:RC,1:0)
+61 ;
+62 ;***** PROCESSES THE RESULT RANGE OPTIONS
+63 ;
+64 ; GRC Code of a Lab Group
+65 ;
+66 ; Return Values:
+67 ; Description of the Lab results to be included in the report.
+68 ;
RANGE(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")
