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

RORX014A.m

Go to the documentation of this file.
  1. RORX014A ;HOIFO/BH,SG,VAC - REGISTRY MEDS REPORT (QUERY & SORT) ;4/7/09 2:09pm
  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 J SCOTT 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. ;***** ADDS THE DRUG COMBINATION TO THE REPORT
  1. ;
  1. ; RXLST List of drug IEN's separated by commas
  1. ; PATIEN Patient IEN in file #2 (DFN)
  1. ;
  1. ADD(RXLST,PATIEN) ;
  1. N RXCIEN,RXCNDX,TMP,VA,VADM,VAERR
  1. S RXCNDX=$E(RXLST,1,100)
  1. ;--- Search for the combination
  1. S RXCIEN=""
  1. F D Q:RXCIEN="" Q:^TMP("RORX014",$J,"RXC",RXCIEN,1)=RXLST
  1. . S RXCIEN=$O(^TMP("RORX014",$J,"RXC","B",RXCNDX,RXCIEN))
  1. ;--- Add new combination
  1. D:RXCIEN'>0
  1. . S RXCIEN=$O(^TMP("RORX014",$J,"RXC"," "),-1)+1
  1. . S ^TMP("RORX014",$J,"RXC",RXCIEN,1)=RXLST
  1. . S ^TMP("RORX014",$J,"RXC","B",RXCNDX,RXCIEN)=""
  1. ;--- Add new patient
  1. S ^("P")=$G(^TMP("RORX014",$J,"RXC",RXCIEN,"P"))+1 ;naked reference: ^TMP("RORX014",$J,"RXC",RXCIEN,"P")
  1. D VADEM^RORUTL05(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 TMP=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)_U_$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
  1. S TMP=TMP_U_$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")_U_$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")_U_AGE
  1. S ^TMP("RORX014",$J,"RXC",RXCIEN,"P",PATIEN)=TMP
  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 RORXDST ; Descriptor for pharmacy search API
  1. ;
  1. N CNT,DRGIEN,ECNT,NAME,PATIEN,RC,RORIEN,RXFLAGS,STR,TMP,XREFNODE
  1. N RCC,FLAG
  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. S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
  1. S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
  1. S (CNT,ECNT,RC)=0
  1. ;
  1. ;--- Prepare parameters for the pharmacy search API
  1. S RORXDST=$NA(RORXDST("RORX014"))
  1. S RORXDST("RORCB")="$$RXSCB^RORX014A"
  1. S RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
  1. S RXFLAGS="E"
  1. S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") RXFLAGS=RXFLAGS_"IV"
  1. S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") RXFLAGS=RXFLAGS_"O"
  1. Q:RXFLAGS="E" 0
  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. . 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 the patient against the ICD Filter
  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 ICD check
  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. . ;--- Search for pharmacy data
  1. . S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
  1. . I TMP'>0 S:TMP<0 ECNT=ECNT+1 Q:$D(@RORXDST)<10
  1. . ;
  1. . S (NAME,STR)=""
  1. . F S NAME=$O(@RORXDST@(NAME)) Q:NAME="" D
  1. . . S DRGIEN=0
  1. . . F S DRGIEN=$O(@RORXDST@(NAME,DRGIEN)) Q:DRGIEN'>0 D
  1. . . . S ^TMP("RORX014",$J,"DRG",DRGIEN)=NAME
  1. . . . S STR=STR_","_DRGIEN
  1. . K @RORXDST
  1. . ;
  1. . D ADD($P(STR,",",2,999),PATIEN)
  1. ;
  1. ;---
  1. Q $S(RC<0:RC,1:ECNT)
  1. ;
  1. ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
  1. RXSCB(RORDST,ORDER,ORDFLG,DRUG,DATE) ;
  1. N IEN,NAME
  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. S @RORDST@(NAME,IEN)=""
  1. Q 0
  1. ;
  1. ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
  1. ;
  1. ; NRXC Number of drug combinations
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. SORT(NRXC) ;
  1. N IEN,TMP
  1. S (IEN,NRXC)=0
  1. F S IEN=$O(^TMP("RORX014",$J,"RXC",IEN)) Q:IEN'>0 D
  1. . S TMP=^TMP("RORX014",$J,"RXC",IEN,"P")
  1. . S ^TMP("RORX014",$J,"RXC","P",TMP,IEN)="",NRXC=NRXC+1
  1. Q 0
  1. ;
  1. ;***** STORES THE REPORT DATA
  1. ;
  1. ; REPORT IEN of the REPORT element
  1. ; NRXC Number of drug combinations
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Number of non-fatal errors
  1. ;
  1. STORE(REPORT,NRXC) ;
  1. N BUF,CNT,DRG,ITEM,NODE,PATIEN,RORI,RXCIEN,RXCNT,RXCOMB,SECTION,TABLE,VA,VADM,VAERR,AGETYPE,AGE
  1. S NODE=$NA(^TMP("RORX014",$J))
  1. S SECTION=$$ADDVAL^RORTSK11(RORTSK,"RXCOMBLST",,REPORT)
  1. Q:SECTION<0 SECTION
  1. D ADDATTR^RORTSK11(RORTSK,SECTION,"TABLE","RXCOMBLST")
  1. ;---
  1. Q:NRXC'>0 0
  1. ;---
  1. S RXCNT="",CNT=0,AGE=""
  1. F S RXCNT=$O(@NODE@("RXC","P",RXCNT),-1) Q:RXCNT="" D
  1. . S RC=$$LOOP^RORTSK01(CNT/NRXC),CNT=CNT+1 Q:RC<0
  1. . S RXCIEN=""
  1. . F S RXCIEN=$O(@NODE@("RXC","P",RXCNT,RXCIEN),-1) Q:RXCIEN="" D
  1. . . S RXCOMB=$$ADDVAL^RORTSK11(RORTSK,"RXCOMB",,SECTION)
  1. . . ;--- List of drugs
  1. . . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,RXCOMB)
  1. . . S BUF=@NODE@("RXC",RXCIEN,1)
  1. . . F RORI=1:1 S DRG=$P(BUF,",",RORI) Q:DRG="" D
  1. . . . S DRG=$P(^TMP("RORX014",$J,"DRG",DRG),U)
  1. . . . D ADDVAL^RORTSK11(RORTSK,"NAME",DRG,TABLE,1)
  1. . . ;--- Number of unique patients
  1. . . D ADDVAL^RORTSK11(RORTSK,"NP",RXCNT,RXCOMB,3)
  1. . . ;--- List of patients
  1. . . Q:'$$PARAM^RORTSK01("OPTIONS","COMPLETE")
  1. . . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,RXCOMB)
  1. . . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
  1. . . S PATIEN=""
  1. . . F S PATIEN=$O(@NODE@("RXC",RXCIEN,"P",PATIEN)) Q:PATIEN="" D
  1. . . . S BUF=@NODE@("RXC",RXCIEN,"P",PATIEN)
  1. . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,PATIEN)
  1. . . . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(BUF,U,2),ITEM,1)
  1. . . . S $P(BUF,U)="0000" D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
  1. . . . ;
  1. . . . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
  1. . . . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(BUF,U,7),ITEM,1)
  1. . . . ;
  1. . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
  1. . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,4),ITEM,1)
  1. . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,5),ITEM,1)
  1. . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,6),ITEM,1)
  1. Q 0