RORX012A ;HOIFO/SG,VAC - COMBINED MEDS AND LABS (QUERY & STORE) ;4/7/09 2:09pm
;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,33,34,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #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 Add ICN column if Additional Identifier
; requested.
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, 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
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;******************************************************************************
Q
;
;***** LAB SEARCH CALLBACK
;
; .ROR8DST Reference to the ROR8DST parameter.
;
; INVDT IEN of the Lab test (inverted date)
;
; .RESULT Reference to a local variable, which contains
; the result (see the $$LTSEARCH^RORUTL10).
;
; Return Values:
; <0 Error code (the search will be aborted)
; 0 Ok
; 1 Skip this result
; 2 Skip this and all remaining results
;
LTSCB(ROR8DST,INVDT,RESULT) ;
N DATE,IEN,NAME,RC,TMP,VAL
S IEN=+RESULT(2) Q:IEN'>0 1 ; IEN of the Lab test
S NAME=$P(RESULT(2),U,2) Q:NAME="" 1 ; Name of the test
S DATE=+$P(RESULT(1),U,2) Q:DATE'>0 1 ; Date of the test
S ROR8DST("RORUTIL")=1
;--- Check the result range if necessary
I $D(RORLTRV(IEN))>1 S RC=1 D Q:RC RC
. S VAL=$$CLRNMVAL^RORUTL18($P(RESULT(1),U,3))
. ;--- Skip a non-numeric result
. Q:'$$NUMERIC^RORUTL05(VAL)
. ;--- Check the range
. I $G(RORLTRV(IEN,"L"))'="" Q:VAL<RORLTRV(IEN,"L")
. I $G(RORLTRV(IEN,"H"))'="" Q:VAL>RORLTRV(IEN,"H")
. S RC=0
;--- Store the result
S @ROR8DST@(DATE,NAME,IEN)=$P(RESULT(1),U,3)
Q 0
;
;***** QUERIES THE REGISTRY
;
; FLAGS Flags for the $$SKIP^RORXU005
; .NSPT Number of selected patients is returned here
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(FLAGS,NSPT) ;
N RORLDST ; Descriptor for Lab search API
N RORPTN ; Number of patients in the registry
N RORXDST ; Descriptor for pharmacy search API
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 RORICN ; National ICN
N RORPACT ; Patient Care Team PACT
N RORPCP ; Primary Care Provider PCP
N RORDAYS ; Days for Future Appointments patch 33
N RORFUT ; Future Appointment date PATC 33 & 34
N RORCLIN ; Future Clinic Name patch 34
;
N CNT,ECNT,IEN,IENS,LTEDT,LTSDT,PATIEN,RC,RXEDT,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
N RCC,FLAG
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S (CNT,ECNT,NSPT,RC)=0,(SKIPEDT,SKIPSDT)=0
;--- Utilization date range
D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
. 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,UTSDT)
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
;--- Number of patients in the registry
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
;
;--- Setup the descriptors for callback API's
I RORLAB D
. I RORLTST'="*",$D(@RORLTST)<10 S RORLAB=0 Q
. S RORLDST("RORCB")="$$LTSCB^RORX012A"
. ;--- Labs date range
. S LTSDT=$$PARAM^RORTSK01("DATE_RANGE_2","START")\1
. S LTEDT=$$PARAM^RORTSK01("DATE_RANGE_2","END")\1
. ;--- Combined date range
. S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,LTSDT)
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,LTEDT)
. ;--- Shift the Labs end date
. S LTEDT=$$FMADD^XLFDT(LTEDT,1)
I RORPHARM D
. I RORXL'="*",$D(@RORXL)<10 S RORPHARM=0 Q
. S RORXDST("RORCB")="$$RXSCB^RORX012A"
. S RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
. ;--- Combined date range
. S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,RORXSDT)
. S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,RORXEDT)
. ;--- Shift the Meds end date
. S RXEDT=$$FMADD^XLFDT(RORXEDT\1,1)
Q:'(RORLAB!RORPHARM) 0
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
;
;--- Browse through the registry records
S IEN=0
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
F S IEN=$O(@XREFNODE@(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 PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
. ;check for patient list and quit if not on list
. I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
. ;--- Check if the patient should be skipped
. Q:$$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
. S SKIP=1,UTIL=0
. ;--- Check if patient should be filtered because of ICD codes
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(PATIEN)
. 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,PATIEN,RORCDSTDT,RORCDENDT) Q
. ;
. D I RC<0 S ECNT=ECNT+1,RC=0 Q
. . ;--- Search for pharmacy data
. . I RORPHARM D Q:RC'>0
. . . M RORXDST("RORXGRP")=RORXGRP("C")
. . . S RORXDST=$NA(^TMP("RORX012",$J,"PAT",PATIEN,"RX"))
. . . K RORXDST("RORUTIL")
. . . S RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RXEDT)
. . . Q:RC<0
. . . ;S:$G(RORXDST("RORUTIL")) UTIL=1
. . . I RC>0 S:$D(RORXDST("RORXGRP"))>1 RC=0
. . . ;--- Invert the result if the "Did Not" logic was selected
. . . I RORPHARM<0 S RC='RC K @RORXDST
. . ;--- Search for Lab data
. . I RORLAB D Q:RC'>0
. . . S RORLDST=$NA(^TMP("RORX012",$J,"PAT",PATIEN,"LR"))
. . . K RORLDST("RORUTIL")
. . . S RC=$$LTSEARCH^RORUTL10(PATIEN,RORLTST,.RORLDST,,LTSDT,LTEDT)
. . . Q:RC<0
. . . ;S:$G(RORLDST("RORUTIL")) UTIL=1
. . . ;--- Invert the result if the "Did Not" logic was selected
. . . S:RORLAB<0 RC='RC
. . ;---
. . S SKIP=0
. ;
. ;--- Check for any utilization in the corresponding date range
. I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
. . K TMP S TMP("ALL")=1
. . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
. . S:'UTIL SKIP=1
. ;
. ;--- Skip the patient if not all search criteria have been met
. I SKIP K ^TMP("RORX012",$J,"PAT",PATIEN) Q
. ;
. ;--- Get and store the patient's data
. D VADEM^RORUTL05(PATIEN,1)
. S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
. S TMP=$$DATE^RORXU002(VADM(6)\1)
. S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
. S RORPCP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
. 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:"")
. ; IF Future Appointment only Patch 33
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . S RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
. . S RORFUT=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U) ; Patch 33 & 34
. . S RORCLIN=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U,2) ; patch 34
. S ^TMP("RORX012",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP_U_RORICN_U_RORPACT_U_RORPCP_U_AGE
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") S ^TMP("RORX012",$J,"PAT",PATIEN)=^TMP("RORX012",$J,"PAT",PATIEN)_U_RORFUT_U_RORCLIN
. S NSPT=NSPT+1
;
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
N GRP,IEN,NAME,TMP
S ROR8DST("RORUTIL")=1
;=== Check the drug groups
S TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
Q:TMP TMP
;--- Get the drug data
I ROR8DST("GENERIC") D
. S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
E S IEN=+DRUG,NAME=$P(DRUG,U,2)
Q:(IEN'>0)!(NAME="") 1
;--- Output the data
S @ROR8DST@(NAME,IEN)=""
Q 0
;
;***** STORES THE REPORT DATA
;
; REPORT IEN of the REPORT element
; NSPT Number of selected patients
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
STORE(REPORT,NSPT) ;
N CNT,DATE,DFN,DOD,ECNT,ICN,IEN,ITEM,LAST4,LTLST,PACT,PCP,NAME,NODE,PTCNT,PTLST,PTNAME,RC,RXLST,TMP,VAL,AGE,AGETYPE
S (ECNT,RC)=0,(LTLST,PTLST,RXLST)=-1
;--- Force the "patient data" note in the output
D ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
;--- Create lab test list
I RORLAB D Q:LTLST<0 LTLST
. S LTLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,REPORT)
. D ADDATTR^RORTSK11(RORTSK,LTLST,"TABLE","LABTESTS")
;--- Create pharmacy list
I RORPHARM>0 D Q:RXLST<0 RXLST
. S RXLST=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
. D ADDATTR^RORTSK11(RORTSK,RXLST,"TABLE","DRUGS")
;--- Create patient list
I (RORLAB<0)!(RORPHARM<0) D Q:PTLST<0 PTLST
. S PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
. D ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
;---
S (CNT,DFN,PTCNT)=0
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
F S DFN=$O(^TMP("RORX012",$J,"PAT",DFN)) Q:DFN'>0 D Q:RC<0
. S TMP=$S(NSPT>0:CNT/NSPT,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S CNT=CNT+1,NODE=$NA(^TMP("RORX012",$J,"PAT",DFN))
. ;--- Patient's data
. S TMP=$G(@NODE)
. S LAST4="0000",PTNAME=$P(TMP,U,2),DOD=$P(TMP,U,3),ICN=$P(TMP,U,4),PACT=$P(TMP,U,5),PCP=$P(TMP,U,6),AGE=$P(TMP,U,7)
. I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") S RORFUT=$P(TMP,U,8),RORCLIN=$P(TMP,U,9)
. ;--- Patient list
. S TMP=$S(LTLST<0:1,1:$D(@NODE@("LR"))<10)
. I TMP,$S(RXLST<0:1,1:$D(@NODE@("RX"))<10) D Q
. . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,DFN)
. . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
. . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
. . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
. . S PTCNT=PTCNT+1
. ;--- List of Lab tests
. S DATE=""
. F S DATE=$O(@NODE@("LR",DATE)) Q:DATE="" D
. . S NAME=""
. . F S NAME=$O(@NODE@("LR",DATE,NAME)) Q:NAME="" D
. . . S IEN=""
. . . F S IEN=$O(@NODE@("LR",DATE,NAME,IEN)) Q:IEN="" D
. . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)
. . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
. . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
. . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
. . . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
. . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
. . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
. . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
. . . . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . . . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
. . . . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
. . . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ITEM,1)
. . . . D ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)
. . . . S VAL=$G(@NODE@("LR",DATE,NAME,IEN))
. . . . S TMP=$S($$NUMERIC^RORUTL05(VAL):3,1:1)
. . . . D ADDVAL^RORTSK11(RORTSK,"RESULT",VAL,ITEM,TMP)
. ;--- List of drugs
. S NAME=""
. F S NAME=$O(@NODE@("RX",NAME)) Q:NAME="" D
. . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,RXLST,,DFN)
. . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
. . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
. . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
. . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"RXNAME",NAME,ITEM,1)
;--- Inactivate the patient list tag if the list is empty
D:PTCNT'>0 UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
;---
Q ECNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX012A 13766 printed Apr 09, 2024@20:49:34 Page 2
RORX012A ;HOIFO/SG,VAC - COMBINED MEDS AND LABS (QUERY & STORE) ;4/7/09 2:09pm
+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 ; #10103 FMADD^XLFDT (supported)
+6 ;
+7 ;******************************************************************************
+8 ;******************************************************************************
+9 ; --- ROUTINE MODIFICATION LOG ---
+10 ;
+11 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+12 ;----------- ---------- ----------- ----------------------------------------
+13 ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
+14 ; 'include' or 'exclude'.
+15 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+16 ; clinics, or divisions for the report.
+17 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+18 ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
+19 ; requested.
+20 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, AGE/DOB as additional
+21 ; identifiers.
+22 ;ROR*1.5*33 MAY 2017 M FERRARESE Adding Future Appointment
+23 ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
+24 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+25 ;******************************************************************************
+26 ;******************************************************************************
+27 QUIT
+28 ;
+29 ;***** LAB SEARCH CALLBACK
+30 ;
+31 ; .ROR8DST Reference to the ROR8DST parameter.
+32 ;
+33 ; INVDT IEN of the Lab test (inverted date)
+34 ;
+35 ; .RESULT Reference to a local variable, which contains
+36 ; the result (see the $$LTSEARCH^RORUTL10).
+37 ;
+38 ; Return Values:
+39 ; <0 Error code (the search will be aborted)
+40 ; 0 Ok
+41 ; 1 Skip this result
+42 ; 2 Skip this and all remaining results
+43 ;
LTSCB(ROR8DST,INVDT,RESULT) ;
+1 NEW DATE,IEN,NAME,RC,TMP,VAL
+2 ; IEN of the Lab test
SET IEN=+RESULT(2)
if IEN'>0
QUIT 1
+3 ; Name of the test
SET NAME=$PIECE(RESULT(2),U,2)
if NAME=""
QUIT 1
+4 ; Date of the test
SET DATE=+$PIECE(RESULT(1),U,2)
if DATE'>0
QUIT 1
+5 SET ROR8DST("RORUTIL")=1
+6 ;--- Check the result range if necessary
+7 IF $DATA(RORLTRV(IEN))>1
SET RC=1
Begin DoDot:1
+8 SET VAL=$$CLRNMVAL^RORUTL18($PIECE(RESULT(1),U,3))
+9 ;--- Skip a non-numeric result
+10 if '$$NUMERIC^RORUTL05(VAL)
QUIT
+11 ;--- Check the range
+12 IF $GET(RORLTRV(IEN,"L"))'=""
if VAL<RORLTRV(IEN,"L")
QUIT
+13 IF $GET(RORLTRV(IEN,"H"))'=""
if VAL>RORLTRV(IEN,"H")
QUIT
+14 SET RC=0
End DoDot:1
if RC
QUIT RC
+15 ;--- Store the result
+16 SET @ROR8DST@(DATE,NAME,IEN)=$PIECE(RESULT(1),U,3)
+17 QUIT 0
+18 ;
+19 ;***** QUERIES THE REGISTRY
+20 ;
+21 ; FLAGS Flags for the $$SKIP^RORXU005
+22 ; .NSPT Number of selected patients is returned here
+23 ;
+24 ; Return Values:
+25 ; <0 Error code
+26 ; 0 Ok
+27 ; >0 Number of non-fatal errors
+28 ;
QUERY(FLAGS,NSPT) ;
+1 ; Descriptor for Lab search API
NEW RORLDST
+2 ; Number of patients in the registry
NEW RORPTN
+3 ; Descriptor for pharmacy search API
NEW RORXDST
+4 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+5 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+6 ; End date for clinic/division utilization search
NEW RORCDENDT
+7 ; National ICN
NEW RORICN
+8 ; Patient Care Team PACT
NEW RORPACT
+9 ; Primary Care Provider PCP
NEW RORPCP
+10 ; Days for Future Appointments patch 33
NEW RORDAYS
+11 ; Future Appointment date PATC 33 & 34
NEW RORFUT
+12 ; Future Clinic Name patch 34
NEW RORCLIN
+13 ;
+14 NEW CNT,ECNT,IEN,IENS,LTEDT,LTSDT,PATIEN,RC,RXEDT,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
+15 NEW RCC,FLAG
+16 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+17 SET (CNT,ECNT,NSPT,RC)=0
SET (SKIPEDT,SKIPSDT)=0
+18 ;--- Utilization date range
+19 if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:1
+20 SET UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
+21 SET UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
+22 ;--- Combined date range
+23 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
+24 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
End DoDot:1
+25 ;--- Number of patients in the registry
+26 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+27 ;
+28 ;--- Setup the descriptors for callback API's
+29 IF RORLAB
Begin DoDot:1
+30 IF RORLTST'="*"
IF $DATA(@RORLTST)<10
SET RORLAB=0
QUIT
+31 SET RORLDST("RORCB")="$$LTSCB^RORX012A"
+32 ;--- Labs date range
+33 SET LTSDT=$$PARAM^RORTSK01("DATE_RANGE_2","START")\1
+34 SET LTEDT=$$PARAM^RORTSK01("DATE_RANGE_2","END")\1
+35 ;--- Combined date range
+36 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,LTSDT)
+37 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,LTEDT)
+38 ;--- Shift the Labs end date
+39 SET LTEDT=$$FMADD^XLFDT(LTEDT,1)
End DoDot:1
+40 IF RORPHARM
Begin DoDot:1
+41 IF RORXL'="*"
IF $DATA(@RORXL)<10
SET RORPHARM=0
QUIT
+42 SET RORXDST("RORCB")="$$RXSCB^RORX012A"
+43 SET RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
+44 ;--- Combined date range
+45 SET SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,RORXSDT)
+46 SET SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,RORXEDT)
+47 ;--- Shift the Meds end date
+48 SET RXEDT=$$FMADD^XLFDT(RORXEDT\1,1)
End DoDot:1
+49 if '(RORLAB!RORPHARM)
QUIT 0
+50 ;
+51 ;=== Set up Clinic/Division list parameters
+52 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
+53 ;
+54 ;--- Browse through the registry records
+55 SET IEN=0
+56 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+57 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+58 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+59 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+60 SET IENS=IEN_","
SET CNT=CNT+1
+61 ;--- Get patient DFN
+62 SET PATIEN=$$PTIEN^RORUTL01(IEN)
if PATIEN'>0
QUIT
+63 ;check for patient list and quit if not on list
+64 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
QUIT
+65 ;--- Check if the patient should be skipped
+66 if $$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
QUIT
+67 SET SKIP=1
SET UTIL=0
+68 ;--- Check if patient should be filtered because of ICD codes
+69 SET RCC=0
+70 IF FLAG'="ALL"
Begin DoDot:2
+71 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+72 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+73 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+74 ;
+75 ;--- Check for Clinic or Division list and quit if not in list
+76 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+77 ;
+78 Begin DoDot:2
+79 ;--- Search for pharmacy data
+80 IF RORPHARM
Begin DoDot:3
+81 MERGE RORXDST("RORXGRP")=RORXGRP("C")
+82 SET RORXDST=$NAME(^TMP("RORX012",$JOB,"PAT",PATIEN,"RX"))
+83 KILL RORXDST("RORUTIL")
+84 SET RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RXEDT)
+85 if RC<0
QUIT
+86 ;S:$G(RORXDST("RORUTIL")) UTIL=1
+87 IF RC>0
if $DATA(RORXDST("RORXGRP"))>1
SET RC=0
+88 ;--- Invert the result if the "Did Not" logic was selected
+89 IF RORPHARM<0
SET RC='RC
KILL @RORXDST
End DoDot:3
if RC'>0
QUIT
+90 ;--- Search for Lab data
+91 IF RORLAB
Begin DoDot:3
+92 SET RORLDST=$NAME(^TMP("RORX012",$JOB,"PAT",PATIEN,"LR"))
+93 KILL RORLDST("RORUTIL")
+94 SET RC=$$LTSEARCH^RORUTL10(PATIEN,RORLTST,.RORLDST,,LTSDT,LTEDT)
+95 if RC<0
QUIT
+96 ;S:$G(RORLDST("RORUTIL")) UTIL=1
+97 ;--- Invert the result if the "Did Not" logic was selected
+98 if RORLAB<0
SET RC='RC
End DoDot:3
if RC'>0
QUIT
+99 ;---
+100 SET SKIP=0
End DoDot:2
IF RC<0
SET ECNT=ECNT+1
SET RC=0
QUIT
+101 ;
+102 ;--- Check for any utilization in the corresponding date range
+103 IF 'SKIP
if $$PARAM^RORTSK01("PATIENTS","CAREONLY")
Begin DoDot:2
+104 KILL TMP
SET TMP("ALL")=1
+105 SET UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
+106 if 'UTIL
SET SKIP=1
End DoDot:2
+107 ;
+108 ;--- Skip the patient if not all search criteria have been met
+109 IF SKIP
KILL ^TMP("RORX012",$JOB,"PAT",PATIEN)
QUIT
+110 ;
+111 ;--- Get and store the patient's data
+112 DO VADEM^RORUTL05(PATIEN,1)
+113 SET RORICN=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
+114 SET TMP=$$DATE^RORXU002(VADM(6)\1)
+115 SET RORPACT=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
+116 SET RORPCP=$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
+117 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+118 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
+119 ; IF Future Appointment only Patch 33
+120 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:2
+121 SET RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
+122 ; Patch 33 & 34
SET RORFUT=$PIECE($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U)
+123 ; patch 34
SET RORCLIN=$PIECE($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U,2)
End DoDot:2
+124 SET ^TMP("RORX012",$JOB,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP_U_RORICN_U_RORPACT_U_RORPCP_U_AGE
+125 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
SET ^TMP("RORX012",$JOB,"PAT",PATIEN)=^TMP("RORX012",$JOB,"PAT",PATIEN)_U_RORFUT_U_RORCLIN
+126 SET NSPT=NSPT+1
End DoDot:1
if RC<0
QUIT
+127 ;
+128 ;---
+129 QUIT $SELECT(RC<0:RC,1:ECNT)
+130 ;
+131 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
+1 NEW GRP,IEN,NAME,TMP
+2 SET ROR8DST("RORUTIL")=1
+3 ;=== Check the drug groups
+4 SET TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
+5 if TMP
QUIT TMP
+6 ;--- Get the drug data
+7 IF ROR8DST("GENERIC")
Begin DoDot:1
+8 SET IEN=+ROR8DST("RORXGEN")
SET NAME=$PIECE(ROR8DST("RORXGEN"),U,2)
End DoDot:1
+9 IF '$TEST
SET IEN=+DRUG
SET NAME=$PIECE(DRUG,U,2)
+10 if (IEN'>0)!(NAME="")
QUIT 1
+11 ;--- Output the data
+12 SET @ROR8DST@(NAME,IEN)=""
+13 QUIT 0
+14 ;
+15 ;***** STORES THE REPORT DATA
+16 ;
+17 ; REPORT IEN of the REPORT element
+18 ; NSPT Number of selected patients
+19 ;
+20 ; Return Values:
+21 ; <0 Error code
+22 ; 0 Ok
+23 ; >0 Number of non-fatal errors
+24 ;
STORE(REPORT,NSPT) ;
+1 NEW CNT,DATE,DFN,DOD,ECNT,ICN,IEN,ITEM,LAST4,LTLST,PACT,PCP,NAME,NODE,PTCNT,PTLST,PTNAME,RC,RXLST,TMP,VAL,AGE,AGETYPE
+2 SET (ECNT,RC)=0
SET (LTLST,PTLST,RXLST)=-1
+3 ;--- Force the "patient data" note in the output
+4 DO ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
+5 ;--- Create lab test list
+6 IF RORLAB
Begin DoDot:1
+7 SET LTLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,REPORT)
+8 DO ADDATTR^RORTSK11(RORTSK,LTLST,"TABLE","LABTESTS")
End DoDot:1
if LTLST<0
QUIT LTLST
+9 ;--- Create pharmacy list
+10 IF RORPHARM>0
Begin DoDot:1
+11 SET RXLST=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
+12 DO ADDATTR^RORTSK11(RORTSK,RXLST,"TABLE","DRUGS")
End DoDot:1
if RXLST<0
QUIT RXLST
+13 ;--- Create patient list
+14 IF (RORLAB<0)!(RORPHARM<0)
Begin DoDot:1
+15 SET PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+16 DO ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
End DoDot:1
if PTLST<0
QUIT PTLST
+17 ;---
+18 SET (CNT,DFN,PTCNT)=0
+19 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+20 FOR
SET DFN=$ORDER(^TMP("RORX012",$JOB,"PAT",DFN))
if DFN'>0
QUIT
Begin DoDot:1
+21 SET TMP=$SELECT(NSPT>0:CNT/NSPT,1:"")
+22 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+23 SET CNT=CNT+1
SET NODE=$NAME(^TMP("RORX012",$JOB,"PAT",DFN))
+24 ;--- Patient's data
+25 SET TMP=$GET(@NODE)
+26 SET LAST4="0000"
SET PTNAME=$PIECE(TMP,U,2)
SET DOD=$PIECE(TMP,U,3)
SET ICN=$PIECE(TMP,U,4)
SET PACT=$PIECE(TMP,U,5)
SET PCP=$PIECE(TMP,U,6)
SET AGE=$PIECE(TMP,U,7)
+27 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
SET RORFUT=$PIECE(TMP,U,8)
SET RORCLIN=$PIECE(TMP,U,9)
+28 ;--- Patient list
+29 SET TMP=$SELECT(LTLST<0:1,1:$DATA(@NODE@("LR"))<10)
+30 IF TMP
IF $SELECT(RXLST<0:1,1:$DATA(@NODE@("RX"))<10)
Begin DoDot:2
+31 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,DFN)
+32 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
+33 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+34 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
+35 DO ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
+36 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
+37 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
+38 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
+39 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:3
+40 DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
+41 DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
End DoDot:3
+42 SET PTCNT=PTCNT+1
End DoDot:2
QUIT
+43 ;--- List of Lab tests
+44 SET DATE=""
+45 FOR
SET DATE=$ORDER(@NODE@("LR",DATE))
if DATE=""
QUIT
Begin DoDot:2
+46 SET NAME=""
+47 FOR
SET NAME=$ORDER(@NODE@("LR",DATE,NAME))
if NAME=""
QUIT
Begin DoDot:3
+48 SET IEN=""
+49 FOR
SET IEN=$ORDER(@NODE@("LR",DATE,NAME,IEN))
if IEN=""
QUIT
Begin DoDot:4
+50 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)
+51 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
+52 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+53 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
+54 DO ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
+55 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
+56 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
+57 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
+58 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:5
+59 DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
+60 DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
End DoDot:5
+61 DO ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ITEM,1)
+62 DO ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)
+63 SET VAL=$GET(@NODE@("LR",DATE,NAME,IEN))
+64 SET TMP=$SELECT($$NUMERIC^RORUTL05(VAL):3,1:1)
+65 DO ADDVAL^RORTSK11(RORTSK,"RESULT",VAL,ITEM,TMP)
End DoDot:4
End DoDot:3
End DoDot:2
+66 ;--- List of drugs
+67 SET NAME=""
+68 FOR
SET NAME=$ORDER(@NODE@("RX",NAME))
if NAME=""
QUIT
Begin DoDot:2
+69 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,RXLST,,DFN)
+70 DO ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
+71 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+72 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
+73 DO ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
+74 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
+75 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
+76 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
+77 IF $$PARAM^RORTSK01("OPTIONS","FUT_APPT")
Begin DoDot:3
+78 DO ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
+79 DO ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
End DoDot:3
+80 DO ADDVAL^RORTSK11(RORTSK,"RXNAME",NAME,ITEM,1)
End DoDot:2
End DoDot:1
if RC<0
QUIT
+81 ;--- Inactivate the patient list tag if the list is empty
+82 if PTCNT'>0
DO UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
+83 ;---
+84 QUIT ECNT
