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

RORX015A.m

Go to the documentation of this file. 
  1. RORX015A ;HOIFO/SG,VAC - OUTPATIENT PROCEDURES (QUERY & SORT) ;4/7/09 2:10pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**1,8,13,19,21,25,31,34**;Feb 17, 2006;Build 45
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #1995         $$CODEN^ICPTCOD and $$CPT^ICPTCOD (supported)
  1.  ; #2055         ROOT^DILFD
  1.  ; #2056         GETS^DIQ
  1.  ; #2546         GETCPT^SDOE
  1.  ; #2548         Multiple APIs in SDQ routine (supported)
  1.  ; #10103        FMADD^XLFDT (supported)
  1.  ; #5747         $$CODEC^ICDEX, $$CODEN^ICDEX, $$VSTP^ICDEX (controlled)
  1.  ; #6130         PTFICD^DGPTFUT
  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 report column if
  1.  ;                                      additional identifier option selected
  1.  ;ROR*1.5*25   OCT 2014   T KOPP        Added PTF ICD-10 support for 25 diagnoses
  1.  ;ROR*1.5*31   MAY 2017   M FERRARESE    Adding PACT, PCP, and AGE/DOB as additional
  1.  ;                                       identifiers.
  1.  ;ROR*1.5*34   SEP 2018   F TRAXLER     Adding FUT_APPT and FUT_CLIN                                     
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ;
  1.  ;***** SEARCHES FOR INPATIENT PROCEDURES
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. INPAT(PTIEN) ;
  1.  N DATE,ERRCNT,IEN,IEN45,IENS,NODE,RC,RORBUF,RORIBUF,RORMSG,XREF,FLD
  1.  S (ERRCNT,RC)=0
  1.  S XREF=$$ROOT^DILFD(45,,1),XREF=$NA(@XREF@("B",PTIEN))
  1.  S IEN45=0
  1.  F  S IEN45=$O(@XREF@(IEN45))  Q:IEN45'>0  D
  1.  . ;--- Surgical procedures
  1.  . S NODE=$$ROOT^DILFD(45.01,","_IEN45_",",1)
  1.  . S IEN=0
  1.  . F  S IEN=$O(@NODE@(IEN))  Q:IEN'>0  D
  1.  . . S IENS=IEN_","_IEN45_","  K RORBUF
  1.  . . ;--- Load the data
  1.  . . K RORMSG D GETS^DIQ(45.01,IENS,".01;","I","RORBUF","RORMSG")
  1.  . . I $G(RORMSG("DIERR"))  D  S ERRCNT=ERRCNT+1
  1.  . . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.01,IENS)
  1.  . . S DATE=$G(RORBUF(45.01,IENS,.01,"I"))
  1.  . . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
  1.  . . ;--- Generate the output
  1.  . . K RORIBUF
  1.  . . D PTFICD^DGPTFUT(401,IEN45,IEN,.RORIBUF)
  1.  . . S FLD="" F  S FLD=$O(RORIBUF(FLD)) Q:FLD=""  I $G(RORIBUF(FLD)) D
  1.  . . . D PROCSET(PTIEN,"I",+RORIBUF(FLD),DATE)
  1.  . ;--- Other procedures
  1.  . S NODE=$$ROOT^DILFD(45.05,","_IEN45_",",1)
  1.  . S IEN=0
  1.  . F  S IEN=$O(@NODE@(IEN))  Q:IEN'>0  D
  1.  . . S IENS=IEN_","_IEN45_","  K RORBUF
  1.  . . ;--- Load the data
  1.  . . K RORMSG D GETS^DIQ(45.05,IENS,".01","I","RORBUF","RORMSG")
  1.  . . I $G(RORMSG("DIERR"))  D  S ERRCNT=ERRCNT+1
  1.  . . . D DBS^RORERR("RORMSG",-99,,PTIEN,45.05,IENS)
  1.  . . S DATE=$G(RORBUF(45.05,IENS,.01,"I"))
  1.  . . Q:(DATE<RORSDT)!(DATE'<ROREDT1)
  1.  . . ;--- Generate the output
  1.  . . K RORIBUF
  1.  . . D PTFICD^DGPTFUT(601,IEN45,IEN,.RORIBUF)
  1.  . . S FLD="" F  S FLD=$O(RORIBUF(FLD)) Q:FLD=""  I $G(RORIBUF(FLD)) D
  1.  . . . D PROCSET(PTIEN,"I",+RORIBUF(FLD),DATE)
  1.  ;---
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** CALL-BACK PROCEDURE FOR THE OUTPATIENT SEARCH
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN)
  1.  ;
  1. OPSCAN(PTIEN) ;
  1.  N CPTIEN,DATE,IEN,RORCPT,VDATE
  1.  D GETCPT^SDOE(Y,"RORCPT")
  1.  Q:$G(RORCPT)'>0
  1.  S VDATE=+$P(Y0,U)
  1.  ;---
  1.  S IEN=0
  1.  F  S IEN=$O(RORCPT(IEN))  Q:IEN'>0  D
  1.  . S CPTIEN=+$P(RORCPT(IEN),U),DATE=+$P($G(RORCPT(IEN,12)),U)
  1.  . D:CPTIEN>0 PROCSET(PTIEN,"O",CPTIEN,$S(DATE>0:DATE,1:VDATE))
  1.  Q
  1.  ;
  1.  ;***** SEARCHES FOR OUTPATIENT PROCEDURES
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. OUTPAT(PTIEN) ;
  1.  N QUERY
  1.  D OPEN^SDQ(.QUERY)
  1.  D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
  1.  D PAT^SDQ(.QUERY,PTIEN,"SET")
  1.  D DATE^SDQ(.QUERY,RORSDT,ROREDT1,"SET")
  1.  D SCANCB^SDQ(.QUERY,"D OPSCAN^RORX015A("_PTIEN_")","SET")
  1.  D ACTIVE^SDQ(.QUERY,"TRUE","SET")
  1.  D SCAN^SDQ(.QUERY,"FORWARD")
  1.  D CLOSE^SDQ(.QUERY)
  1.  Q 0
  1.  ;
  1.  ;**** STORES THE PROCEDURE CODE
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN)
  1.  ; SOURCE        CPT source code ("O" or "I")
  1.  ; [IEN]         IEN of the procedure descriptor (file #81 or #80.1)
  1.  ; DATE          Date when the code was entered
  1.  ; [CODE]        Procedure code (CPT or ICD-9)
  1.  ;
  1.  ; Either the IEN or the CODE parameter must be provided.
  1.  ;
  1. PROCSET(PTIEN,SOURCE,IEN,DATE,CODE) ;
  1.  Q:DATE'>0
  1.  N TMP
  1.  S IEN=+$G(IEN)
  1.  ;---
  1.  I IEN'>0  Q:$G(CODE)=""  D  Q:IEN'>0
  1.  . I SOURCE="O"  S IEN=+$$CODEN^ICPTCOD(CODE) Q
  1.  . I SOURCE="I"  S IEN=+$$CODEN^ICDEX(CODE,80.1) Q
  1.  ;---
  1.  I SOURCE="O",'$$PARAM^RORTSK01("CPTLST","ALL")  D  Q:'TMP
  1.  . S TMP=$D(RORTSK("PARAMS","CPTLST","C",IEN))
  1.  I SOURCE="I"  Q:$$ICDGRCHK^RORXU008(.RORPTGRP,IEN,RORICDL)
  1.  ;---
  1.  S TMP=+$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN))
  1.  S:'TMP!(DATE<TMP) @RORTMP@("PAT",PTIEN,SOURCE,IEN)=DATE
  1.  S ^("C")=$G(@RORTMP@("PAT",PTIEN,SOURCE,IEN,"C"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX015
  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 ROREDT1       ; Day after the end date
  1.  N RORPTGRP      ; Temporary list of ICD groups
  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 CNT,ECNT,IEN,IENS,MODE,PTIEN,RC,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTSDT,XREFNODE
  1.  N RCC,FLAG,UTIL
  1.  S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
  1.  S ROREDT1=$$FMADD^XLFDT(ROREDT\1,1)
  1.  S (CNT,ECNT,RC)=0,SKIPEDT=ROREDT,SKIPSDT=RORSDT
  1.  S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") MODE("I")=1
  1.  S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") MODE("O")=1
  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.  ;=== 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 PTIEN=$$PTIEN^RORUTL01(IEN)  Q:PTIEN'>0
  1.  . ;--- Check for patient list and quit if not on list
  1.  . I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PTIEN)) Q
  1.  . ;--- Check if the patient should be skipped
  1.  . Q:$$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
  1.  . ;--- Check if patient has passed the ICD Filter
  1.  . S RCC=0
  1.  . I FLAG'="ALL" D
  1.  . . S RCC=$$ICD^RORXU010(PTIEN)
  1.  . I (FLAG="INCLUDE")&(RCC=0) Q
  1.  . I (FLAG="EXCLUDE")&(RCC=1) Q
  1.  . ;--- End of ICD check
  1.  . M RORPTGRP=RORIGRP("C")
  1.  . ;
  1.  . ;--- Check for Clinic or Division list and quit if not in list
  1.  . I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PTIEN,RORCDSTDT,RORCDENDT) Q
  1.  . ;
  1.  . ;--- Inpatient codes (ICD)
  1.  . I $G(MODE("I"))   D  I RC  Q:RC<0  S ECNT=ECNT+RC
  1.  . . S RC=$$INPAT(PTIEN)
  1.  . ;--- Outpatient codes (CPT)
  1.  . I $G(MODE("O"))  D  I RC  Q:RC<0  S ECNT=ECNT+RC
  1.  . . S RC=$$OUTPAT(PTIEN)
  1.  . ;
  1.  . ;--- If ICD codes from some groups have not been found,
  1.  . ;--- then do not consider inpatient procedures at all
  1.  . K:$D(RORPTGRP)>1 @RORTMP@("PAT",PTIEN,"I")
  1.  . ;---
  1.  . S SKIP=($D(@RORTMP@("PAT",PTIEN))<10)
  1.  . S:RORPROC<0 SKIP='SKIP
  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,PTIEN,.TMP)
  1.  . . S:'UTIL SKIP=1
  1.  . ;
  1.  . ;--- Skip the patient if not all search criteria have been met
  1.  . I SKIP  K @RORTMP@("PAT",PTIEN)  Q
  1.  . ;
  1.  . ;--- Calculate the patient's totals
  1.  . S RC=$$TOTALS(PTIEN)
  1.  . I RC  Q:RC<0  S ECNT=ECNT+RC
  1.  ;---
  1.  Q $S(RC<0:RC,1:ECNT)
  1.  ;
  1.  ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. SORT() ;
  1.  N IEN,SRC,TMP,TNC,TNDC
  1.  ;---
  1.  S (TNC,TNDC)=0
  1.  F SRC="I","O"  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(@RORTMP@("PROC",SRC,IEN))  Q:IEN'>0  D
  1.  . . S TMP=$P($G(@RORTMP@("PROC",SRC,IEN)),U,2)
  1.  . . S:TMP'="" @RORTMP@("PROC","B",TMP,SRC,IEN)=""
  1.  . . S TNC=TNC+$G(@RORTMP@("PROC",SRC,IEN,"C"))
  1.  . . S TNDC=TNDC+1
  1.  S @RORTMP@("PROC")=TNC_U_TNDC
  1.  ;---
  1.  Q 0
  1.  ;
  1.  ;***** CALCULATES INTERMEDIATE TOTALS
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Number of non-fatal errors
  1.  ;
  1. TOTALS(PTIEN) ;
  1.  N CNT,CODE,IEN,NAME,PNODE,RC,SRC,TMP,TMP1,TMP2,VA,VADM,AGE,AGETYPE,RORAPPT,RORAPPTINFO,RORCLIN
  1.  S PNODE=$NA(@RORTMP@("PAT",PTIEN))
  1.  ;--- Get and store the patient's data
  1.  D VADEM^RORUTL05(PTIEN,1)
  1.  S TMP=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PTIEN),1:"")
  1.  S TMP1=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PTIEN),1:"")
  1.  S TMP2=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PTIEN),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.  I $$PARAM^RORTSK01("OPTIONS","FUT_APPT") D  ;patch 34
  1.  . S RORAPPTINFO=$$FUTAPPT^RORUTL02(PTIEN,$$PARAM^RORTSK01("OPTIONS","FUT_APPT"))
  1.  . S RORAPPT=$P(RORAPPTINFO,U,1),RORCLIN=$P(RORAPPTINFO,U,2)
  1.  S @PNODE=VA("BID")_U_VADM(1)_U_$$DATE^RORXU002(VADM(6)\1)_U_TMP_U_TMP1_U_TMP2_U_AGE_U_$G(RORAPPT)_U_$G(RORCLIN)
  1.  S ^("PAT")=$G(@RORTMP@("PAT"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX015
  1.  ;
  1.  F SRC="I","O"  D
  1.  . S IEN=0
  1.  . F  S IEN=$O(@PNODE@(SRC,IEN))  Q:IEN'>0  D
  1.  . . S CODE=$P($G(@RORTMP@("PROC",SRC,IEN)),U),NAME=""
  1.  . . D:CODE=""
  1.  . . . I SRC="O"  D
  1.  . . . . S TMP=$$CPT^ICPTCOD(IEN)
  1.  . . . . S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,3)
  1.  . . . E  D
  1.  . . . . ;S TMP=$$ICDOP^ICDCODE(IEN)
  1.  . . . . ;S:TMP'<0 CODE=$P(TMP,U,2),NAME=$P(TMP,U,5)
  1.  . . . . S CODE=$$CODEC^ICDEX(80.1,IEN)
  1.  . . . . S NAME=$$VSTP^ICDEX(IEN)
  1.  . . . S:CODE="" CODE="UNKN"
  1.  . . . S:NAME="" NAME="Unknown ("_IEN_")"
  1.  . . . S @RORTMP@("PROC",SRC,IEN)=CODE_U_NAME
  1.  . . ;---
  1.  . . S CNT=+$G(@PNODE@(SRC,IEN,"C"))
  1.  . . S ^("C")=$G(@RORTMP@("PROC",SRC,IEN,"C"))+CNT ;naked reference: ^TMP($J,"RORTMP-n") from RORX015
  1.  . . S ^("P")=$G(@RORTMP@("PROC",SRC,IEN,"P"))+1 ;naked reference: ^TMP($J,"RORTMP-n") from RORX015
  1.  Q 0