RORXU005 ;HCIOFO/SG - REPORT BUILDER UTILITIES ;5/25/11 11:48am
;;1.5;CLINICAL CASE REGISTRIES;**1,15,21,22,26,30,31,33**;Feb 17, 2006;Build 81
;
;******************************************************************************
;******************************************************************************
;
; --- ROUTINE MODIFICATION LOG ---
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*22 FEB 2014 T KOPP Added tag SKIPOEF to return the result
; if the period of service of patient
; matches OEF/OIF selection criteria.
;ROR*1.5*26 JAN 2015 T KOPP Added check for SVR match in report
;
;ROR*1.5*30 OCT 2016 M FERRARESE Changing the dispay for "Sex" to "Birth Sex"
; screen logic, flags S and V
;ROR*1.5*31 MAY 2017 S ALSAHHAR Adding logic for AGE/DOB identifier
;
;******************************************************************************
; This routine uses the following IAs:
;
; #10035 Direct read of the DOD field of the file #2
; #10061 DEM^VADPT (supported)
;
Q
;
;***** CALLBACK FUNCTION FOR DRUG SEARCH API
REIMBCB(RORDST,ORDER,FLAGS,DRUG,DATE) ;
S RORDST=1
Q 2
;
;***** RETURNS THE REIMBURSEMENT LEVEL FOR THE PATIENT
;
; RORIEN IEN of the patient's record in the registry
;
; ROR8DRGS Either closed root of the ARV drug list prepared by
; the $$DRUGLIST^RORUTL16 or the Registry IEN. In the
; latter case, the list will be compiled automatically.
;
; STDT Start date
; ENDT End date
;
; Return Values:
; <0 Error code
; 0 Neither Clinical AIDS nor ARV drugs
; 10 ARV drugs
; 20 Clinical AIDS
; 30 Both Clinical AIDS and ARV drugs
;
REIMBLVL(RORIEN,ROR8DRGS,STDT,ENDT) ;
N PATIEN,RC,RLVL,RORDST
S RLVL=0
;--- Clinical AIDS
S:$$CLINAIDS^RORHIVUT(+RORIEN,ENDT) RLVL=RLVL+20
;--- ARV Drugs
S PATIEN=$$PTIEN^RORUTL01(RORIEN)
S RORDST("RORCB")="$$REIMBCB^RORXU005"
S RC=$$RXSEARCH^RORUTL14(PATIEN,ROR8DRGS,.RORDST,"IOV",STDT,ENDT)
S:$G(RORDST)>0 RLVL=RLVL+10
;--- Reimbursement level
Q $S(RC<0:RC,1:RLVL)
;
;***** RETURNS THE PATIENT'S LIST OF RISK FACTORS
;
; RORIEN IEN of the patient's record in the registry
;
; Return Values:
; <0 Error code
; "" No risk factors have been found
; " ... " A string containing the risk factor numbers
; separated by commas and spaces
;
RISKS(RORIEN) ;
Q:'$D(^RORDATA(799.4,+RORIEN,0)) ""
N FLD,FLDLST,I,IENS,RISKLST,RORBUF,RORMSG,DIERR
S FLDLST="14.01;14.02;14.03;14.04;14.08;14.07;14.09;14.1;14.11;14.12;14.13;14.16;14.17"
;--- Load the risk fields
S IENS=(+RORIEN)_","
D GETS^DIQ(799.4,IENS,FLDLST,"I","RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR(799.4,-9,,,799.4,IENS)
;--- Process the data
S RISKLST=""
F I=1:1 S FLD=$P(FLDLST,";",I) Q:FLD="" D:FLD>0
. S:$G(RORBUF(799.4,IENS,FLD,"I"))=1 RISKLST=RISKLST_", "_I
Q $P(RISKLST,", ",2,999)
;
;***** DETERMINES IF THE PATIENT SHOULD NOT BE INCLUDED IN THE REPORT
;
; RORIEN IEN of the patient's record in the registry
;
; FLAGS Flags that control the execution (can be combined)
;
; C Skip confirmed patients
; G Skip pending patients
;
; D Skip deceased patients
; L Skip alive patients
;
; P Skip patients confirmed before the start date
; N Skip patients confirmed during the report
; time frame
; F Skip patients added after the end date
;
; H Skip patients without local HIV diagnosis
;
; M Skip male patients
; W Skip female patients
;
; O Process LOCAL_FIELDS
; R Process OTHER_REGISTRIES
;
; E Exclude patients with OEF/OIF period of service
; I Include only patients with OEF/OIF period of service
;
; S Include only patients with SVR
; V Include only patients with No SVR
;
; U Include only patients with FUTURE APPOINTMENTS ; PATCH 33
;
;
; [STDT] Start date of the report (FileMan).
; Time is ignored and the beginning of the day is
; considered as the boundary (STDT\1).
;
; If not defined or not greater than 0 then 0 is used.
;
; [ENDT] End date of the report (FileMan).
; Time is ignored and the end of the day is
; considered as the boundary (ENDT\1+1).
;
; If not defined or not greater than 0 then 9999999
; is used.
;
; Return Values:
; 0 Include the patient's data in the report
; 1 Skip the patient
;
SKIP(RORIEN,FLAGS,STDT,ENDT) ;
N DOD,IEN,MODE,NODE,PTIEN,REGIEN,BIRTHSEX,SKIP,STATUS,TMP,ARFLAG
S SKIP=0
;--- Always skip patients marked for deletion
Q:$$SKIPNA(RORIEN,FLAGS,.STATUS) 1
;---Include all registry patients if flags are not provided
Q:FLAGS="" 0
;
;--- Confirmed
I FLAGS["C" Q:STATUS'=4 1
;
;--- Alive/Deceased patients
S STDT=$S($G(STDT)>0:STDT\1,1:0)
I $TR(FLAGS,"LD")'=FLAGS D Q:$S(TMP:FLAGS["L",1:FLAGS["D") 1
. S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN)
. S DOD=+$P($G(^DPT(PTIEN,.35)),U)
. S TMP=$S(DOD>0:DOD'<STDT,1:1)
;
;--- Male/Female patients screen
I FLAGS["M"!(FLAGS["W") D Q:SKIP 1
. S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN) ;get dfn
. S SKIP=$$SKIPSEX(PTIEN,FLAGS)
;
;--- Age Range patients screen
S ARFLAG=$G(RORTSK("PARAMS","AGE_RANGE","A","TYPE"))
I $D(ARFLAG),ARFLAG'="ALL" D Q:SKIP 1
. S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN) ;get dfn
. S SKIP=$$SKIPAR(PTIEN,ARFLAG)
;
;--- OEF/OIF period of service patients screen
I FLAGS["E"!(FLAGS["I") D Q:SKIP 1
. S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN) ;get dfn
. S SKIP=$$SKIPOEF(PTIEN,FLAGS)
;
;--- SVR patients screen
I FLAGS["V"!(FLAGS["S") D Q:SKIP 1
. N REGIEN,RC,RORXL,RORLDST,RORXDST
. S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN) ;get dfn
. S REGIEN=$$GET1^DIQ(798,RORIEN_",",.02,"I")
. ;== Lab parameters
. S RORLDST("RORCB")="$$LTSCB^RORX023A"
. ;== Pharm parameters
. S RORXDST("GENERIC")=1 ;only meds with generic name
. S RORXDST("RORCB")="$$RXOCB^RORX023A" ;call back routine
. ;--- RX list of HepC registry drugs
. S RORXL=$$ALLOC^RORTMP()
. S RC=$$DRUGLIST^RORUTL16(RORXL,REGIEN)
. S RC=$$SVR^RORX023A(PTIEN,2000101,DT,REGIEN,RORXL,"",$$FMADD^XLFDT(DT,1),.RORLDST,.RORXDST)
. D POP^RORTMP(RORXL)
. I FLAGS["V" S SKIP=$S(RC=0:0,1:1) Q ; skip if SVR and not SVR requested
. I FLAGS["S" S SKIP=$S(RC=1:0,1:1) ; skip if not SVR and SVR requested
;
;--- Confirmed before/during/after the date range
S ENDT=$S($G(ENDT)>0:ENDT\1,1:9999999)+1
I $TR(FLAGS,"PNF")'=FLAGS D Q:TMP 1
. S TMP=+$$CONFDT^RORUTL18(RORIEN) ; Date Confirmed
. S TMP=$S(TMP<STDT:FLAGS["P",TMP>ENDT:FLAGS["F",1:FLAGS["N")
;
;--- Other registries
I FLAGS["R" D Q:SKIP 1
. S NODE=$NA(RORTSK("PARAMS","OTHER_REGISTRIES","C"))
. Q:$D(@NODE)<10
. S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN)
. S REGIEN=0
. F S REGIEN=$O(@NODE@(REGIEN)) Q:REGIEN'>0 D Q:SKIP
. . S MODE=+$G(@NODE@(REGIEN)) Q:'MODE
. . S IEN=$$PRRIEN^RORUTL01(PTIEN,REGIEN)
. . I IEN'>0 S SKIP=1
. . E S:$$SKIPNA(IEN,FLAGS) SKIP=1
. . S:MODE<0 SKIP='SKIP ; Exclude
;
;--- Local Fields
I FLAGS["O" D Q:SKIP 1
. S NODE=$NA(RORTSK("PARAMS","LOCAL_FIELDS","C"))
. Q:$D(@NODE)<10
. S IEN=0
. F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D Q:SKIP
. . S MODE=+$G(@NODE@(IEN)) Q:'MODE
. . S:'$D(^RORDATA(798,RORIEN,20,"B",IEN)) SKIP=1
. . S:MODE<0 SKIP='SKIP ; Exclude
;
;--- Local HIV Diagnosis
I FLAGS["H" D Q:SKIP 1
. N RORV
. S MODE=+RORTSK("PARAMS","HIV_DX") Q:'MODE
. S RORV=+$P($G(^RORDATA(799.4,RORIEN,12)),U,8)
. S:RORV'=1 SKIP=1
. S:MODE<0 SKIP='SKIP
;
;
;---Check for future appointments patch 33
I FLAGS["U" D Q:SKIP 1
.N RORDAYS
.S RORDAYS=$G(RORTSK("PARAMS","OPTIONS","A","FUT_APPT"))
.S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN) ;get dfn
.S SKIP=$$SKIPFUT(PTIEN,RORDAYS)
;
;--- Include in the report
Q 0
;
;***** CHECKS STATUS OF THE PATIENT'S REGISTRY RECORD (internal)
;
; IEN798 IEN of the patient's record in the registry
;
; FLAGS Flags that control the execution
;
; [.STATUS] Status code is returned via this parameter.
;
; Return Values:
; 0 Continue processing of the patient's data
; 1 Skip the patient
;
SKIPNA(IEN798,FLAGS,STATUS) ;
Q:$$ACTIVE^RORDD(IEN798,,.STATUS) 0 ; Active patient
Q:(STATUS=5)!(STATUS="") 1 ; Deleted patient
Q:(STATUS=4)&(FLAGS["G") 1 ; Pending patient
Q 0
;
;***** CHECKS IF BIRTHSEX OF PATIENT MATCHES BIRTHSEX SELECTED FOR REPORT
;
; DFN IEN of the patient's record in the patient file (#2)
;
; FLAGS Flags that control the execution
;
; Return Values:
; 0 Continue processing of the patient's data
; 1 Skip the patient
;
SKIPSEX(DFN,FLAGS) ;
N VADM,VAPTYP,VAHOW,BIRTHSEX
D DEM^VADPT
S BIRTHSEX=$P($G(VADM(5)),U)
Q $S(FLAGS["M":BIRTHSEX'="F",FLAGS["W":BIRTHSEX'="M",1:0)
;
;***** CHECKS IF PERIOD OF SERVICE OF PATIENT MATCHES OEF/OIF SELECTION FOR
; REPORT
;
; DFN IEN of the patient's record in the patient file (#2)
;
; FLAGS Flags that control the execution
;
; Return Values:
; 0 Continue processing of the patient's data
; 1 Skip the patient
;
SKIPOEF(DFN,FLAGS) ;
N VASV,QUIT
D SVC^VADPT
S QUIT=0
; Ignore if Only OEF/OIF selected and patient has no such POS
I FLAGS["I" S QUIT=$S($G(VASV(11))!($G(VASV(12)))!($G(VASV(13))):0,1:1)
; Ignore if Exclude OEF/OIF selected and patient has such POS
I 'QUIT,FLAGS["E" S QUIT=$S($G(VASV(11))!($G(VASV(12)))!($G(VASV(13))):1,1:0)
Q QUIT
;
;***** CHECKS IF AGE RANGE OF PATIENT MATCHES AGE RANGE SELECTED FOR REPORT
;
; DFN IEN of the patient's record in the patient file (#2)
;
; FLAGS Flags that control the execution
;
; Return Values:
; 0 Continue processing of the patient's data
; 1 Skip the patient
;
SKIPAR(DFN,ARFLAGS) ; skip Age Range
N VADM,VAPTYP,VAHOW,ARSTDT,ARENDT,PATAGE
I $G(ARFLAGS)="" Q 0
D DEM^VADPT
S ARSTDT=$G(RORTSK("PARAMS","AGE_RANGE","A","START"))
S ARENDT=$G(RORTSK("PARAMS","AGE_RANGE","A","END"))
I ARSTDT>ARENDT!(ARSTDT="")!(ARENDT="") Q 0
S PATAGE=$S(ARFLAGS["AGE":$P($G(VADM(4)),U),ARFLAGS["DOB":$P($G(VADM(3)),U),1:"")
I PATAGE>ARENDT!(PATAGE<ARSTDT) Q 1
Q 0
;
SKIPFUT(PTIEN,RORDAYS) ; SKIP if no future appointment PATCH 33
I '$$FUTAPPT^RORUTL02(PTIEN,RORDAYS) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU005 11218 printed Dec 13, 2024@01:45:08 Page 2
RORXU005 ;HCIOFO/SG - REPORT BUILDER UTILITIES ;5/25/11 11:48am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,15,21,22,26,30,31,33**;Feb 17, 2006;Build 81
+2 ;
+3 ;******************************************************************************
+4 ;******************************************************************************
+5 ;
+6 ; --- ROUTINE MODIFICATION LOG ---
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- ---------- ----------- ----------------------------------------
+9 ;ROR*1.5*22 FEB 2014 T KOPP Added tag SKIPOEF to return the result
+10 ; if the period of service of patient
+11 ; matches OEF/OIF selection criteria.
+12 ;ROR*1.5*26 JAN 2015 T KOPP Added check for SVR match in report
+13 ;
+14 ;ROR*1.5*30 OCT 2016 M FERRARESE Changing the dispay for "Sex" to "Birth Sex"
+15 ; screen logic, flags S and V
+16 ;ROR*1.5*31 MAY 2017 S ALSAHHAR Adding logic for AGE/DOB identifier
+17 ;
+18 ;******************************************************************************
+19 ; This routine uses the following IAs:
+20 ;
+21 ; #10035 Direct read of the DOD field of the file #2
+22 ; #10061 DEM^VADPT (supported)
+23 ;
+24 QUIT
+25 ;
+26 ;***** CALLBACK FUNCTION FOR DRUG SEARCH API
REIMBCB(RORDST,ORDER,FLAGS,DRUG,DATE) ;
+1 SET RORDST=1
+2 QUIT 2
+3 ;
+4 ;***** RETURNS THE REIMBURSEMENT LEVEL FOR THE PATIENT
+5 ;
+6 ; RORIEN IEN of the patient's record in the registry
+7 ;
+8 ; ROR8DRGS Either closed root of the ARV drug list prepared by
+9 ; the $$DRUGLIST^RORUTL16 or the Registry IEN. In the
+10 ; latter case, the list will be compiled automatically.
+11 ;
+12 ; STDT Start date
+13 ; ENDT End date
+14 ;
+15 ; Return Values:
+16 ; <0 Error code
+17 ; 0 Neither Clinical AIDS nor ARV drugs
+18 ; 10 ARV drugs
+19 ; 20 Clinical AIDS
+20 ; 30 Both Clinical AIDS and ARV drugs
+21 ;
REIMBLVL(RORIEN,ROR8DRGS,STDT,ENDT) ;
+1 NEW PATIEN,RC,RLVL,RORDST
+2 SET RLVL=0
+3 ;--- Clinical AIDS
+4 if $$CLINAIDS^RORHIVUT(+RORIEN,ENDT)
SET RLVL=RLVL+20
+5 ;--- ARV Drugs
+6 SET PATIEN=$$PTIEN^RORUTL01(RORIEN)
+7 SET RORDST("RORCB")="$$REIMBCB^RORXU005"
+8 SET RC=$$RXSEARCH^RORUTL14(PATIEN,ROR8DRGS,.RORDST,"IOV",STDT,ENDT)
+9 if $GET(RORDST)>0
SET RLVL=RLVL+10
+10 ;--- Reimbursement level
+11 QUIT $SELECT(RC<0:RC,1:RLVL)
+12 ;
+13 ;***** RETURNS THE PATIENT'S LIST OF RISK FACTORS
+14 ;
+15 ; RORIEN IEN of the patient's record in the registry
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; "" No risk factors have been found
+20 ; " ... " A string containing the risk factor numbers
+21 ; separated by commas and spaces
+22 ;
RISKS(RORIEN) ;
+1 if '$DATA(^RORDATA(799.4,+RORIEN,0))
QUIT ""
+2 NEW FLD,FLDLST,I,IENS,RISKLST,RORBUF,RORMSG,DIERR
+3 SET FLDLST="14.01;14.02;14.03;14.04;14.08;14.07;14.09;14.1;14.11;14.12;14.13;14.16;14.17"
+4 ;--- Load the risk fields
+5 SET IENS=(+RORIEN)_","
+6 DO GETS^DIQ(799.4,IENS,FLDLST,"I","RORBUF","RORMSG")
+7 if $GET(DIERR)
QUIT $$DBS^RORERR(799.4,-9,,,799.4,IENS)
+8 ;--- Process the data
+9 SET RISKLST=""
+10 FOR I=1:1
SET FLD=$PIECE(FLDLST,";",I)
if FLD=""
QUIT
if FLD>0
Begin DoDot:1
+11 if $GET(RORBUF(799.4,IENS,FLD,"I"))=1
SET RISKLST=RISKLST_", "_I
End DoDot:1
+12 QUIT $PIECE(RISKLST,", ",2,999)
+13 ;
+14 ;***** DETERMINES IF THE PATIENT SHOULD NOT BE INCLUDED IN THE REPORT
+15 ;
+16 ; RORIEN IEN of the patient's record in the registry
+17 ;
+18 ; FLAGS Flags that control the execution (can be combined)
+19 ;
+20 ; C Skip confirmed patients
+21 ; G Skip pending patients
+22 ;
+23 ; D Skip deceased patients
+24 ; L Skip alive patients
+25 ;
+26 ; P Skip patients confirmed before the start date
+27 ; N Skip patients confirmed during the report
+28 ; time frame
+29 ; F Skip patients added after the end date
+30 ;
+31 ; H Skip patients without local HIV diagnosis
+32 ;
+33 ; M Skip male patients
+34 ; W Skip female patients
+35 ;
+36 ; O Process LOCAL_FIELDS
+37 ; R Process OTHER_REGISTRIES
+38 ;
+39 ; E Exclude patients with OEF/OIF period of service
+40 ; I Include only patients with OEF/OIF period of service
+41 ;
+42 ; S Include only patients with SVR
+43 ; V Include only patients with No SVR
+44 ;
+45 ; U Include only patients with FUTURE APPOINTMENTS ; PATCH 33
+46 ;
+47 ;
+48 ; [STDT] Start date of the report (FileMan).
+49 ; Time is ignored and the beginning of the day is
+50 ; considered as the boundary (STDT\1).
+51 ;
+52 ; If not defined or not greater than 0 then 0 is used.
+53 ;
+54 ; [ENDT] End date of the report (FileMan).
+55 ; Time is ignored and the end of the day is
+56 ; considered as the boundary (ENDT\1+1).
+57 ;
+58 ; If not defined or not greater than 0 then 9999999
+59 ; is used.
+60 ;
+61 ; Return Values:
+62 ; 0 Include the patient's data in the report
+63 ; 1 Skip the patient
+64 ;
SKIP(RORIEN,FLAGS,STDT,ENDT) ;
+1 NEW DOD,IEN,MODE,NODE,PTIEN,REGIEN,BIRTHSEX,SKIP,STATUS,TMP,ARFLAG
+2 SET SKIP=0
+3 ;--- Always skip patients marked for deletion
+4 if $$SKIPNA(RORIEN,FLAGS,.STATUS)
QUIT 1
+5 ;---Include all registry patients if flags are not provided
+6 if FLAGS=""
QUIT 0
+7 ;
+8 ;--- Confirmed
+9 IF FLAGS["C"
if STATUS'=4
QUIT 1
+10 ;
+11 ;--- Alive/Deceased patients
+12 SET STDT=$SELECT($GET(STDT)>0:STDT\1,1:0)
+13 IF $TRANSLATE(FLAGS,"LD")'=FLAGS
Begin DoDot:1
+14 if '$DATA(PTIEN)
SET PTIEN=+$$PTIEN^RORUTL01(RORIEN)
+15 SET DOD=+$PIECE($GET(^DPT(PTIEN,.35)),U)
+16 SET TMP=$SELECT(DOD>0:DOD'<STDT,1:1)
End DoDot:1
if $SELECT(TMP
QUIT 1
+17 ;
+18 ;--- Male/Female patients screen
+19 IF FLAGS["M"!(FLAGS["W")
Begin DoDot:1
+20 ;get dfn
if '$DATA(PTIEN)
SET PTIEN=+$$PTIEN^RORUTL01(RORIEN)
+21 SET SKIP=$$SKIPSEX(PTIEN,FLAGS)
End DoDot:1
if SKIP
QUIT 1
+22 ;
+23 ;--- Age Range patients screen
+24 SET ARFLAG=$GET(RORTSK("PARAMS","AGE_RANGE","A","TYPE"))
+25 IF $DATA(ARFLAG)
IF ARFLAG'="ALL"
Begin DoDot:1
+26 ;get dfn
if '$DATA(PTIEN)
SET PTIEN=+$$PTIEN^RORUTL01(RORIEN)
+27 SET SKIP=$$SKIPAR(PTIEN,ARFLAG)
End DoDot:1
if SKIP
QUIT 1
+28 ;
+29 ;--- OEF/OIF period of service patients screen
+30 IF FLAGS["E"!(FLAGS["I")
Begin DoDot:1
+31 ;get dfn
if '$DATA(PTIEN)
SET PTIEN=+$$PTIEN^RORUTL01(RORIEN)
+32 SET SKIP=$$SKIPOEF(PTIEN,FLAGS)
End DoDot:1
if SKIP
QUIT 1
+33 ;
+34 ;--- SVR patients screen
+35 IF FLAGS["V"!(FLAGS["S")
Begin DoDot:1
+36 NEW REGIEN,RC,RORXL,RORLDST,RORXDST
+37 ;get dfn
if '$DATA(PTIEN)
SET PTIEN=+$$PTIEN^RORUTL01(RORIEN)
+38 SET REGIEN=$$GET1^DIQ(798,RORIEN_",",.02,"I")
+39 ;== Lab parameters
+40 SET RORLDST("RORCB")="$$LTSCB^RORX023A"
+41 ;== Pharm parameters
+42 ;only meds with generic name
SET RORXDST("GENERIC")=1
+43 ;call back routine
SET RORXDST("RORCB")="$$RXOCB^RORX023A"
+44 ;--- RX list of HepC registry drugs
+45 SET RORXL=$$ALLOC^RORTMP()
+46 SET RC=$$DRUGLIST^RORUTL16(RORXL,REGIEN)
+47 SET RC=$$SVR^RORX023A(PTIEN,2000101,DT,REGIEN,RORXL,"",$$FMADD^XLFDT(DT,1),.RORLDST,.RORXDST)
+48 DO POP^RORTMP(RORXL)
+49 ; skip if SVR and not SVR requested
IF FLAGS["V"
SET SKIP=$SELECT(RC=0:0,1:1)
QUIT
+50 ; skip if not SVR and SVR requested
IF FLAGS["S"
SET SKIP=$SELECT(RC=1:0,1:1)
End DoDot:1
if SKIP
QUIT 1
+51 ;
+52 ;--- Confirmed before/during/after the date range
+53 SET ENDT=$SELECT($GET(ENDT)>0:ENDT\1,1:9999999)+1
+54 IF $TRANSLATE(FLAGS,"PNF")'=FLAGS
Begin DoDot:1
+55 ; Date Confirmed
SET TMP=+$$CONFDT^RORUTL18(RORIEN)
+56 SET TMP=$SELECT(TMP<STDT:FLAGS["P",TMP>ENDT:FLAGS["F",1:FLAGS["N")
End DoDot:1
if TMP
QUIT 1
+57 ;
+58 ;--- Other registries
+59 IF FLAGS["R"
Begin DoDot:1
+60 SET NODE=$NAME(RORTSK("PARAMS","OTHER_REGISTRIES","C"))
+61 if $DATA(@NODE)<10
QUIT
+62 if '$DATA(PTIEN)
SET PTIEN=+$$PTIEN^RORUTL01(RORIEN)
+63 SET REGIEN=0
+64 FOR
SET REGIEN=$ORDER(@NODE@(REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:2
+65 SET MODE=+$GET(@NODE@(REGIEN))
if 'MODE
QUIT
+66 SET IEN=$$PRRIEN^RORUTL01(PTIEN,REGIEN)
+67 IF IEN'>0
SET SKIP=1
+68 IF '$TEST
if $$SKIPNA(IEN,FLAGS)
SET SKIP=1
+69 ; Exclude
if MODE<0
SET SKIP='SKIP
End DoDot:2
if SKIP
QUIT
End DoDot:1
if SKIP
QUIT 1
+70 ;
+71 ;--- Local Fields
+72 IF FLAGS["O"
Begin DoDot:1
+73 SET NODE=$NAME(RORTSK("PARAMS","LOCAL_FIELDS","C"))
+74 if $DATA(@NODE)<10
QUIT
+75 SET IEN=0
+76 FOR
SET IEN=$ORDER(@NODE@(IEN))
if IEN'>0
QUIT
Begin DoDot:2
+77 SET MODE=+$GET(@NODE@(IEN))
if 'MODE
QUIT
+78 if '$DATA(^RORDATA(798,RORIEN,20,"B",IEN))
SET SKIP=1
+79 ; Exclude
if MODE<0
SET SKIP='SKIP
End DoDot:2
if SKIP
QUIT
End DoDot:1
if SKIP
QUIT 1
+80 ;
+81 ;--- Local HIV Diagnosis
+82 IF FLAGS["H"
Begin DoDot:1
+83 NEW RORV
+84 SET MODE=+RORTSK("PARAMS","HIV_DX")
if 'MODE
QUIT
+85 SET RORV=+$PIECE($GET(^RORDATA(799.4,RORIEN,12)),U,8)
+86 if RORV'=1
SET SKIP=1
+87 if MODE<0
SET SKIP='SKIP
End DoDot:1
if SKIP
QUIT 1
+88 ;
+89 ;
+90 ;---Check for future appointments patch 33
+91 IF FLAGS["U"
Begin DoDot:1
+92 NEW RORDAYS
+93 SET RORDAYS=$GET(RORTSK("PARAMS","OPTIONS","A","FUT_APPT"))
+94 ;get dfn
if '$DATA(PTIEN)
SET PTIEN=+$$PTIEN^RORUTL01(RORIEN)
+95 SET SKIP=$$SKIPFUT(PTIEN,RORDAYS)
End DoDot:1
if SKIP
QUIT 1
+96 ;
+97 ;--- Include in the report
+98 QUIT 0
+99 ;
+100 ;***** CHECKS STATUS OF THE PATIENT'S REGISTRY RECORD (internal)
+101 ;
+102 ; IEN798 IEN of the patient's record in the registry
+103 ;
+104 ; FLAGS Flags that control the execution
+105 ;
+106 ; [.STATUS] Status code is returned via this parameter.
+107 ;
+108 ; Return Values:
+109 ; 0 Continue processing of the patient's data
+110 ; 1 Skip the patient
+111 ;
SKIPNA(IEN798,FLAGS,STATUS) ;
+1 ; Active patient
if $$ACTIVE^RORDD(IEN798,,.STATUS)
QUIT 0
+2 ; Deleted patient
if (STATUS=5)!(STATUS="")
QUIT 1
+3 ; Pending patient
if (STATUS=4)&(FLAGS["G")
QUIT 1
+4 QUIT 0
+5 ;
+6 ;***** CHECKS IF BIRTHSEX OF PATIENT MATCHES BIRTHSEX SELECTED FOR REPORT
+7 ;
+8 ; DFN IEN of the patient's record in the patient file (#2)
+9 ;
+10 ; FLAGS Flags that control the execution
+11 ;
+12 ; Return Values:
+13 ; 0 Continue processing of the patient's data
+14 ; 1 Skip the patient
+15 ;
SKIPSEX(DFN,FLAGS) ;
+1 NEW VADM,VAPTYP,VAHOW,BIRTHSEX
+2 DO DEM^VADPT
+3 SET BIRTHSEX=$PIECE($GET(VADM(5)),U)
+4 QUIT $SELECT(FLAGS["M":BIRTHSEX'="F",FLAGS["W":BIRTHSEX'="M",1:0)
+5 ;
+6 ;***** CHECKS IF PERIOD OF SERVICE OF PATIENT MATCHES OEF/OIF SELECTION FOR
+7 ; REPORT
+8 ;
+9 ; DFN IEN of the patient's record in the patient file (#2)
+10 ;
+11 ; FLAGS Flags that control the execution
+12 ;
+13 ; Return Values:
+14 ; 0 Continue processing of the patient's data
+15 ; 1 Skip the patient
+16 ;
SKIPOEF(DFN,FLAGS) ;
+1 NEW VASV,QUIT
+2 DO SVC^VADPT
+3 SET QUIT=0
+4 ; Ignore if Only OEF/OIF selected and patient has no such POS
+5 IF FLAGS["I"
SET QUIT=$SELECT($GET(VASV(11))!($GET(VASV(12)))!($GET(VASV(13))):0,1:1)
+6 ; Ignore if Exclude OEF/OIF selected and patient has such POS
+7 IF 'QUIT
IF FLAGS["E"
SET QUIT=$SELECT($GET(VASV(11))!($GET(VASV(12)))!($GET(VASV(13))):1,1:0)
+8 QUIT QUIT
+9 ;
+10 ;***** CHECKS IF AGE RANGE OF PATIENT MATCHES AGE RANGE SELECTED FOR REPORT
+11 ;
+12 ; DFN IEN of the patient's record in the patient file (#2)
+13 ;
+14 ; FLAGS Flags that control the execution
+15 ;
+16 ; Return Values:
+17 ; 0 Continue processing of the patient's data
+18 ; 1 Skip the patient
+19 ;
SKIPAR(DFN,ARFLAGS) ; skip Age Range
+1 NEW VADM,VAPTYP,VAHOW,ARSTDT,ARENDT,PATAGE
+2 IF $GET(ARFLAGS)=""
QUIT 0
+3 DO DEM^VADPT
+4 SET ARSTDT=$GET(RORTSK("PARAMS","AGE_RANGE","A","START"))
+5 SET ARENDT=$GET(RORTSK("PARAMS","AGE_RANGE","A","END"))
+6 IF ARSTDT>ARENDT!(ARSTDT="")!(ARENDT="")
QUIT 0
+7 SET PATAGE=$SELECT(ARFLAGS["AGE":$PIECE($GET(VADM(4)),U),ARFLAGS["DOB":$PIECE($GET(VADM(3)),U),1:"")
+8 IF PATAGE>ARENDT!(PATAGE<ARSTDT)
QUIT 1
+9 QUIT 0
+10 ;
SKIPFUT(PTIEN,RORDAYS) ; SKIP if no future appointment PATCH 33
+1 IF '$$FUTAPPT^RORUTL02(PTIEN,RORDAYS)
QUIT 1
+2 QUIT 0
