RORXU001 ;HOIFO/BH,SG,VAC - REPORT UTILITIES ;4/23/09 1:21pm
;;1.5;CLINICAL CASE REGISTRIES;**8,13**;Feb 17, 2006;Build 27
;
; This routine uses the following IAs:
;
; #325 ADM^VADPT2 (controlled)
; #2056 GET1^DIQ, GETS^DIQ (supported)
; #10103 DT^XLFDT, FMADD^XLFDT
; #2548 APIs in routine SDQ: ACRP Interface Toolkit (supported)
; #417 .01 field and "C" x-ref of file #40.8 (controlled)
; #3545 ^DGPT("AAD" (private)
; #10061 IN5^VADPT (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*13 DEC 2010 A SAUNDERS Added tags CDUTIL and CDSCAN to check
; for encounters in selected Divisions or
; Clinics. Added tag CDPARMS to set
; Clnic and Division list parameters.
;
;******************************************************************************
;******************************************************************************
Q
;
;***** DOUBLE CHECKS THE ADMISSION
;
; DFN Patient IEN
; VAINDT Admission date
; .DISDT Discharge date
;
; Return Values:
; 0 Ok
; 1 Invalid admission date
;
CHKADM(DFN,VAINDT,DISDT) ;
N IEN,RORMSG,VADMVT,VAHOW,VAROOT
D ADM^VADPT2 Q:'VADMVT 1
S IEN=+$$GET1^DIQ(405,VADMVT,.17,"I",,"RORMSG")
S:IEN>0 DISDT=$$GET1^DIQ(405,IEN_",",.01,"I",,"RORMSG")
Q 0
;
;***** DATE OF THE MOST RECENT VISIT TO ANY OF THE SELECTED CLINICS
;
; PATIEN Patient IEN (file #2)
;
; .RORCLIN Reference to a local array of Clinics, the subscripts
; are IEN's from file #44 or will be a single element
; array with a subscript of "ALL", which will denote
; all clinics (i.e. CLIN("ALL")="").
;
; Return Values:
; 0 The patient has never been seen at any of the given
; clinics
; >0 Date of the most recent visit to one of the selected
; clinics
;
LASTVSIT(PATIEN,RORCLIN) ;
N QUERY,RORDT,RORLAST
S RORDT=$$FMADD^XLFDT($$DT^XLFDT,1),RORLAST=0
;---
D OPEN^SDQ(.QUERY)
D INDEX^SDQ(.QUERY,"PATIENT","SET")
D PAT^SDQ(.QUERY,PATIEN,"SET")
D SCANCB^SDQ(.QUERY,"D SDQSCAN2^RORXU001(Y,Y0)","SET")
D ACTIVE^SDQ(.QUERY,"TRUE","SET")
D SCAN^SDQ(.QUERY,"FORWARD")
D CLOSE^SDQ(.QUERY)
;---
Q RORLAST
;
;***** LOADS PTF DATA AND CHECKS IF THE RECORD SHOULD BE SKIPPED
;
; PTFIEN IEN of the PTF record
;
; [FLAGS] Flags to control processing
; F Skip fee-basis records - This flag commented
; out April 2009
; P Skip non-PTF records
;
; [.ADMDT] Admission date is returned via this parameter
; [.DISDT] Discharge date is returned via this parameter
; [.SUFFIX] Suffix is returned via this parameter
; [.STATUS] Status is returned via this parameter
; [.FACILITY] Facility number is returned via this parameter
;
; Return Values:
; <0 Error code
; 0 Ok
; 1 Skip this record
;
PTF(PTFIEN,FLAGS,ADMDT,DISDT,SUFFIX,STATUS,FACILITY) ;
N FLDLST,IENS,RORBUF,RORMSG
S FLAGS=$G(FLAGS),IENS=(+PTFIEN)_","
S FLDLST="2;3;5;6;70"
;S:FLAGS["F" FLDLST=FLDLST_";4" ; FEE BASIS- commented out
S:FLAGS["P" FLDLST=FLDLST_";11" ; TYPE OF RECORD
;--- Load the data
K RORMSG D GETS^DIQ(45,IENS,FLDLST,"I","RORBUF","RORMSG")
;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,45,IENS)
Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,45,IENS)
;---
S ADMDT=$G(RORBUF(45,IENS,2,"I")) ; ADMISSION DATE
S FACILITY=$G(RORBUF(45,IENS,3,"I")) ; FACILITY
S SUFFIX=$G(RORBUF(45,IENS,5,"I")) ; SUFFIX
S STATUS=$G(RORBUF(45,IENS,6,"I")) ; STATUS
S DISDT=$G(RORBUF(45,IENS,70,"I")) ; DISCHARGE DATE
Q:ADMDT'>0 1
;--- Skip a non-PTF record
I FLAGS["P" Q:$G(RORBUF(45,IENS,11,"I"))'=1 1
;--- Skip a fee basis record
I FLAGS["F" Q:$G(RORBUF(45,IENS,4,"I")) 1
;--- Success
Q 0
;
;**** CALL-BACK ENTRY POINTS FOR THE SDQ API
SDQSCAN1(Y,Y0) ;
N TMP
;--- Check the clinic
I '$$PARAM^RORTSK01("CLINICS","ALL") D Q:'TMP
. S TMP=$D(RORTSK("PARAMS","CLINICS","C",+$P(Y0,U,4)))
;--- Count the encounters
S RORENCNT=RORENCNT+1
Q
;
SDQSCAN2(Y,Y0) ;
N DTX,TMP
;--- Check the clinic
I '$$PARAM^RORTSK01("CLINICS","ALL") D Q:'TMP
. S TMP=$D(RORTSK("PARAMS","CLINICS","C",+$P(Y0,U,4)))
;--- Date of the visit
S DTX=+$P(Y0,U) S:(DTX>RORLAST)&(DTX<RORDT) RORLAST=DTX
Q
;
;***** CHECKS IF THE PATIENT WAS SEEN AT SELECTED CLINICS
;
; RORSDT Start Date for search (FileMan).
; Time is ignored and the beginning of the day is
; considered as the boundary (ST\1).
;
; ROREDT End Date for search (FileMan).
; Time is ignored and the end of the day is
; considered as the boundary (ED\1+1).
;
; PATIEN Patient IEN (file #2)
;
; Return Values:
; 0 The patient was not seen at any of the given clinics
; during the provided time frame
; 1 The patient was seen
;
SEEN(RORSDT,ROREDT,PATIEN) ;
N QUERY,RORENCNT
S RORENCNT=0
;---
D OPEN^SDQ(.QUERY)
D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
D PAT^SDQ(.QUERY,PATIEN,"SET")
D DATE^SDQ(.QUERY,RORSDT\1,$$FMADD^XLFDT(ROREDT\1,1),"SET")
D SCANCB^SDQ(.QUERY,"D SDQSCAN1^RORXU001(Y,Y0)","SET")
D ACTIVE^SDQ(.QUERY,"TRUE","SET")
D SCAN^SDQ(.QUERY,"FORWARD")
D CLOSE^SDQ(.QUERY)
;---
Q (RORENCNT>0)
;
;***** SET UP CLINIC/DIVISION LIST PARAMETERS
;
;Input
; RORTSK Report parameters
; OVERRIDE Optional. If '1', send back dates in DATE_RANGE_3 instead of
; dates in DATE_RANGE.
;
;Output
; 1 if clinic or division list exists, else 0
; START - Date in RORTSK("PARAMS","DATE_RANGE","A","START")
; END - Date in RORTSK("PARAMS","DATE_RANGE","A","END")
;
CDPARMS(RORTSK,START,END,OVERRIDE) ;
N FLAG S FLAG=0
I $D(RORTSK("PARAMS","CLINICS","C")) S FLAG=1
I $D(RORTSK("PARAMS","DIVISIONS","C")) S FLAG=1
I FLAG D
. I $G(OVERRIDE)=1 D
.. S START=$G(RORTSK("PARAMS","DATE_RANGE_3","A","START"))
.. S END=$G(RORTSK("PARAMS","DATE_RANGE_3","A","END"))
. E D
.. S START=$G(RORTSK("PARAMS","DATE_RANGE","A","START"))
.. S END=$G(RORTSK("PARAMS","DATE_RANGE","A","END"))
Q FLAG
;
;***** EVALUATE CLINIC OR DIVISION UTILIZATION
;Will determine if the patient had any utilization in any of the
;clinics or division in the list.
;
;Input
; RORTSK Report parameters with clinic or division list
; DFN Patient DFN from file #2
; RORSDT Start date for search
; ROREDT End date for search
;
;Return Values:
; MATCH Flag to indicate whether the patient should be on the report:
;
; 1 The patient should appear on the report because at least 1 of
; the following is true:
; -- all clinics or divisions are selected
; -- the patient has an outpatient encounter in at least 1 of the
; clinics on the clinic list
; -- the patient has an outpatient encounter in at least 1 of the
; divisions on the division list
; -- the patient has an inpatient 'movement' in at least 1 of the
; divisions on the division list
;
; 0 Parameter error or the patient should not appear on the report
;
CDUTIL(RORTSK,DFN,RORSDT,ROREDT) ;
Q:'DFN 0
Q:'RORSDT 0
Q:'ROREDT 0
N TYPE ;type of list = CLINICS or DIVISIONS
N MATCH ;flag to indicate whether to keep or skip the patient
N PIECE ;clinic or division piece number on the encounter node
S (TYPE,MATCH,PIECE)=0
;
;---Set Clinic and Division variables
I $D(RORTSK("PARAMS","CLINICS","C")) S TYPE="CLINICS",PIECE=4 ;clinic
I $D(RORTSK("PARAMS","DIVISIONS","C")) S TYPE="DIVISIONS",PIECE=11 ;division
;
Q:(TYPE=0) 1 ;quit if ALL divisions and clinics are requested
;
;if division list, check for inpatient utilization
I TYPE="DIVISIONS" D INPAT(DFN,RORSDT,ROREDT,.MATCH)
;
;if no utilization found yet, check outpatient encounters
I 'MATCH D OUTPAT(DFN,RORSDT,ROREDT,TYPE,PIECE,.MATCH)
;
Q MATCH
;
;***** CHECK FOR INPATIENT UTILIZATION IN DIVISION(S).
;
;Input
; DFN Patient DFN from file #2
; RORSDT Start date for search
; ROREDT End date for search
; MATCH Flag for output
;
;Output
; MATCH=1 Inpatient utilization found in selected division(s)
; MATCH=0 No inpatient utilization found in selected division(s)
;
INPAT(DFN,RORSDT,ROREDT,MATCH) ; get inpatient data
N ADMDATE,STOP,MVDATE,RC,PTFIEN,TMP,DIVIEN,RC
S STOP=0,RC=0
S ADMDATE=RORSDT
S ROREDT=ROREDT_".235959"
;beginning with the 'start' date, first see if the patient was already an
;inpatient at that time. Then loop through admission dates in ^DGPT.
F Q:STOP D S ADMDATE=$O(^DGPT("AAD",DFN,ADMDATE)) Q:ADMDATE'>0
. I ADMDATE>ROREDT S STOP=1 Q
. K MVDATE,VAIP S VAIP(16,1)=ADMDATE
. F Q:STOP D Q:RC
.. S VAIP("D")=+$G(VAIP(16,1))
.. I VAIP("D")'>0 S RC=1 Q
.. D IN5^VADPT
.. S MVDATE=+$G(VAIP(3)) ;movement date (internal format)
.. Q:+$G(VAIP(4))=3 ;quit if type of movement is OPT-SC
.. ;--- Check if movement date is after end date
.. I $G(MVDATE)>ROREDT Q
.. ;--- Check the PTF record
.. S PTFIEN=+$G(VAIP(12)) Q:PTFIEN'>0
.. ;skip non-ptf records and fee-basis records
.. N SUFFIX,FACILITY
.. Q:$$PTF^RORXU001(PTFIEN,"FP",,,.SUFFIX,,.FACILITY)
.. ;--- Check the division
.. S TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")
.. I 'TMP D
... S TMP=FACILITY_SUFFIX
... S DIVIEN=$S(TMP'="":+$O(^DG(40.8,"C",TMP,"")),1:0)
... I $D(RORTSK("PARAMS","DIVISIONS","C",DIVIEN)) S MATCH=1,STOP=1
Q
;
;***** CHECK FOR OUTPATIENT UTILIZATION IN CLINIC/DIVISION(S).
;
;Input
; DFN Patient DFN from file #2
; RORSDT Start date for search
; ROREDT End date for search
; MATCH Flag for output
;
;Output
; MATCH=1 Outpatient utilization found
; MATCH=0 No outpatient utilization found
;
OUTPAT(DFN,RORSDT,ROREDT,TYPE,PIECE,MATCH) ; get outpatient encounter data
K SDQDATA,SDQUERY N QUERY
D OPEN^SDQ(.QUERY)
I '$$ERRCHK^SDQUT() D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
I '$$ERRCHK^SDQUT() D PAT^SDQ(.QUERY,DFN,"SET")
I '$$ERRCHK^SDQUT() D DATE^SDQ(.QUERY,RORSDT,$$FMADD^XLFDT(ROREDT,1),"SET")
I '$$ERRCHK^SDQUT() D SCANCB^SDQ(.QUERY,"I 'MATCH D CDSCAN^RORXU001(Y0,.MATCH,.TYPE,.PIECE,.RORTSK)","SET")
I '$$ERRCHK^SDQUT() D ACTIVE^SDQ(.QUERY,"TRUE","SET")
I '$$ERRCHK^SDQUT() D SCAN^SDQ(.QUERY,"FORWARD")
D CLOSE^SDQ(.QUERY)
;---
K SDQDATA,SDQUERY,SDCNT
Q
;
;***** SDQ CALLBACK - EXECUTED FOR EACH ENCOUNTER RETURNED IN CDLIST.
; LOOKING FOR MATCH ON CLINIC OR DIVISION.
;Input
; Y0 Encounter information returned from SCAN^SDQ
; 4th piece = clinic IEN
; 11th piece = division IEN
;
; MATCH Comes in set to 0
; TYPE CLINICS or DIVISIONS
; PIECE Piece# of encounter data of interest (clinic or division)
; RORTSK Report parameters
;
;Output
; MATCH=1 Encounter meets utilization requirement
; MATCH=0 Encounter does not meet utilization requirement
;
CDSCAN(Y0,MATCH,TYPE,PIECE,RORTSK) ; get clinic/division from encounter
;--- Check the list
I $D(RORTSK("PARAMS",TYPE,"C",+$P(Y0,U,PIECE))) S MATCH=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU001 11904 printed Dec 13, 2024@01:45:04 Page 2
RORXU001 ;HOIFO/BH,SG,VAC - REPORT UTILITIES ;4/23/09 1:21pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,13**;Feb 17, 2006;Build 27
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #325 ADM^VADPT2 (controlled)
+6 ; #2056 GET1^DIQ, GETS^DIQ (supported)
+7 ; #10103 DT^XLFDT, FMADD^XLFDT
+8 ; #2548 APIs in routine SDQ: ACRP Interface Toolkit (supported)
+9 ; #417 .01 field and "C" x-ref of file #40.8 (controlled)
+10 ; #3545 ^DGPT("AAD" (private)
+11 ; #10061 IN5^VADPT (supported)
+12 ;
+13 ;******************************************************************************
+14 ;******************************************************************************
+15 ; --- ROUTINE MODIFICATION LOG ---
+16 ;
+17 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+18 ;----------- ---------- ----------- ----------------------------------------
+19 ;ROR*1.5*13 DEC 2010 A SAUNDERS Added tags CDUTIL and CDSCAN to check
+20 ; for encounters in selected Divisions or
+21 ; Clinics. Added tag CDPARMS to set
+22 ; Clnic and Division list parameters.
+23 ;
+24 ;******************************************************************************
+25 ;******************************************************************************
+26 QUIT
+27 ;
+28 ;***** DOUBLE CHECKS THE ADMISSION
+29 ;
+30 ; DFN Patient IEN
+31 ; VAINDT Admission date
+32 ; .DISDT Discharge date
+33 ;
+34 ; Return Values:
+35 ; 0 Ok
+36 ; 1 Invalid admission date
+37 ;
CHKADM(DFN,VAINDT,DISDT) ;
+1 NEW IEN,RORMSG,VADMVT,VAHOW,VAROOT
+2 DO ADM^VADPT2
if 'VADMVT
QUIT 1
+3 SET IEN=+$$GET1^DIQ(405,VADMVT,.17,"I",,"RORMSG")
+4 if IEN>0
SET DISDT=$$GET1^DIQ(405,IEN_",",.01,"I",,"RORMSG")
+5 QUIT 0
+6 ;
+7 ;***** DATE OF THE MOST RECENT VISIT TO ANY OF THE SELECTED CLINICS
+8 ;
+9 ; PATIEN Patient IEN (file #2)
+10 ;
+11 ; .RORCLIN Reference to a local array of Clinics, the subscripts
+12 ; are IEN's from file #44 or will be a single element
+13 ; array with a subscript of "ALL", which will denote
+14 ; all clinics (i.e. CLIN("ALL")="").
+15 ;
+16 ; Return Values:
+17 ; 0 The patient has never been seen at any of the given
+18 ; clinics
+19 ; >0 Date of the most recent visit to one of the selected
+20 ; clinics
+21 ;
LASTVSIT(PATIEN,RORCLIN) ;
+1 NEW QUERY,RORDT,RORLAST
+2 SET RORDT=$$FMADD^XLFDT($$DT^XLFDT,1)
SET RORLAST=0
+3 ;---
+4 DO OPEN^SDQ(.QUERY)
+5 DO INDEX^SDQ(.QUERY,"PATIENT","SET")
+6 DO PAT^SDQ(.QUERY,PATIEN,"SET")
+7 DO SCANCB^SDQ(.QUERY,"D SDQSCAN2^RORXU001(Y,Y0)","SET")
+8 DO ACTIVE^SDQ(.QUERY,"TRUE","SET")
+9 DO SCAN^SDQ(.QUERY,"FORWARD")
+10 DO CLOSE^SDQ(.QUERY)
+11 ;---
+12 QUIT RORLAST
+13 ;
+14 ;***** LOADS PTF DATA AND CHECKS IF THE RECORD SHOULD BE SKIPPED
+15 ;
+16 ; PTFIEN IEN of the PTF record
+17 ;
+18 ; [FLAGS] Flags to control processing
+19 ; F Skip fee-basis records - This flag commented
+20 ; out April 2009
+21 ; P Skip non-PTF records
+22 ;
+23 ; [.ADMDT] Admission date is returned via this parameter
+24 ; [.DISDT] Discharge date is returned via this parameter
+25 ; [.SUFFIX] Suffix is returned via this parameter
+26 ; [.STATUS] Status is returned via this parameter
+27 ; [.FACILITY] Facility number is returned via this parameter
+28 ;
+29 ; Return Values:
+30 ; <0 Error code
+31 ; 0 Ok
+32 ; 1 Skip this record
+33 ;
PTF(PTFIEN,FLAGS,ADMDT,DISDT,SUFFIX,STATUS,FACILITY) ;
+1 NEW FLDLST,IENS,RORBUF,RORMSG
+2 SET FLAGS=$GET(FLAGS)
SET IENS=(+PTFIEN)_","
+3 SET FLDLST="2;3;5;6;70"
+4 ;S:FLAGS["F" FLDLST=FLDLST_";4" ; FEE BASIS- commented out
+5 ; TYPE OF RECORD
if FLAGS["P"
SET FLDLST=FLDLST_";11"
+6 ;--- Load the data
+7 KILL RORMSG
DO GETS^DIQ(45,IENS,FLDLST,"I","RORBUF","RORMSG")
+8 ;Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,45,IENS)
+9 if $GET(RORMSG("DIERR"))
QUIT $$DBS^RORERR("RORMSG",-9,,,45,IENS)
+10 ;---
+11 ; ADMISSION DATE
SET ADMDT=$GET(RORBUF(45,IENS,2,"I"))
+12 ; FACILITY
SET FACILITY=$GET(RORBUF(45,IENS,3,"I"))
+13 ; SUFFIX
SET SUFFIX=$GET(RORBUF(45,IENS,5,"I"))
+14 ; STATUS
SET STATUS=$GET(RORBUF(45,IENS,6,"I"))
+15 ; DISCHARGE DATE
SET DISDT=$GET(RORBUF(45,IENS,70,"I"))
+16 if ADMDT'>0
QUIT 1
+17 ;--- Skip a non-PTF record
+18 IF FLAGS["P"
if $GET(RORBUF(45,IENS,11,"I"))'=1
QUIT 1
+19 ;--- Skip a fee basis record
+20 IF FLAGS["F"
if $GET(RORBUF(45,IENS,4,"I"))
QUIT 1
+21 ;--- Success
+22 QUIT 0
+23 ;
+24 ;**** CALL-BACK ENTRY POINTS FOR THE SDQ API
SDQSCAN1(Y,Y0) ;
+1 NEW TMP
+2 ;--- Check the clinic
+3 IF '$$PARAM^RORTSK01("CLINICS","ALL")
Begin DoDot:1
+4 SET TMP=$DATA(RORTSK("PARAMS","CLINICS","C",+$PIECE(Y0,U,4)))
End DoDot:1
if 'TMP
QUIT
+5 ;--- Count the encounters
+6 SET RORENCNT=RORENCNT+1
+7 QUIT
+8 ;
SDQSCAN2(Y,Y0) ;
+1 NEW DTX,TMP
+2 ;--- Check the clinic
+3 IF '$$PARAM^RORTSK01("CLINICS","ALL")
Begin DoDot:1
+4 SET TMP=$DATA(RORTSK("PARAMS","CLINICS","C",+$PIECE(Y0,U,4)))
End DoDot:1
if 'TMP
QUIT
+5 ;--- Date of the visit
+6 SET DTX=+$PIECE(Y0,U)
if (DTX>RORLAST)&(DTX<RORDT)
SET RORLAST=DTX
+7 QUIT
+8 ;
+9 ;***** CHECKS IF THE PATIENT WAS SEEN AT SELECTED CLINICS
+10 ;
+11 ; RORSDT Start Date for search (FileMan).
+12 ; Time is ignored and the beginning of the day is
+13 ; considered as the boundary (ST\1).
+14 ;
+15 ; ROREDT End Date for search (FileMan).
+16 ; Time is ignored and the end of the day is
+17 ; considered as the boundary (ED\1+1).
+18 ;
+19 ; PATIEN Patient IEN (file #2)
+20 ;
+21 ; Return Values:
+22 ; 0 The patient was not seen at any of the given clinics
+23 ; during the provided time frame
+24 ; 1 The patient was seen
+25 ;
SEEN(RORSDT,ROREDT,PATIEN) ;
+1 NEW QUERY,RORENCNT
+2 SET RORENCNT=0
+3 ;---
+4 DO OPEN^SDQ(.QUERY)
+5 DO INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
+6 DO PAT^SDQ(.QUERY,PATIEN,"SET")
+7 DO DATE^SDQ(.QUERY,RORSDT\1,$$FMADD^XLFDT(ROREDT\1,1),"SET")
+8 DO SCANCB^SDQ(.QUERY,"D SDQSCAN1^RORXU001(Y,Y0)","SET")
+9 DO ACTIVE^SDQ(.QUERY,"TRUE","SET")
+10 DO SCAN^SDQ(.QUERY,"FORWARD")
+11 DO CLOSE^SDQ(.QUERY)
+12 ;---
+13 QUIT (RORENCNT>0)
+14 ;
+15 ;***** SET UP CLINIC/DIVISION LIST PARAMETERS
+16 ;
+17 ;Input
+18 ; RORTSK Report parameters
+19 ; OVERRIDE Optional. If '1', send back dates in DATE_RANGE_3 instead of
+20 ; dates in DATE_RANGE.
+21 ;
+22 ;Output
+23 ; 1 if clinic or division list exists, else 0
+24 ; START - Date in RORTSK("PARAMS","DATE_RANGE","A","START")
+25 ; END - Date in RORTSK("PARAMS","DATE_RANGE","A","END")
+26 ;
CDPARMS(RORTSK,START,END,OVERRIDE) ;
+1 NEW FLAG
SET FLAG=0
+2 IF $DATA(RORTSK("PARAMS","CLINICS","C"))
SET FLAG=1
+3 IF $DATA(RORTSK("PARAMS","DIVISIONS","C"))
SET FLAG=1
+4 IF FLAG
Begin DoDot:1
+5 IF $GET(OVERRIDE)=1
Begin DoDot:2
+6 SET START=$GET(RORTSK("PARAMS","DATE_RANGE_3","A","START"))
+7 SET END=$GET(RORTSK("PARAMS","DATE_RANGE_3","A","END"))
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 SET START=$GET(RORTSK("PARAMS","DATE_RANGE","A","START"))
+10 SET END=$GET(RORTSK("PARAMS","DATE_RANGE","A","END"))
End DoDot:2
End DoDot:1
+11 QUIT FLAG
+12 ;
+13 ;***** EVALUATE CLINIC OR DIVISION UTILIZATION
+14 ;Will determine if the patient had any utilization in any of the
+15 ;clinics or division in the list.
+16 ;
+17 ;Input
+18 ; RORTSK Report parameters with clinic or division list
+19 ; DFN Patient DFN from file #2
+20 ; RORSDT Start date for search
+21 ; ROREDT End date for search
+22 ;
+23 ;Return Values:
+24 ; MATCH Flag to indicate whether the patient should be on the report:
+25 ;
+26 ; 1 The patient should appear on the report because at least 1 of
+27 ; the following is true:
+28 ; -- all clinics or divisions are selected
+29 ; -- the patient has an outpatient encounter in at least 1 of the
+30 ; clinics on the clinic list
+31 ; -- the patient has an outpatient encounter in at least 1 of the
+32 ; divisions on the division list
+33 ; -- the patient has an inpatient 'movement' in at least 1 of the
+34 ; divisions on the division list
+35 ;
+36 ; 0 Parameter error or the patient should not appear on the report
+37 ;
CDUTIL(RORTSK,DFN,RORSDT,ROREDT) ;
+1 if 'DFN
QUIT 0
+2 if 'RORSDT
QUIT 0
+3 if 'ROREDT
QUIT 0
+4 ;type of list = CLINICS or DIVISIONS
NEW TYPE
+5 ;flag to indicate whether to keep or skip the patient
NEW MATCH
+6 ;clinic or division piece number on the encounter node
NEW PIECE
+7 SET (TYPE,MATCH,PIECE)=0
+8 ;
+9 ;---Set Clinic and Division variables
+10 ;clinic
IF $DATA(RORTSK("PARAMS","CLINICS","C"))
SET TYPE="CLINICS"
SET PIECE=4
+11 ;division
IF $DATA(RORTSK("PARAMS","DIVISIONS","C"))
SET TYPE="DIVISIONS"
SET PIECE=11
+12 ;
+13 ;quit if ALL divisions and clinics are requested
if (TYPE=0)
QUIT 1
+14 ;
+15 ;if division list, check for inpatient utilization
+16 IF TYPE="DIVISIONS"
DO INPAT(DFN,RORSDT,ROREDT,.MATCH)
+17 ;
+18 ;if no utilization found yet, check outpatient encounters
+19 IF 'MATCH
DO OUTPAT(DFN,RORSDT,ROREDT,TYPE,PIECE,.MATCH)
+20 ;
+21 QUIT MATCH
+22 ;
+23 ;***** CHECK FOR INPATIENT UTILIZATION IN DIVISION(S).
+24 ;
+25 ;Input
+26 ; DFN Patient DFN from file #2
+27 ; RORSDT Start date for search
+28 ; ROREDT End date for search
+29 ; MATCH Flag for output
+30 ;
+31 ;Output
+32 ; MATCH=1 Inpatient utilization found in selected division(s)
+33 ; MATCH=0 No inpatient utilization found in selected division(s)
+34 ;
INPAT(DFN,RORSDT,ROREDT,MATCH) ; get inpatient data
+1 NEW ADMDATE,STOP,MVDATE,RC,PTFIEN,TMP,DIVIEN,RC
+2 SET STOP=0
SET RC=0
+3 SET ADMDATE=RORSDT
+4 SET ROREDT=ROREDT_".235959"
+5 ;beginning with the 'start' date, first see if the patient was already an
+6 ;inpatient at that time. Then loop through admission dates in ^DGPT.
+7 FOR
if STOP
QUIT
Begin DoDot:1
+8 IF ADMDATE>ROREDT
SET STOP=1
QUIT
+9 KILL MVDATE,VAIP
SET VAIP(16,1)=ADMDATE
+10 FOR
if STOP
QUIT
Begin DoDot:2
+11 SET VAIP("D")=+$GET(VAIP(16,1))
+12 IF VAIP("D")'>0
SET RC=1
QUIT
+13 DO IN5^VADPT
+14 ;movement date (internal format)
SET MVDATE=+$GET(VAIP(3))
+15 ;quit if type of movement is OPT-SC
if +$GET(VAIP(4))=3
QUIT
+16 ;--- Check if movement date is after end date
+17 IF $GET(MVDATE)>ROREDT
QUIT
+18 ;--- Check the PTF record
+19 SET PTFIEN=+$GET(VAIP(12))
if PTFIEN'>0
QUIT
+20 ;skip non-ptf records and fee-basis records
+21 NEW SUFFIX,FACILITY
+22 if $$PTF^RORXU001(PTFIEN,"FP",,,.SUFFIX,,.FACILITY)
QUIT
+23 ;--- Check the division
+24 SET TMP=$$PARAM^RORTSK01("DIVISIONS","ALL")
+25 IF 'TMP
Begin DoDot:3
+26 SET TMP=FACILITY_SUFFIX
+27 SET DIVIEN=$SELECT(TMP'="":+$ORDER(^DG(40.8,"C",TMP,"")),1:0)
+28 IF $DATA(RORTSK("PARAMS","DIVISIONS","C",DIVIEN))
SET MATCH=1
SET STOP=1
End DoDot:3
End DoDot:2
if RC
QUIT
End DoDot:1
SET ADMDATE=$ORDER(^DGPT("AAD",DFN,ADMDATE))
if ADMDATE'>0
QUIT
+29 QUIT
+30 ;
+31 ;***** CHECK FOR OUTPATIENT UTILIZATION IN CLINIC/DIVISION(S).
+32 ;
+33 ;Input
+34 ; DFN Patient DFN from file #2
+35 ; RORSDT Start date for search
+36 ; ROREDT End date for search
+37 ; MATCH Flag for output
+38 ;
+39 ;Output
+40 ; MATCH=1 Outpatient utilization found
+41 ; MATCH=0 No outpatient utilization found
+42 ;
OUTPAT(DFN,RORSDT,ROREDT,TYPE,PIECE,MATCH) ; get outpatient encounter data
+1 KILL SDQDATA,SDQUERY
NEW QUERY
+2 DO OPEN^SDQ(.QUERY)
+3 IF '$$ERRCHK^SDQUT()
DO INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
+4 IF '$$ERRCHK^SDQUT()
DO PAT^SDQ(.QUERY,DFN,"SET")
+5 IF '$$ERRCHK^SDQUT()
DO DATE^SDQ(.QUERY,RORSDT,$$FMADD^XLFDT(ROREDT,1),"SET")
+6 IF '$$ERRCHK^SDQUT()
DO SCANCB^SDQ(.QUERY,"I 'MATCH D CDSCAN^RORXU001(Y0,.MATCH,.TYPE,.PIECE,.RORTSK)","SET")
+7 IF '$$ERRCHK^SDQUT()
DO ACTIVE^SDQ(.QUERY,"TRUE","SET")
+8 IF '$$ERRCHK^SDQUT()
DO SCAN^SDQ(.QUERY,"FORWARD")
+9 DO CLOSE^SDQ(.QUERY)
+10 ;---
+11 KILL SDQDATA,SDQUERY,SDCNT
+12 QUIT
+13 ;
+14 ;***** SDQ CALLBACK - EXECUTED FOR EACH ENCOUNTER RETURNED IN CDLIST.
+15 ; LOOKING FOR MATCH ON CLINIC OR DIVISION.
+16 ;Input
+17 ; Y0 Encounter information returned from SCAN^SDQ
+18 ; 4th piece = clinic IEN
+19 ; 11th piece = division IEN
+20 ;
+21 ; MATCH Comes in set to 0
+22 ; TYPE CLINICS or DIVISIONS
+23 ; PIECE Piece# of encounter data of interest (clinic or division)
+24 ; RORTSK Report parameters
+25 ;
+26 ;Output
+27 ; MATCH=1 Encounter meets utilization requirement
+28 ; MATCH=0 Encounter does not meet utilization requirement
+29 ;
CDSCAN(Y0,MATCH,TYPE,PIECE,RORTSK) ; get clinic/division from encounter
+1 ;--- Check the list
+2 IF $DATA(RORTSK("PARAMS",TYPE,"C",+$PIECE(Y0,U,PIECE)))
SET MATCH=1
+3 QUIT
