source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORXU005.m@ 1688

Last change on this file since 1688 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.5 KB
Line 
1RORXU005 ;HCIOFO/SG - REPORT BUILDER UTILITIES ; 5/17/06 1:45pm
2 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #10035 Direct read of the DOD field of the file #2
7 ;
8 Q
9 ;
10 ;***** CALLBACK FUNCTION FOR DRUG SEARCH API
11REIMBCB(RORDST,ORDER,FLAGS,DRUG,DATE) ;
12 S RORDST=1
13 Q 2
14 ;
15 ;***** RETURNS THE REIMBURSEMENT LEVEL FOR THE PATIENT
16 ;
17 ; RORIEN IEN of the patient's record in the registry
18 ;
19 ; ROR8DRGS Either closed root of the ARV drug list prepared by
20 ; the $$DRUGLIST^RORUTL16 or the Registry IEN. In the
21 ; latter case, the list will be compiled automatically.
22 ;
23 ; STDT Start date
24 ; ENDT End date
25 ;
26 ; Return Values:
27 ; <0 Error code
28 ; 0 Neither Clinical AIDS nor ARV drugs
29 ; 10 ARV drugs
30 ; 20 Clinical AIDS
31 ; 30 Both Clinical AIDS and ARV drugs
32 ;
33REIMBLVL(RORIEN,ROR8DRGS,STDT,ENDT) ;
34 N PATIEN,RC,RLVL,RORDST
35 S RLVL=0
36 ;--- Clinical AIDS
37 S:$$CLINAIDS^RORHIVUT(+RORIEN,ENDT) RLVL=RLVL+20
38 ;--- ARV Drugs
39 S PATIEN=$$PTIEN^RORUTL01(RORIEN)
40 S RORDST("RORCB")="$$REIMBCB^RORXU005"
41 S RC=$$RXSEARCH^RORUTL14(PATIEN,ROR8DRGS,.RORDST,"IOV",STDT,ENDT)
42 S:$G(RORDST)>0 RLVL=RLVL+10
43 ;--- Reimbursement level
44 Q $S(RC<0:RC,1:RLVL)
45 ;
46 ;***** RETURNS THE PATIENT'S LIST OF RISK FACTORS
47 ;
48 ; RORIEN IEN of the patient's record in the registry
49 ;
50 ; Return Values:
51 ; <0 Error code
52 ; "" No risk factors have been found
53 ; " ... " A string containing the risk factor numbers
54 ; separated by commas and spaces
55 ;
56RISKS(RORIEN) ;
57 Q:'$D(^RORDATA(799.4,+RORIEN,0)) ""
58 N FLD,FLDLST,I,RISKLST,RORBUF,RORMSG
59 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"
60 ;--- Load the risk fields
61 S IENS=(+RORIEN)_","
62 D GETS^DIQ(799.4,IENS,FLDLST,"I","RORBUF","RORMSG")
63 Q:$G(DIERR) $$DBS^RORERR(799.4,-9,,,799.4,IENS)
64 ;--- Process the data
65 S RISKLST=""
66 F I=1:1 S FLD=$P(FLDLST,";",I) Q:FLD="" D:FLD>0
67 . S:$G(RORBUF(799.4,IENS,FLD,"I"))=1 RISKLST=RISKLST_", "_I
68 Q $P(RISKLST,", ",2,999)
69 ;
70 ;***** DETERMINES IF THE PATIENT SHOULD NOT BE INCLUDED IN THE REPORT
71 ;
72 ; RORIEN IEN of the patient's record in the registry
73 ;
74 ; FLAGS Flags that control the execution (can be combined)
75 ;
76 ; C Skip confirmed patients
77 ; G Skip pending patients
78 ;
79 ; D Skip deceased patients
80 ; L Skip alive patients
81 ;
82 ; P Skip patients confirmed before the start date
83 ; N Skip patients confirmed during the report
84 ; time frame
85 ; F Skip patients added after the end date
86 ;
87 ; O Process LOCAL_FIELDS
88 ; R Process OTHER_REGISTRIES
89 ;
90 ; [STDT] Start date of the report (FileMan).
91 ; Time is ignored and the beginning of the day is
92 ; considered as the boundary (STDT\1).
93 ;
94 ; If not defined or not greater than 0 then 0 is used.
95 ;
96 ; [ENDT] End date of the report (FileMan).
97 ; Time is ignored and the end of the day is
98 ; considered as the boundary (ENDT\1+1).
99 ;
100 ; If not defined or not greater than 0 then 9999999
101 ; is used.
102 ;
103 ; Return Values:
104 ; 0 Include the patient's data in the report
105 ; 1 Skip the patient
106 ;
107SKIP(RORIEN,FLAGS,STDT,ENDT) ;
108 N DOD,IEN,MODE,NODE,PTIEN,REGIEN,SKIP,STATUS,TMP
109 S SKIP=0
110 ;--- Always skip patients marked for deletion
111 Q:$$SKIPNA(RORIEN,FLAGS,.STATUS) 1
112 ;---Include all registry patients if flags are not provided
113 Q:FLAGS="" 0
114 ;
115 ;--- Confirmed
116 I FLAGS["C" Q:STATUS'=4 1
117 ;
118 ;--- Alive/Deceased patients
119 S STDT=$S($G(STDT)>0:STDT\1,1:0)
120 I $TR(FLAGS,"LD")'=FLAGS D Q:$S(TMP:FLAGS["L",1:FLAGS["D") 1
121 . S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN)
122 . S DOD=+$P($G(^DPT(PTIEN,.35)),U)
123 . S TMP=$S(DOD>0:DOD'<STDT,1:1)
124 ;
125 ;--- Confirmed before/during/after the date range
126 S ENDT=$S($G(ENDT)>0:ENDT\1,1:9999999)+1
127 I $TR(FLAGS,"PNF")'=FLAGS D Q:TMP 1
128 . S TMP=+$$CONFDT^RORUTL18(RORIEN) ; Date Confirmed
129 . S TMP=$S(TMP<STDT:FLAGS["P",TMP>ENDT:FLAGS["F",1:FLAGS["N")
130 ;
131 ;--- Other registries
132 I FLAGS["R" D Q:SKIP 1
133 . S NODE=$NA(RORTSK("PARAMS","OTHER_REGISTRIES","C"))
134 . Q:$D(@NODE)<10
135 . S:'$D(PTIEN) PTIEN=+$$PTIEN^RORUTL01(RORIEN)
136 . S REGIEN=0
137 . F S REGIEN=$O(@NODE@(REGIEN)) Q:REGIEN'>0 D Q:SKIP
138 . . S MODE=+$G(@NODE@(REGIEN)) Q:'MODE
139 . . S IEN=$$PRRIEN^RORUTL01(PTIEN,REGIEN)
140 . . I IEN'>0 S SKIP=1
141 . . E S:$$SKIPNA(IEN,FLAGS) SKIP=1
142 . . S:MODE<0 SKIP='SKIP ; Exclude
143 ;
144 ;--- Local Fields
145 I FLAGS["O" D Q:SKIP 1
146 . S NODE=$NA(RORTSK("PARAMS","LOCAL_FIELDS","C"))
147 . Q:$D(@NODE)<10
148 . S IEN=0
149 . F S IEN=$O(@NODE@(IEN)) Q:IEN'>0 D Q:SKIP
150 . . S MODE=+$G(@NODE@(IEN)) Q:'MODE
151 . . S:'$D(^RORDATA(798,RORIEN,20,"B",IEN)) SKIP=1
152 . . S:MODE<0 SKIP='SKIP ; Exclude
153 ;
154 ;--- Include in the report
155 Q 0
156 ;
157 ;***** CHECKS STATUS OF THE PATIENT'S REGISTRY RECORD (internal)
158 ;
159 ; IEN798 IEN of the patient's record in the registry
160 ;
161 ; FLAGS Flags that control the execution
162 ;
163 ; [.STATUS] Status code is returned via this parameter.
164 ;
165 ; Return Values:
166 ; 0 Continue processing of the patient's data
167 ; 1 Skip the patient
168 ;
169SKIPNA(IEN798,FLAGS,STATUS) ;
170 Q:$$ACTIVE^RORDD(IEN798,,.STATUS) 0 ; Active patient
171 Q:(STATUS=5)!(STATUS="") 1 ; Deleted patient
172 Q:(STATUS=4)&(FLAGS["G") 1 ; Pending patient
173 Q 0
Note: See TracBrowser for help on using the repository browser.