174 lines
5.5 KiB
Mathematica
174 lines
5.5 KiB
Mathematica
RORXU005 ;HCIOFO/SG - REPORT BUILDER UTILITIES ; 5/17/06 1:45pm
|
|
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|
;
|
|
; This routine uses the following IAs:
|
|
;
|
|
; #10035 Direct read of the DOD field of the file #2
|
|
;
|
|
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,RISKLST,RORBUF,RORMSG
|
|
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
|
|
;
|
|
; O Process LOCAL_FIELDS
|
|
; R Process OTHER_REGISTRIES
|
|
;
|
|
; [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,SKIP,STATUS,TMP
|
|
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)
|
|
;
|
|
;--- 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
|
|
;
|
|
;--- 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
|