RORX012 ;HOIFO/SG,VAC - COMBINED MEDS AND LABS REPORT ;4/9/09 9:40am
;;1.5;CLINICAL CASE REGISTRIES;**8,21,31,33,34**;Feb 17, 2006;Build 45
;
;Modified Feb 2009, to permit only the most recent test to be
; displayed on the report - a call to ^RORXU009
;
;Modified March 2009 to filter patients on Include or Exclude ICD9
; codes. Call to ^RORXU010
;
;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 MAY 2017 M FERRARESE Adding Future Appointment
;
;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
;******************************************************************************
;
Q
;
;***** OUTPUTS THE REPORT HEADER
;
; PARTAG Reference (IEN) to the parent tag
;
; Return Values:
; <0 Error code
; >0 IEN of the HEADER element
;
;;DRUGS(#,NAME,LAST4,DOD,RXNAME)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;DRUGS(#,NAME,LAST4,AGE,DOD,RXNAME)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;DRUGS(#,NAME,LAST4,DOB,DOD,RXNAME)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;LABTESTS(#,NAME,LAST4,DOD,DATE,LTNAME,RESULT)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;LABTESTS(#,NAME,LAST4,AGE,DOD,DATE,LTNAME,RESULT)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;LABTESTS(#,NAME,LAST4,DOB,DOD,DATE,LTNAME,RESULT)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
;;PATIENTS(#,NAME,LAST4,AGE,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
;;PATIENTS(#,NAME,LAST4,DOB,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
;
N HEADER,RC
S HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
Q:HEADER<0 HEADER
S RC=$$TBLDEF^RORXU002("HEADER^RORX012",HEADER)
Q $S(RC<0:RC,1:HEADER)
;
;***** OUTPUTS THE PARAMETERS TO THE REPORT
;
; PARTAG Reference (IEN) to the parent tag
;
; [.STDT] Start and end dates of the report
; [.ENDT] are returned via these parameters
;
; [.FLAGS] Flags for the $$SKIP^RORXU005 are
; returned via this parameter
;
; Return Values:
; <0 Error code
; >0 IEN of the PARAMETERS element
;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
N PARAMS,TMP
S PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
Q:PARAMS<0 PARAMS
;--- Process the list of drugs and groups
I RORPHARM D Q:TMP<0 TMP
. S TMP=$$DRUGLST^RORXU007(.RORTSK,PARAMS,.RORXL,.RORXGRP)
;--- Process the list of Lab tests
I RORLAB D Q:TMP<0 TMP
. S TMP=$$LTLST^RORXU006(.RORTSK,PARAMS,.RORLTST,"RORLTRV")
;---
Q PARAMS
;
;***** DETERMINES THE REPORT MODE FOR LAB OR PHARMACY
;
; NAME Base name of the attribute ("LAB" or "PHARM")
;
; Return Values:
; <0 "Did Not"
; 0 Not selected
; >0 "Did"
RPTMODE(NAME) ;
Q:$$PARAM^RORTSK01("PATIENTS",NAME) 1 ; "Did"
Q:$$PARAM^RORTSK01("PATIENTS","NO"_NAME) -1 ; "Did Not"
Q 0
;
;***** COMPILES THE "COMBINED PHARMACY AND LAB" REPORT
; REPORT CODE: 012
;
; .RORTSK Task number and task parameters
;
; The ^TMP("RORX012",$J) global node is used by this function.
;
; ^TMP("RORX012",$J,
; "PAT",
; DFN, Patient descriptor
; ^01: Last 4 digits of SSN
; ^02: Patient name
; ^03: Date of Death
; ^04: ICN
; ^05: PACT
; ^06: PCP
; ^07: AGE/DOB
; ^08: FUT APPOINTMENT DATE
; ^09: FUT APPOINTMENT CLINIC
;
;
; "LR",
; Date,
; TestName,
; TestIEN) Result
; "RX",
; DrugName,
; DrugIEN) ""
;
; Return Values:
; <0 Error code
; 0 Ok
;
RXANDLAB(RORTSK) ;
N RORLAB ; Labs mode (-1|0|1)
N RORLTST ; Closed root of the list of lab tests for the
; ; Lab search API
N RORLTRV ; Closed root of the list of lab tests with ranges
N RORPHARM ; Meds mode (-1|0|1)
N RORREG ; Registry IEN
N RORXEDT ; Pharmacy end date
N RORXGRP ; List of drug groups
N RORXL ; Closed root of the drug list for the pharmacy
; ; search API or "*" if all drugs were selected
N RORXSDT ; Pharmacy start date
;
N ECNT,NSPT,RC,REPORT,SFLAGS,TMP
N RORDEL ; Flag to determine if Most Recent is set
N RORDELTSK ; Task number passed to delete tests
S RORDEL=$G(RORTSK("PARAMS","LABTESTS","A","MOST_RECENT"))
S RORDELTSK=RORTSK
S (RORXL,RORLTST)="",(ECNT,RC)=0
K ^TMP("RORX012",$J)
;--- Root node of the report
S REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
Q:REPORT<0 REPORT
;
D
. ;--- Get and prepare the report parameters
. S RORREG=$$PARAM^RORTSK01("REGIEN") ; Registry IEN
. S RORLAB=$$RPTMODE("LAB") ; Labs logic
. S RORPHARM=$$RPTMODE("PHARM") ; Meds logic
. S RC=$$PARAMS(REPORT,.RORXSDT,.RORXEDT,.SFLAGS) Q:RC<0
. ;--- Report header
. S RC=$$HEADER(REPORT) Q:RC<0
. ;--- Query the registry
. D TPPSETUP^RORTSK01(80)
. S RC=$$QUERY^RORX012A(SFLAGS,.NSPT)
. I RC Q:RC<0 S ECNT=ECNT+RC
. ;--- Store the results
. D TPPSETUP^RORTSK01(20)
. S RC=$$STORE^RORX012A(REPORT,NSPT)
. I RC Q:RC<0 S ECNT=ECNT+RC
;
;--- Cleanup
;--- Modify the report if only the latest test is required
; Inputs are Task number for File 798.8 and the flag
I RORDEL=1 D DEL^RORXU009(RORDELTSK)
K ^TMP("RORX012",$J)
D FREE^RORTMP(RORXL),FREE^RORTMP(RORLTST)
;
Q $S(RC<0:RC,ECNT>0:-43,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX012 6050 printed Dec 13, 2024@01:44:36 Page 2
RORX012 ;HOIFO/SG,VAC - COMBINED MEDS AND LABS REPORT ;4/9/09 9:40am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,21,31,33,34**;Feb 17, 2006;Build 45
+2 ;
+3 ;Modified Feb 2009, to permit only the most recent test to be
+4 ; displayed on the report - a call to ^RORXU009
+5 ;
+6 ;Modified March 2009 to filter patients on Include or Exclude ICD9
+7 ; codes. Call to ^RORXU010
+8 ;
+9 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+10 ; requested.
+11 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+12 ; identifiers.
+13 ;ROR*1.5*33 MAY 2017 M FERRARESE Adding Future Appointment
+14 ;
+15 ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
+16 ;******************************************************************************
+17 ;
+18 QUIT
+19 ;
+20 ;***** OUTPUTS THE REPORT HEADER
+21 ;
+22 ; PARTAG Reference (IEN) to the parent tag
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; >0 IEN of the HEADER element
+27 ;
+1 ;;DRUGS(#,NAME,LAST4,DOD,RXNAME)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+2 ;;DRUGS(#,NAME,LAST4,AGE,DOD,RXNAME)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+3 ;;DRUGS(#,NAME,LAST4,DOB,DOD,RXNAME)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+4 ;;LABTESTS(#,NAME,LAST4,DOD,DATE,LTNAME,RESULT)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+5 ;;LABTESTS(#,NAME,LAST4,AGE,DOD,DATE,LTNAME,RESULT)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+6 ;;LABTESTS(#,NAME,LAST4,DOB,DOD,DATE,LTNAME,RESULT)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+7 ;;PATIENTS(#,NAME,LAST4,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="ALL"
+8 ;;PATIENTS(#,NAME,LAST4,AGE,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="AGE"
+9 ;;PATIENTS(#,NAME,LAST4,DOB,DOD,ICN,PACT,PCP,FUT_APPT,FUT_CLIN)^I $$PARAM^RORTSK01("AGE_RANGE","TYPE")="DOB"
+10 ;
+11 NEW HEADER,RC
+12 SET HEADER=$$HEADER^RORXU002(.RORTSK,PARTAG)
+13 if HEADER<0
QUIT HEADER
+14 SET RC=$$TBLDEF^RORXU002("HEADER^RORX012",HEADER)
+15 QUIT $SELECT(RC<0:RC,1:HEADER)
+16 ;
+17 ;***** OUTPUTS THE PARAMETERS TO THE REPORT
+18 ;
+19 ; PARTAG Reference (IEN) to the parent tag
+20 ;
+21 ; [.STDT] Start and end dates of the report
+22 ; [.ENDT] are returned via these parameters
+23 ;
+24 ; [.FLAGS] Flags for the $$SKIP^RORXU005 are
+25 ; returned via this parameter
+26 ;
+27 ; Return Values:
+28 ; <0 Error code
+29 ; >0 IEN of the PARAMETERS element
+30 ;
PARAMS(PARTAG,STDT,ENDT,FLAGS) ;
+1 NEW PARAMS,TMP
+2 SET PARAMS=$$PARAMS^RORXU002(.RORTSK,PARTAG,.STDT,.ENDT,.FLAGS)
+3 if PARAMS<0
QUIT PARAMS
+4 ;--- Process the list of drugs and groups
+5 IF RORPHARM
Begin DoDot:1
+6 SET TMP=$$DRUGLST^RORXU007(.RORTSK,PARAMS,.RORXL,.RORXGRP)
End DoDot:1
if TMP<0
QUIT TMP
+7 ;--- Process the list of Lab tests
+8 IF RORLAB
Begin DoDot:1
+9 SET TMP=$$LTLST^RORXU006(.RORTSK,PARAMS,.RORLTST,"RORLTRV")
End DoDot:1
if TMP<0
QUIT TMP
+10 ;---
+11 QUIT PARAMS
+12 ;
+13 ;***** DETERMINES THE REPORT MODE FOR LAB OR PHARMACY
+14 ;
+15 ; NAME Base name of the attribute ("LAB" or "PHARM")
+16 ;
+17 ; Return Values:
+18 ; <0 "Did Not"
+19 ; 0 Not selected
+20 ; >0 "Did"
RPTMODE(NAME) ;
+1 ; "Did"
if $$PARAM^RORTSK01("PATIENTS",NAME)
QUIT 1
+2 ; "Did Not"
if $$PARAM^RORTSK01("PATIENTS","NO"_NAME)
QUIT -1
+3 QUIT 0
+4 ;
+5 ;***** COMPILES THE "COMBINED PHARMACY AND LAB" REPORT
+6 ; REPORT CODE: 012
+7 ;
+8 ; .RORTSK Task number and task parameters
+9 ;
+10 ; The ^TMP("RORX012",$J) global node is used by this function.
+11 ;
+12 ; ^TMP("RORX012",$J,
+13 ; "PAT",
+14 ; DFN, Patient descriptor
+15 ; ^01: Last 4 digits of SSN
+16 ; ^02: Patient name
+17 ; ^03: Date of Death
+18 ; ^04: ICN
+19 ; ^05: PACT
+20 ; ^06: PCP
+21 ; ^07: AGE/DOB
+22 ; ^08: FUT APPOINTMENT DATE
+23 ; ^09: FUT APPOINTMENT CLINIC
+24 ;
+25 ;
+26 ; "LR",
+27 ; Date,
+28 ; TestName,
+29 ; TestIEN) Result
+30 ; "RX",
+31 ; DrugName,
+32 ; DrugIEN) ""
+33 ;
+34 ; Return Values:
+35 ; <0 Error code
+36 ; 0 Ok
+37 ;
RXANDLAB(RORTSK) ;
+1 ; Labs mode (-1|0|1)
NEW RORLAB
+2 ; Closed root of the list of lab tests for the
NEW RORLTST
+3 ; ; Lab search API
+4 ; Closed root of the list of lab tests with ranges
NEW RORLTRV
+5 ; Meds mode (-1|0|1)
NEW RORPHARM
+6 ; Registry IEN
NEW RORREG
+7 ; Pharmacy end date
NEW RORXEDT
+8 ; List of drug groups
NEW RORXGRP
+9 ; Closed root of the drug list for the pharmacy
NEW RORXL
+10 ; ; search API or "*" if all drugs were selected
+11 ; Pharmacy start date
NEW RORXSDT
+12 ;
+13 NEW ECNT,NSPT,RC,REPORT,SFLAGS,TMP
+14 ; Flag to determine if Most Recent is set
NEW RORDEL
+15 ; Task number passed to delete tests
NEW RORDELTSK
+16 SET RORDEL=$GET(RORTSK("PARAMS","LABTESTS","A","MOST_RECENT"))
+17 SET RORDELTSK=RORTSK
+18 SET (RORXL,RORLTST)=""
SET (ECNT,RC)=0
+19 KILL ^TMP("RORX012",$JOB)
+20 ;--- Root node of the report
+21 SET REPORT=$$ADDVAL^RORTSK11(RORTSK,"REPORT")
+22 if REPORT<0
QUIT REPORT
+23 ;
+24 Begin DoDot:1
+25 ;--- Get and prepare the report parameters
+26 ; Registry IEN
SET RORREG=$$PARAM^RORTSK01("REGIEN")
+27 ; Labs logic
SET RORLAB=$$RPTMODE("LAB")
+28 ; Meds logic
SET RORPHARM=$$RPTMODE("PHARM")
+29 SET RC=$$PARAMS(REPORT,.RORXSDT,.RORXEDT,.SFLAGS)
if RC<0
QUIT
+30 ;--- Report header
+31 SET RC=$$HEADER(REPORT)
if RC<0
QUIT
+32 ;--- Query the registry
+33 DO TPPSETUP^RORTSK01(80)
+34 SET RC=$$QUERY^RORX012A(SFLAGS,.NSPT)
+35 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
+36 ;--- Store the results
+37 DO TPPSETUP^RORTSK01(20)
+38 SET RC=$$STORE^RORX012A(REPORT,NSPT)
+39 IF RC
if RC<0
QUIT
SET ECNT=ECNT+RC
End DoDot:1
+40 ;
+41 ;--- Cleanup
+42 ;--- Modify the report if only the latest test is required
+43 ; Inputs are Task number for File 798.8 and the flag
+44 IF RORDEL=1
DO DEL^RORXU009(RORDELTSK)
+45 KILL ^TMP("RORX012",$JOB)
+46 DO FREE^RORTMP(RORXL)
DO FREE^RORTMP(RORLTST)
+47 ;
+48 QUIT $SELECT(RC<0:RC,ECNT>0:-43,1:0)
