source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDBA2.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1ORWDBA2 ; SLC/GDU - Billing Awareness - Phase I [11/26/04 15:43]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**195**;Dec 17, 1997
3 ;
4 ;Clinician's Personal Diagnoses List
5 ;The personal diagnoses list is stored in the NEW PERSON file # 200.
6 ;In file # 200 it is stored in the multi-valued field PERSONAL DIAGNOSIS
7 ;LIST, field # 351, sub-file 200.0351. This is unique to the individual
8 ;clinician. It is designed to aid the clinician with the CIDC process
9 ;by providing a list of diagnoses codes most frequently used by that
10 ;clinician.
11 ;
12 ;External References:
13 ; NOW^%DTC DBIA 10000
14 ; FILE^DIE DBIA 2053
15 ; UPDATE^DIE DBIA 2053
16 ; DT^DILF DBIA 2054
17 ; FDA^FILF DBIA 2054
18 ; $$GET1^DIQ DBIA 2056
19 ; GETS^DIQ DBIA 2056
20 ; $$STATCHK^ICDAPIU DBIA 3991
21 ; $$ICDDX^ICDCODE DBIA 3990
22 ; $$NOW^XLFDT DBIA 10103
23 ;
24ADDPDL(Y,ORCIEN,ORDXA) ;Add to Personal Diagnosis List
25 ;Add a new personal diagnosis list or new ICD9 code to an existing
26 ;personal diagnosis list for a clinician. It will filter out duplicate
27 ;entries before updating an existing PDL.
28 ;Input Variables:
29 ; ORCIEN Clinician Internal Entry Number
30 ; ORDXA Array of dx codes to be added to personal dx list
31 ; format: ORDXA(#)=ICD9_Code^Lexicon_Expression_IEN
32 ;Output Variable:
33 ; Y Return value, 1 successful, 0 unsuccessful
34 ;Local Variables:
35 ; DXI Diagnosis Array Index
36 ; DXIEN Diagnosis Code Internal Entry Number
37 ; EM Error Message
38 ; FDXR Found Diagnoses Records Array
39 ; FDXRI Found Diagnoses Records Array Index
40 ; IEN Internal Entry Number
41 ; PDL Personal Diagnoses List Array
42 ; PDLI Personal Diagnoses List Array Index
43 N DXI,DXIEN,EM,FDXR,FDXRI,IEN,PDL,PDLI
44 ;Gets clinician's Personal Diagnosis List and removes duplicates from
45 ;dx input array. Quits if all are duplicates.
46 D GETS^DIQ(200,ORCIEN,"351*,","","PDL","EM")
47 I $D(PDL) D
48 . S DXI="" F S DXI=$O(ORDXA(DXI)) Q:DXI="" D
49 .. S PDLI="" F S PDLI=$O(PDL(200.0351,PDLI)) Q:PDLI="" D
50 ... I PDL(200.0351,PDLI,.01)=$P($G(ORDXA(DXI)),U) K ORDXA(DXI)
51 I $D(ORDXA)=0 S Y=0 Q
52 ;Process dx input array
53 S DXI="" F S DXI=$O(ORDXA(DXI)) Q:DXI=""!($D(EM)) D
54 . K FDXR,EM
55 . ;Get the IEN for the current diagnosis code
56 . D FIND^DIC(80,"","","CM",$P(ORDXA(DXI),U),"*","","","","FDXR","EM")
57 . I $P(FDXR("DILIST",0),U)=0 Q
58 . I $P(FDXR("DILIST",0),U)=1 S DXIEN=FDXR("DILIST",2,1)
59 . I $P(FDXR("DILIST",0),U)>1 D
60 .. F FDXRI=1:1:FDXR("DILIST",0) D
61 ... I FDXR("DILIST",1,FDXRI)=$P($G(ORDXA(DXI)),U) S DXIEN=FDXR("DILIST",2,FDXRI)
62 . ;Add IDC9 code to personal diagnoses list
63 . K IEN
64 . S IEN="1,"_ORCIEN_",",IEN="+"_IEN
65 . D FDA^DILF(200.0351,IEN,.01,"",DXIEN,"FDA","EM")
66 . D UPDATE^DIE("","FDA","IEN","EM")
67 . ;Add Lexicon Expression list
68 . I $P(ORDXA(DXI),U,2)'="" D
69 .. S IEN=IEN(1)_","_ORCIEN_","
70 .. D FDA^DILF(200.0351,IEN,1,"",$P(ORDXA(DXI),U,2),"FDA","EM")
71 .. D FILE^DIE("","FDA","EM")
72 I $D(EM) S Y=0 Q
73 S Y=1
74 Q
75 ;
76DELPDL(Y,ORCIEN,ORDXA) ;Delete from Personal Diagnosis List
77 ;Delete a selected diagnosis code or group of diagnoses codes from a
78 ;Clinician's Personal DX List.
79 ;Input Variables:
80 ; ORCIEN Clinician Internal ID number
81 ; ORDXA Array of dx codes to be deleted from personal dx list
82 ;Output Variable:
83 ; Y Return value, 1 successful, 0 unsuccessful
84 ;Local Variables:
85 ; DXI Diagnosis code array index
86 ; EM Error Message
87 ; FDA FileMan Data Array
88 ; IEN Interanl Entry Number
89 ; RF Record Found
90 N DXI,EM,FDA,IEN,RF
91 D GETS^DIQ(200,ORCIEN,"351*,","","RF","EM")
92 I $D(RF)=0 S Y=0 Q
93 S IEN="" F S IEN=$O(RF(200.0351,IEN)) Q:IEN="" D
94 .S DXI="" F S DXI=$O(ORDXA(DXI)) Q:DXI="" D
95 .. I RF(200.0351,IEN,.01)=ORDXA(DXI) D
96 ... D FDA^DILF(200.0351,IEN,.01,"","@","FDA","EM")
97 ... D FILE^DIE("","FDA","EM")
98 S Y=1
99 Q
100 ;
101GETPDL(Y,ORCIEN) ;Get Personal Diagnosis List
102 ;This gets the clinician's personal diagnosis list. Using the personal
103 ;diagnosis list, builds and returns an array variable with the ICD9
104 ;codes and descriptions stored in the ICD DIAGNOSIS file, # 80.
105 ;Flagging any inactive ICD9 code with a "#".
106 ;Input Variable:
107 ; ORCIEN Clinician Internal ID number
108 ;Output Variable:
109 ; Y Array of ICD9 codes and descriptions
110 ; Y(#)=ICD9_code^DX_description^DX_Inactive
111 ; If inactive # in third piece
112 ; If active null in third piece
113 ;Local Variables:
114 ; DXC Diagnosis Code (for sorting)
115 ; DXD Diagnosis Description
116 ; DXDT Diagnosis Date
117 ; DXI Diagnosis Inactive Flag
118 ; EM Error Message
119 ; ICD9 ICD9 code (for GUI)
120 ; IEN Internal Entry Number
121 ; RF Record Found
122 N DXC,DXD,DXDT,DXI,EM,ICD9,IEN,RF
123 S DXDT=$$NOW^XLFDT
124 D GETS^DIQ(200,ORCIEN,"351*,","EI","RF","EM")
125 I $D(RF) D
126 . S (DXC,DXD,DXI,ICD9,IEN)=""
127 . F S IEN=$O(RF(200.0351,IEN)) Q:IEN="" D
128 .. S ICD9=RF(200.0351,IEN,.01,"E")
129 .. S DXC=$$SETDXC(ICD9)
130 .. I $G(RF(200.0351,IEN,1,"I"))="" S DXD=$$SETDXD($P($$ICDDX^ICDCODE(ICD9,DXDT),U,4))
131 .. I $G(RF(200.0351,IEN,1,"I"))=1 S DXD=$$SETDXD($P($$ICDDX^ICDCODE(ICD9,DXDT),U,4))
132 .. I $G(RF(200.0351,IEN,1,"I"))>1 S DXD=RF(200.0351,IEN,1,"E")
133 .. S DXI=$$SETDXI($$STATCHK^ICDAPIU(ICD9,DXDT))
134 .. S Y(DXC)=ICD9_U_DXD_U_DXI
135 E S Y=0
136 Q
137 ;
138GETDUDC(Y,ORCIEN,ORPTIEN) ;Get Day's Unique Diagnoses Codes
139 ;Gets all the unique ICD9 codes for the orders placed today by the
140 ;clinician for this patient. Using the ICD9 codes it builds an array
141 ;variable with the ICD9 code, its description from the ICD DIAGNOSIS
142 ;file, #80. Flagging any inactive ICD9 codes with a "#".
143 ;Input Variables:
144 ; ORCIEN Clinician's internal ID number
145 ; ORPTIEN Patient's internal ID number
146 ;Output Variable:
147 ; Y Array of ICD9 codes and descriptions
148 ; Y(#)=ICD9_code^DX_Description^DX_Inactive
149 ; If inactive # in third piece
150 ; If active null in third piece
151 ;Local Variables:
152 ; CKDATE Check Date (stops loop)
153 ; DXC Diagnosis Code (for sorting)
154 ; DXD Diagnosis Description
155 ; DXI Diagnosis Inactive Flag
156 ; DXIEN Diagnosis Internal Entry Number
157 ; ICD9 ICD9 code (for GUI display)
158 ; IEN Internal Entry Number
159 ; OBJORD Object of Order
160 ; ORDATE Order Date
161 ; ORDG Order Group (ACT index variable)
162 ; OREM Order Error Message
163 ; ORIEN Order Internal Entry Number
164 ; ORRF Order Record Found
165 ; RCODI Reverse Cronological Order Date Index
166 ; SUBFILE Subfile Number
167 N CKDATE,DXC,DXD,DXEM,DXI,DXIEN,DXRF,ICD9,IEN,OBJORD,ORDATE,ORDG,OREM
168 N ORIEN,ORRF,RCODI,SUBFILE
169 S OBJORD=ORPTIEN_";DPT("
170 S (DXIEN,ORDATE,ORDG,ORIEN,RCODI)="",CKDATE=$$F24HA
171 F S RCODI=$O(^OR(100,"ACT",OBJORD,RCODI)) S ORDATE=9999999-RCODI Q:ORDATE<CKDATE!(RCODI="") D
172 . F S ORDG=$O(^OR(100,"ACT",OBJORD,RCODI,ORDG)) Q:ORDG="" D
173 .. S ORIEN=$QS($Q(^OR(100,"ACT",OBJORD,RCODI,ORDG)),6)
174 .. K ORRF,OREM
175 .. D GETS^DIQ(100,ORIEN,"1;5.1*","I","ORRF","OREM")
176 .. S IEN=$QS($Q(ORRF(100)),2)
177 .. Q:ORRF(100,IEN,1,"I")'=ORCIEN
178 .. Q:$D(ORRF(100.051))=0
179 .. S (DXC,DXD,DXI,DXIEN,ICD9,IEN)=""
180 .. F S IEN=$O(ORRF(100.051,IEN)) Q:IEN="" D
181 ... Q:ORRF(100.051,IEN,.01,"I")=""
182 ... S DXIEN=ORRF(100.051,IEN,.01,"I")
183 ... S ICD9=$$GET1^DIQ(80,DXIEN,.01,"")
184 ... S DXC=$$SETDXC(ICD9)
185 ... S DXD=$$SETDXD($P($$ICDDX^ICDCODE(ICD9,ORDATE),U,4))
186 ... S DXI=$$SETDXI($$STATCHK^ICDAPIU(ICD9,ORDATE))
187 ... S Y(DXC)=ICD9_U_DXD_U_DXI
188 Q
189 ;
190SETDXC(X) ;Set diagnosis code variable for sorting
191 S X=$S($E(X)?1A:X,1:+X) Q X
192 ;
193SETDXD(X) ;Set upper case diagnosis discription to mixed case
194 N X1,X2
195 F X1=2:1:$L(X) D
196 . I $E(X,X1)?1U,$E(X,X1-1)?1A D
197 .. S X2=$E(X,X1)
198 .. S X2=$C($A(X2)+32)
199 .. S $E(X,X1)=X2
200 Q X
201 ;
202SETDXI(X) ;Set the diagnosis inactive indicator
203 S X=$S($P(X,U)=0:"#",1:"") Q X
204 ;
205CI(CNT) ;Counter Incrementer
206 ; CNT - Counter
207 S CNT=CNT+1 Q CNT
208 ;
209F24HA() ;Returns date and time from exactly 24 hours ago
210 N %,%H,%I,X
211 D NOW^%DTC
212 Q %-1
213 ;
214ERRMSG(MT) ;Display Error Message
215 ; to be determined
216 Q
Note: See TracBrowser for help on using the repository browser.