- 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 Feb 18, 2025@23:10:59 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