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

RORX008A.m

Go to the documentation of this file. 
  1. RORX008A ;HOIFO/BH,SG,VAC - VERA REIMBURSEMENT REPORT ;4/7/09 2:08pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
  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       Added ICN as last report column if
  1.  ;                                      additional identifier option selected
  1.  ;ROR*1.5*31   MAY 2017    M FERRARESE  Adding PACT, PCP, and AGE/DOB as additional
  1.  ;                                      identifiers.
  1.  ;ROR*1.5*39   JUL 2021    M FERRARESE  Setting SSN and LAST4 to zeros                                     
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ;
  1.  ;***** QUERIES THE REGISTRY
  1.  ;
  1.  ; FLAGS         Flags for the $$SKIP^RORXU005
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. QUERY(FLAGS) ;
  1.  N RORPTN        ; Number of patients in the registry
  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.  ;
  1.  N CLINAIDS,CMPXCARE,CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,FLAG,IEN,NAME,PATIEN,RC,RCC,RORIEN,RORXDST,TMP,UTLCHK,VA,VADM,VAERR,XREFNODE
  1.  N AGE,AGETYPE
  1.  ;
  1.  S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
  1.  S RORPTN=$$REGSIZE^RORUTL02(+RORREG)  S:RORPTN<0 RORPTN=0
  1.  S (CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,RC)=0
  1.  S UTLCHK("ALL")=""
  1.  ;
  1.  ;--- Prepare parameters for the pharmacy search API
  1.  S RORXDST("RORCB")="$$RXSCB^RORX008A"
  1.  S TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
  1.  S RORXDST("SINGLE")='TMP!'$$PARAM^RORTSK01("PATIENTS","COMPLEX")
  1.  ;
  1.  ;=== Set up Clinic/Division list parameters
  1.  S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
  1.  ;
  1.  ;--- Browse through the registry records
  1.  S RORIEN=0
  1.  S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
  1.  F  S RORIEN=$O(@XREFNODE@(RORIEN))  Q:RORIEN'>0  D  Q:RC<0
  1.  . ;--- Start progress counter
  1.  . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
  1.  . S RC=$$LOOP^RORTSK01(TMP)  Q:RC<0
  1.  . S CNT=CNT+1
  1.  . ;--- Get patient DFN
  1.  . S PATIEN=$$PTIEN^RORUTL01(RORIEN) 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(RORIEN,FLAGS,RORSDT,ROREDT)
  1.  . ;--- Check patient against ICD list
  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.  . ; End of check of ICD list
  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.  . ;--- Skip Clinical AIDS if Complex Care was not requested
  1.  . S CMPXCARE=0
  1.  . S CLINAIDS=$S($$CLINAIDS^RORHIVUT(RORIEN,ROREDT):1,1:0)
  1.  . I CLINAIDS  Q:'$$PARAM^RORTSK01("PATIENTS","COMPLEX")  S CMPXCARE=1
  1.  . ;
  1.  . ;--- Skip a patient without utlilization
  1.  . Q:'$$UTIL^RORXU003(RORSDT,ROREDT,PATIEN,.UTLCHK)
  1.  . ;
  1.  . ;--- Search for pharmacy data
  1.  . K RORXDST("ARV")
  1.  . S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORSDT,ROREDT1)
  1.  . I TMP<0  S ECNT=ECNT+1  Q
  1.  . I $D(RORXDST("ARV"))  Q:'$$PARAM^RORTSK01("PATIENTS","COMPLEX")  D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(RORXDST("ARV",IEN))  Q:IEN'>0  D
  1.  . . . D:'$D(^TMP("RORX008",$J,"DRG",IEN))
  1.  . . . . S ^TMP("RORX008",$J,"DRG",IEN)=RORXDST("ARV",IEN)
  1.  . . . S ^(CLINAIDS)=$G(^TMP("RORX008",$J,"DRG",IEN,CLINAIDS))+1 ;naked reference: ^TMP("RORX008",$J,"DRG",IEN,CLINAIDS)
  1.  . . S CMPXCARE=1,CNTARV=CNTARV+1
  1.  . ;
  1.  . ;--- Skip Basic Care if it was not requested
  1.  . I CMPXCARE  S CNTCMPX=CNTCMPX+1
  1.  . E  Q:'$$PARAM^RORTSK01("PATIENTS","BASIC")  S CNTBASIC=CNTBASIC+1
  1.  . ;
  1.  . D:$$PARAM^RORTSK01("OPTIONS","PTLIST")
  1.  . . D VADEM^RORUTL05(PATIEN,1)
  1.  . . S TMP=$$DATE^RORXU002(VADM(6)\1)
  1.  . . S TMP=TMP_U_($D(RORXDST("ARV"))>0)_U_CMPXCARE_U_CLINAIDS
  1.  . . S ^TMP("RORX008",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP
  1.  . . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,6)=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
  1.  . . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,7)=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
  1.  . . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,8)=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
  1.  . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") D
  1.  . . . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
  1.  . . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,9)=AGE
  1.  ;
  1.  ;--- Totals
  1.  S ^TMP("RORX008",$J,"PAT")=CNTBASIC_U_CNTCMPX_U_CNTARV
  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 CA,IEN,NAME
  1.  S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
  1.  Q:(IEN'>0)!(NAME="") 1
  1.  ;---
  1.  S ROR8DST("ARV")=""  Q:ROR8DST("SINGLE") 2
  1.  ;---
  1.  S ROR8DST("ARV",IEN)=NAME
  1.  Q 0
  1.  ;
  1.  ;***** STORES THE REPORT DATA
  1.  ;
  1.  ; REPORT        IEN of the REPORT element
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. STORE(REPORT) ;
  1.  N BUF,CNT,ITEM,IEN,NODE,NPAIDS,NPHIV,RC,TABLE,TMP
  1.  S NODE=$NA(^TMP("RORX008",$J)),RC=0
  1.  ;
  1.  ;--- List of ARV drugs
  1.  S TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
  1.  I TMP,$$PARAM^RORTSK01("PATIENTS","COMPLEX")  D  Q:RC<0 RC
  1.  . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
  1.  . I TABLE<0  S RC=TABLE  Q
  1.  . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DRUGS")
  1.  . S IEN=0
  1.  . F  S IEN=$O(@NODE@("DRG",IEN))  Q:IEN'>0  D
  1.  . . S BUF=@NODE@("DRG",IEN)
  1.  . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(@NODE@("DRG",IEN),U),ITEM,1)
  1.  . . S NPHIV=+$G(@NODE@("DRG",IEN,0))
  1.  . . S NPAIDS=+$G(@NODE@("DRG",IEN,1))
  1.  . . D ADDVAL^RORTSK11(RORTSK,"NP",NPHIV+NPAIDS,ITEM,3)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"NPHIV",NPHIV,ITEM,3)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"NPAIDS",NPAIDS,ITEM,3)
  1.  ;
  1.  ;--- List of patients
  1.  I $$PARAM^RORTSK01("OPTIONS","PTLIST")  D  Q:RC<0 RC
  1.  . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
  1.  . I TABLE<0  S RC=TABLE  Q
  1.  . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
  1.  . S IEN=0
  1.  . F  S IEN=$O(@NODE@("PAT",IEN))  Q:IEN'>0  D
  1.  . . S BUF=@NODE@("PAT",IEN) S $P(BUF,U)="0000"
  1.  . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,IEN)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(BUF,U,2),ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
  1.  . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
  1.  . . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(BUF,U,9),ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"AIDSTAT",+$P(BUF,U,6),ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"ARV",+$P(BUF,U,4),ITEM,1)
  1.  . . D ADDVAL^RORTSK11(RORTSK,"COMPLEX",+$P(BUF,U,5),ITEM,1)
  1.  . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,6),ITEM,1)
  1.  . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,7),ITEM,1)
  1.  . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,8),ITEM,1)
  1.  ;
  1.  ;--- Summary
  1.  S BUF=@NODE@("PAT")
  1.  S ITEM=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
  1.  D ADDVAL^RORTSK11(RORTSK,"NP",$P(BUF,U)+$P(BUF,U,2),ITEM)
  1.  D ADDVAL^RORTSK11(RORTSK,"NPBASIC",+$P(BUF,U,1),ITEM)
  1.  D ADDVAL^RORTSK11(RORTSK,"NPCOMPLEX",+$P(BUF,U,2),ITEM)
  1.  D ADDVAL^RORTSK11(RORTSK,"NPARV",+$P(BUF,U,3),ITEM)
  1.  Q 0