RORX016A ;HOIFO/BH,SG,VAC - OUTPATIENT UTILIZATION (QUERY) ;4/7/09 2:10pm
;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,31,39**;Feb 17, 2006;Build 4
;
; This routine uses the following IAs:
;
; #557 Read access to the file #40.7 (controlled)
; #2548 APIs in routine SDQ: ACRP Interface Toolkit (supported)
; #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
;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System
;ROR*1.5*31 MAY 2017 S ALSAHHAR Adding AGE/DOB as additional identifiers.
;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
;******************************************************************************
;******************************************************************************
Q
;
;***** LOADS AND PROCESSES THE OUTPATIENT DATA
;
; RORDFN Patient IEN (in file #2)
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
OPDATA(RORDFN) ;
N QUERY,RORDST,RORECNT
S RORDST=$NA(^TMP("RORX016",$J))
D OPEN^SDQ(.QUERY)
D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
D PAT^SDQ(.QUERY,RORDFN,"SET")
D DATE^SDQ(.QUERY,RORSDT,ROREDT1,"SET")
D SCANCB^SDQ(.QUERY,"D SCAN^RORX016A(Y,Y0)","SET")
D ACTIVE^SDQ(.QUERY,"TRUE","SET")
D SCAN^SDQ(.QUERY,"FORWARD")
D CLOSE^SDQ(.QUERY)
Q +$G(RORECNT)
;
;***** QUERIES THE REGISTRY
;
; FLAGS Flags for the $$SKIP^RORXU005
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(FLAGS) ;
N ROREDT1 ; Day after the end date
N RORLAST4 ; Last 4 digits of the current patient's SSN
N RORPNAME ; Name of the current patient
N RORPTN ; Number of patients in the registry
;
N CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE,AGE,AGETYPE
N RCC,FLAG
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S ROREDT1=$$FMADD^XLFDT(ROREDT,1)
S (CNT,ECNT,RC)=0
;--- 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 the patient DFN
. S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
. ;--- Check for patient list and quit if not in 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,RORSDT,ROREDT)
. ;--- Check the patient against the ICD Filter
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(PATIEN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
. ;--- End of ICD Filter check
. ;
. ;--- Get the patient's data
. D VADEM^RORUTL05(PATIEN,1)
. S RORPNAME=VADM(1),(RORLAST4,VA("BID"))="0000" ;VA("BID")
. 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:"")
. ;
. ;--- Get the outpatient data
. S RC=$$OPDATA(PATIEN)
. I RC S ECNT=ECNT+1 Q:RC<0
. ;
. ;--- Calculate intermediate totals
. S RC=$$TOTALS^RORX016B(PATIEN,AGE)
. I RC S ECNT=ECNT+1 Q:RC<0
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** CALLBACK ENTRY POINT FOR ACRP API
SCAN(Y,Y0) ;
N DTX,STOP,TMP
;--- Check the division list
S TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")
I 'TMP Q:'$D(RORTSK("PARAMS","DIVISIONS","C",+$P(Y0,U,11)))
;--- Data comes from the OUTPATIENT ENCOUNTER file (409.68)
S STOP=$P($G(^DIC(40.7,+$P(Y0,U,3),0)),U,2),DTX=Y0\1
S:STOP="" STOP="NSC"
S @RORDST@("OP",RORDFN,DTX)=$G(@RORDST@("OP",RORDFN,DTX))+1
S @RORDST@("OP",RORDFN,DTX,STOP)=$G(@RORDST@("OP",RORDFN,DTX,STOP))+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX016A 4413 printed Apr 09, 2024@20:48:39 Page 2
RORX016A ;HOIFO/BH,SG,VAC - OUTPATIENT UTILIZATION (QUERY) ;4/7/09 2:10pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #557 Read access to the file #40.7 (controlled)
+6 ; #2548 APIs in routine SDQ: ACRP Interface Toolkit (supported)
+7 ; #10103 FMADD^XLFDT (supported)
+8 ;
+9 ;******************************************************************************
+10 ;******************************************************************************
+11 ; --- ROUTINE MODIFICATION LOG ---
+12 ;
+13 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+14 ;----------- ---------- ----------- ----------------------------------------
+15 ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
+16 ; 'include' or 'exclude'.
+17 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients
+18 ;ROR*1.5*19 FEB 2012 J SCOTT Support for ICD-10 Coding System
+19 ;ROR*1.5*31 MAY 2017 S ALSAHHAR Adding AGE/DOB as additional identifiers.
+20 ;ROR*1.5*39 JUN 2021 F TRAXLER Replace real SSN with zeroes.
+21 ;******************************************************************************
+22 ;******************************************************************************
+23 QUIT
+24 ;
+25 ;***** LOADS AND PROCESSES THE OUTPATIENT DATA
+26 ;
+27 ; RORDFN Patient IEN (in file #2)
+28 ;
+29 ; Return Values:
+30 ; <0 Error code
+31 ; 0 Ok
+32 ; >0 Number of non-fatal errors
+33 ;
OPDATA(RORDFN) ;
+1 NEW QUERY,RORDST,RORECNT
+2 SET RORDST=$NAME(^TMP("RORX016",$JOB))
+3 DO OPEN^SDQ(.QUERY)
+4 DO INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
+5 DO PAT^SDQ(.QUERY,RORDFN,"SET")
+6 DO DATE^SDQ(.QUERY,RORSDT,ROREDT1,"SET")
+7 DO SCANCB^SDQ(.QUERY,"D SCAN^RORX016A(Y,Y0)","SET")
+8 DO ACTIVE^SDQ(.QUERY,"TRUE","SET")
+9 DO SCAN^SDQ(.QUERY,"FORWARD")
+10 DO CLOSE^SDQ(.QUERY)
+11 QUIT +$GET(RORECNT)
+12 ;
+13 ;***** QUERIES THE REGISTRY
+14 ;
+15 ; FLAGS Flags for the $$SKIP^RORXU005
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; 0 Ok
+20 ; >0 Number of non-fatal errors
+21 ;
QUERY(FLAGS) ;
+1 ; Day after the end date
NEW ROREDT1
+2 ; Last 4 digits of the current patient's SSN
NEW RORLAST4
+3 ; Name of the current patient
NEW RORPNAME
+4 ; Number of patients in the registry
NEW RORPTN
+5 ;
+6 NEW CNT,ECNT,IEN,IENS,PATIEN,RC,TMP,VA,VADM,XREFNODE,AGE,AGETYPE
+7 NEW RCC,FLAG
+8 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+9 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+10 SET ROREDT1=$$FMADD^XLFDT(ROREDT,1)
+11 SET (CNT,ECNT,RC)=0
+12 ;--- Browse through the registry records
+13 SET IEN=0
+14 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+15 FOR
SET IEN=$ORDER(@XREFNODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+16 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+17 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+18 SET IENS=IEN_","
SET CNT=CNT+1
+19 ;--- Get the patient DFN
+20 SET PATIEN=$$PTIEN^RORUTL01(IEN)
if PATIEN'>0
QUIT
+21 ;--- Check for patient list and quit if not in list
+22 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
QUIT
+23 ;--- Check if the patient should be skipped
+24 if $$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
QUIT
+25 ;--- Check the patient against the ICD Filter
+26 SET RCC=0
+27 IF FLAG'="ALL"
Begin DoDot:2
+28 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+29 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+30 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+31 ;--- End of ICD Filter check
+32 ;
+33 ;--- Get the patient's data
+34 DO VADEM^RORUTL05(PATIEN,1)
+35 ;VA("BID")
SET RORPNAME=VADM(1)
SET (RORLAST4,VA("BID"))="0000"
+36 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+37 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
+38 ;
+39 ;--- Get the outpatient data
+40 SET RC=$$OPDATA(PATIEN)
+41 IF RC
SET ECNT=ECNT+1
if RC<0
QUIT
+42 ;
+43 ;--- Calculate intermediate totals
+44 SET RC=$$TOTALS^RORX016B(PATIEN,AGE)
+45 IF RC
SET ECNT=ECNT+1
if RC<0
QUIT
End DoDot:1
if RC<0
QUIT
+46 ;---
+47 QUIT $SELECT(RC<0:RC,1:ECNT)
+48 ;
+49 ;***** CALLBACK ENTRY POINT FOR ACRP API
SCAN(Y,Y0) ;
+1 NEW DTX,STOP,TMP
+2 ;--- Check the division list
+3 SET TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")
+4 IF 'TMP
if '$DATA(RORTSK("PARAMS","DIVISIONS","C",+$PIECE(Y0,U,11)))
QUIT
+5 ;--- Data comes from the OUTPATIENT ENCOUNTER file (409.68)
+6 SET STOP=$PIECE($GET(^DIC(40.7,+$PIECE(Y0,U,3),0)),U,2)
SET DTX=Y0\1
+7 if STOP=""
SET STOP="NSC"
+8 SET @RORDST@("OP",RORDFN,DTX)=$GET(@RORDST@("OP",RORDFN,DTX))+1
+9 SET @RORDST@("OP",RORDFN,DTX,STOP)=$GET(@RORDST@("OP",RORDFN,DTX,STOP))+1
+10 QUIT
