Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORX012A

RORX012A.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #10103 FMADD^XLFDT (supported)
  1. ;
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ; --- ROUTINE MODIFICATION LOG ---
  1. ;
  1. ;PKG/PATCH DATE DEVELOPER MODIFICATION
  1. ;----------- ---------- ----------- ----------------------------------------
  1. ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
  1. ; 'include' or 'exclude'.
  1. ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
  1. ; clinics, or divisions for the report.
  1. ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
  1. ;ROR*1.5*21 SEP 2013 T KOPP Add ICN column if Additional Identifier
  1. ; requested.
  1. ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, AGE/DOB as additional
  1. ; identifiers.
  1. ;ROR*1.5*33 MAY 2017 M FERRARESE Adding Future Appointment
  1. ;ROR*1.5*34 SEP 2018 M FERRARESE Adding Future Appointment clinic name
  1. ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. Q
  1. ;
  1. ;***** LAB SEARCH CALLBACK
  1. ;
  1. ; .ROR8DST Reference to the ROR8DST parameter.
  1. ;
  1. ; INVDT IEN of the Lab test (inverted date)
  1. ;
  1. ; .RESULT Reference to a local variable, which contains
  1. ; the result (see the $$LTSEARCH^RORUTL10).
  1. ;
  1. ; Return Values:
  1. ; <0 Error code (the search will be aborted)
  1. ; 0 Ok
  1. ; 1 Skip this result
  1. ; 2 Skip this and all remaining results
  1. ;
  1. LTSCB(ROR8DST,INVDT,RESULT) ;
  1. N DATE,IEN,NAME,RC,TMP,VAL
  1. S IEN=+RESULT(2) Q:IEN'>0 1 ; IEN of the Lab test
  1. S NAME=$P(RESULT(2),U,2) Q:NAME="" 1 ; Name of the test
  1. S DATE=+$P(RESULT(1),U,2) Q:DATE'>0 1 ; Date of the test
  1. S ROR8DST("RORUTIL")=1
  1. ;--- Check the result range if necessary
  1. I $D(RORLTRV(IEN))>1 S RC=1 D Q:RC RC
  1. . S VAL=$$CLRNMVAL^RORUTL18($P(RESULT(1),U,3))
  1. . ;--- Skip a non-numeric result
  1. . Q:'$$NUMERIC^RORUTL05(VAL)
  1. . ;--- Check the range
  1. . I $G(RORLTRV(IEN,"L"))'="" Q:VAL<RORLTRV(IEN,"L")
  1. . I $G(RORLTRV(IEN,"H"))'="" Q:VAL>RORLTRV(IEN,"H")
  1. . S RC=0
  1. ;--- Store the result
  1. S @ROR8DST@(DATE,NAME,IEN)=$P(RESULT(1),U,3)
  1. Q 0
  1. ;
  1. ;***** QUERIES THE REGISTRY
  1. ;
  1. ; FLAGS Flags for the $$SKIP^RORXU005
  1. ; .NSPT Number of selected patients is returned here
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. QUERY(FLAGS,NSPT) ;
  1. N RORLDST ; Descriptor for Lab search API
  1. N RORPTN ; Number of patients in the registry
  1. N RORXDST ; Descriptor for pharmacy search API
  1. N RORCDLIST ; Flag to indicate whether a clinic or division list exists
  1. N RORCDSTDT ; Start date for clinic/division utilization search
  1. N RORCDENDT ; End date for clinic/division utilization search
  1. N RORICN ; National ICN
  1. N RORPACT ; Patient Care Team PACT
  1. N RORPCP ; Primary Care Provider PCP
  1. N RORDAYS ; Days for Future Appointments patch 33
  1. N RORFUT ; Future Appointment date PATC 33 & 34
  1. N RORCLIN ; Future Clinic Name patch 34
  1. ;
  1. N CNT,ECNT,IEN,IENS,LTEDT,LTSDT,PATIEN,RC,RXEDT,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
  1. N RCC,FLAG
  1. S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
  1. S (CNT,ECNT,NSPT,RC)=0,(SKIPEDT,SKIPSDT)=0
  1. ;--- Utilization date range
  1. D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
  1. . S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
  1. . S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
  1. . ;--- Combined date range
  1. . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
  1. . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
  1. ;--- Number of patients in the registry
  1. S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
  1. ;
  1. ;--- Setup the descriptors for callback API's
  1. I RORLAB D
  1. . I RORLTST'="*",$D(@RORLTST)<10 S RORLAB=0 Q
  1. . S RORLDST("RORCB")="$$LTSCB^RORX012A"
  1. . ;--- Labs date range
  1. . S LTSDT=$$PARAM^RORTSK01("DATE_RANGE_2","START")\1
  1. . S LTEDT=$$PARAM^RORTSK01("DATE_RANGE_2","END")\1
  1. . ;--- Combined date range
  1. . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,LTSDT)
  1. . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,LTEDT)
  1. . ;--- Shift the Labs end date
  1. . S LTEDT=$$FMADD^XLFDT(LTEDT,1)
  1. I RORPHARM D
  1. . I RORXL'="*",$D(@RORXL)<10 S RORPHARM=0 Q
  1. . S RORXDST("RORCB")="$$RXSCB^RORX012A"
  1. . S RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
  1. . ;--- Combined date range
  1. . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,RORXSDT)
  1. . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,RORXEDT)
  1. . ;--- Shift the Meds end date
  1. . S RXEDT=$$FMADD^XLFDT(RORXEDT\1,1)
  1. Q:'(RORLAB!RORPHARM) 0
  1. ;
  1. ;=== Set up Clinic/Division list parameters
  1. S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT,1)
  1. ;
  1. ;--- Browse through the registry records
  1. S IEN=0
  1. S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
  1. F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
  1. . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
  1. . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
  1. . S IENS=IEN_",",CNT=CNT+1
  1. . ;--- Get patient DFN
  1. . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
  1. . ;check for patient list and quit if not on list
  1. . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
  1. . ;--- Check if the patient should be skipped
  1. . Q:$$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
  1. . S SKIP=1,UTIL=0
  1. . ;--- Check if patient should be filtered because of ICD codes
  1. . S RCC=0
  1. . I FLAG'="ALL" D
  1. . . S RCC=$$ICD^RORXU010(PATIEN)
  1. . I (FLAG="INCLUDE")&(RCC=0) Q
  1. . I (FLAG="EXCLUDE")&(RCC=1) Q
  1. . ;
  1. . ;--- Check for Clinic or Division list and quit if not in list
  1. . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
  1. . ;
  1. . D I RC<0 S ECNT=ECNT+1,RC=0 Q
  1. . . ;--- Search for pharmacy data
  1. . . I RORPHARM D Q:RC'>0
  1. . . . M RORXDST("RORXGRP")=RORXGRP("C")
  1. . . . S RORXDST=$NA(^TMP("RORX012",$J,"PAT",PATIEN,"RX"))
  1. . . . K RORXDST("RORUTIL")
  1. . . . S RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RXEDT)
  1. . . . Q:RC<0
  1. . . . ;S:$G(RORXDST("RORUTIL")) UTIL=1
  1. . . . I RC>0 S:$D(RORXDST("RORXGRP"))>1 RC=0
  1. . . . ;--- Invert the result if the "Did Not" logic was selected
  1. . . . I RORPHARM<0 S RC='RC K @RORXDST
  1. . . ;--- Search for Lab data
  1. . . I RORLAB D Q:RC'>0
  1. . . . S RORLDST=$NA(^TMP("RORX012",$J,"PAT",PATIEN,"LR"))
  1. . . . K RORLDST("RORUTIL")
  1. . . . S RC=$$LTSEARCH^RORUTL10(PATIEN,RORLTST,.RORLDST,,LTSDT,LTEDT)
  1. . . . Q:RC<0
  1. . . . ;S:$G(RORLDST("RORUTIL")) UTIL=1
  1. . . . ;--- Invert the result if the "Did Not" logic was selected
  1. . . . S:RORLAB<0 RC='RC
  1. . . ;---
  1. . . S SKIP=0
  1. . ;
  1. . ;--- Check for any utilization in the corresponding date range
  1. . I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
  1. . . K TMP S TMP("ALL")=1
  1. . . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
  1. . . S:'UTIL SKIP=1
  1. . ;
  1. . ;--- Skip the patient if not all search criteria have been met
  1. . I SKIP K ^TMP("RORX012",$J,"PAT",PATIEN) Q
  1. . ;
  1. . ;--- Get and store the patient's data
  1. . D VADEM^RORUTL05(PATIEN,1)
  1. . S RORICN=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
  1. . S TMP=$$DATE^RORXU002(VADM(6)\1)
  1. . S RORPACT=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
  1. . S RORPCP=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
  1. . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
  1. . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
  1. . ; IF Future Appointment only Patch 33
  1. . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
  1. . . S RORDAYS=$$PARAM^RORTSK01("OPTIONS","FUT_APPT")
  1. . . S RORFUT=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U) ; Patch 33 & 34
  1. . . S RORCLIN=$P($$FUTAPPT^RORUTL02(PATIEN,RORDAYS),U,2) ; patch 34
  1. . S ^TMP("RORX012",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP_U_RORICN_U_RORPACT_U_RORPCP_U_AGE
  1. . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") S ^TMP("RORX012",$J,"PAT",PATIEN)=^TMP("RORX012",$J,"PAT",PATIEN)_U_RORFUT_U_RORCLIN
  1. . S NSPT=NSPT+1
  1. ;
  1. ;---
  1. Q $S(RC<0:RC,1:ECNT)
  1. ;
  1. ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
  1. RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
  1. N GRP,IEN,NAME,TMP
  1. S ROR8DST("RORUTIL")=1
  1. ;=== Check the drug groups
  1. S TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
  1. Q:TMP TMP
  1. ;--- Get the drug data
  1. I ROR8DST("GENERIC") D
  1. . S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
  1. E S IEN=+DRUG,NAME=$P(DRUG,U,2)
  1. Q:(IEN'>0)!(NAME="") 1
  1. ;--- Output the data
  1. S @ROR8DST@(NAME,IEN)=""
  1. Q 0
  1. ;
  1. ;***** STORES THE REPORT DATA
  1. ;
  1. ; REPORT IEN of the REPORT element
  1. ; NSPT Number of selected patients
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. STORE(REPORT,NSPT) ;
  1. N CNT,DATE,DFN,DOD,ECNT,ICN,IEN,ITEM,LAST4,LTLST,PACT,PCP,NAME,NODE,PTCNT,PTLST,PTNAME,RC,RXLST,TMP,VAL,AGE,AGETYPE
  1. S (ECNT,RC)=0,(LTLST,PTLST,RXLST)=-1
  1. ;--- Force the "patient data" note in the output
  1. D ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
  1. ;--- Create lab test list
  1. I RORLAB D Q:LTLST<0 LTLST
  1. . S LTLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,REPORT)
  1. . D ADDATTR^RORTSK11(RORTSK,LTLST,"TABLE","LABTESTS")
  1. ;--- Create pharmacy list
  1. I RORPHARM>0 D Q:RXLST<0 RXLST
  1. . S RXLST=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
  1. . D ADDATTR^RORTSK11(RORTSK,RXLST,"TABLE","DRUGS")
  1. ;--- Create patient list
  1. I (RORLAB<0)!(RORPHARM<0) D Q:PTLST<0 PTLST
  1. . S PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
  1. . D ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
  1. ;---
  1. S (CNT,DFN,PTCNT)=0
  1. S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
  1. F S DFN=$O(^TMP("RORX012",$J,"PAT",DFN)) Q:DFN'>0 D Q:RC<0
  1. . S TMP=$S(NSPT>0:CNT/NSPT,1:"")
  1. . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
  1. . S CNT=CNT+1,NODE=$NA(^TMP("RORX012",$J,"PAT",DFN))
  1. . ;--- Patient's data
  1. . S TMP=$G(@NODE)
  1. . 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)
  1. . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") S RORFUT=$P(TMP,U,8),RORCLIN=$P(TMP,U,9)
  1. . ;--- Patient list
  1. . S TMP=$S(LTLST<0:1,1:$D(@NODE@("LR"))<10)
  1. . I TMP,$S(RXLST<0:1,1:$D(@NODE@("RX"))<10) D Q
  1. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,DFN)
  1. . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
  1. . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
  1. . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
  1. . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
  1. . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
  1. . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
  1. . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
  1. . . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
  1. . . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
  1. . . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
  1. . . S PTCNT=PTCNT+1
  1. . ;--- List of Lab tests
  1. . S DATE=""
  1. . F S DATE=$O(@NODE@("LR",DATE)) Q:DATE="" D
  1. . . S NAME=""
  1. . . F S NAME=$O(@NODE@("LR",DATE,NAME)) Q:NAME="" D
  1. . . . S IEN=""
  1. . . . F S IEN=$O(@NODE@("LR",DATE,NAME,IEN)) Q:IEN="" D
  1. . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)
  1. . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
  1. . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
  1. . . . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
  1. . . . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
  1. . . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
  1. . . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
  1. . . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
  1. . . . . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
  1. . . . . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
  1. . . . . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
  1. . . . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ITEM,1)
  1. . . . . D ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)
  1. . . . . S VAL=$G(@NODE@("LR",DATE,NAME,IEN))
  1. . . . . S TMP=$S($$NUMERIC^RORUTL05(VAL):3,1:1)
  1. . . . . D ADDVAL^RORTSK11(RORTSK,"RESULT",VAL,ITEM,TMP)
  1. . ;--- List of drugs
  1. . S NAME=""
  1. . F S NAME=$O(@NODE@("RX",NAME)) Q:NAME="" D
  1. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,RXLST,,DFN)
  1. . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
  1. . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
  1. . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
  1. . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
  1. . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
  1. . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
  1. . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
  1. . . I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D
  1. . . . D ADDVAL^RORTSK11(RORTSK,"FUT_APPT",RORFUT,ITEM,1)
  1. . . . D ADDVAL^RORTSK11(RORTSK,"FUT_CLIN",RORCLIN,ITEM,1)
  1. . . D ADDVAL^RORTSK11(RORTSK,"RXNAME",NAME,ITEM,1)
  1. ;--- Inactivate the patient list tag if the list is empty
  1. D:PTCNT'>0 UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
  1. ;---
  1. Q ECNT