source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLL.m@ 952

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1PXRMDLL ;SLC/PJH - REMINDER DIALOG LOADER ;09/26/2007
2 ;;2.0;CLINICAL REMINDERS;**10,6**;Feb 04, 2005;Build 123
3 ;
4OK(DIEN) ;Check if mental health test is for GUI
5 I 'DIEN Q 0
6 Q $$MH^PXRMDLG5(DIEN)
7 ;
8TXT ;Format text
9 N NULL
10 S TEXT=DTXT(SUB),NULL=0
11 I ($E(TEXT)=" ")!(TEXT="") S NULL=1
12 I LAST,'NULL S TEXT="<br>"_TEXT
13 S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
14 S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
15 Q
16 ;
17EXP(TIEN,DITEM,DSUB) ;Expand taxonomy codes
18 N ACNT,AHIS,ATYP,ARRAY,CODES,CNT,DPCE,DTAX
19 ;Get taxonomy file details
20 D TAX(TIEN,.ARRAY)
21 ;
22 ;Build dialog from the returned array
23 ;
24 ;Main Taxonomy prompt
25 S DTXT=ARRAY
26 S OCNT=OCNT+1
27 S ORY(OCNT)=1_U_DITEM_U_DSUB_U_"S"_U_DEXC
28 ;Default group indents and selection entry
29 S $P(ORY(OCNT),U,16)=2,$P(ORY(OCNT),U,18)=2
30 S OCNT=OCNT+1
31 S ORY(OCNT)=2_U_DITEM_U_DSUB_U_DTXT
32 ;
33 ;Taxonomy CPT/POV resolution prompts
34 S ACNT=""
35 F S ACNT=$O(ARRAY(ACNT)) Q:ACNT="" D
36 .;Prompt text
37 .S DTXT=$P(ARRAY(ACNT),U),DPCE=$P(ARRAY(ACNT),U,4)
38 .;Historical/Current flag
39 .S AHIS=0 I $P(ARRAY(ACNT),U,3)=2 S AHIS=1
40 .;CPT/POV
41 .S ATYP="POV" I $P(ARRAY(ACNT),U,2)=81 S ATYP="CPT"
42 .;Initial display
43 .S DHIDE=0,DCHECK=0,DDIS=0
44 .;Construct ien for this level
45 .S DTAX=DSUB_"."_ACNT
46 .S OCNT=OCNT+1
47 .S ORY(OCNT)=1_U_DITEM_U_DTAX_U_"T"_U_DEXC_U_U_ATYP_U_AHIS
48 .S OCNT=OCNT+1
49 .S ORY(OCNT)=2_U_DITEM_U_DTAX_U_DTXT
50 Q
51 ;
52GROUP(DIEN,DSUB) ;Dialog group
53 N DATA,DBOX,DCAP,DCHK,DENTRY,DEXC,DGIEN,DGRP,DGSEQ,DGSUB,DHIDE,DIND
54 N DINDPN,DMHEX,DRESL,DSHARE,SUB,DCOUNT
55 ;Group caption text
56 S DATA=$G(^PXRMD(801.41,DIEN,0))
57 S DCAP=$P(DATA,U,5),DBOX=$P(DATA,U,6),DIND=$P(DATA,U,7)
58 S DSHARE=$P(DATA,U,8),DENTRY=$P(DATA,U,9),DHIDE=$P(DATA,U,10)
59 S DINDPN=$P(DATA,U,12) S:DINDPN="" DINDPN=0
60 S DBOX=$S(DBOX="Y":1,1:"")
61 ;group header is display only if SUPPRESS CHECKBOX
62 S DCHK="S" I ('DHIDE)&(DSUPP) S DCHK="D",DHIDE=0
63 ;Default group setting to hide
64 I DHIDE="" S DHIDE=1
65 ;
66 S DEXC=$P($G(^PXRMD(801.41,DIEN,2)),U,3)
67 ;
68 S OCNT=OCNT+1,ORY(OCNT)=1_U_DIEN_U_DSUB_U_DCHK_U_DEXC
69 S $P(ORY(OCNT),U,8)=$$AHIS(DIEN)
70 S $P(ORY(OCNT),U,15)=DHIDE,$P(ORY(OCNT),U,16)=DIND
71 S $P(ORY(OCNT),U,17)=DSHARE,$P(ORY(OCNT),U,18)=DENTRY
72 S $P(ORY(OCNT),U,19)=DBOX,$P(ORY(OCNT),U,20)=DCAP
73 S $P(ORY(OCNT),U,21)=DINDPN
74 ;Create type 2 records if if here is additional group text
75 N LAST,TEXT
76 S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
77 .D TXT
78 .S OCNT=OCNT+1,ORY(OCNT)=2_U_DIEN_U_DSUB_U_TEXT
79 ;Get dialog group sub-elements
80 N DTYP,DSUPP,DDIS,IDENT S DGSEQ=0
81 F S DGSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ)) Q:'DGSEQ D
82 .S DGSUB=$O(^PXRMD(801.41,DIEN,10,"B",DGSEQ,"")) Q:'DGSUB
83 .S DATA=$G(^PXRMD(801.41,DIEN,10,DGSUB,0))
84 .S DGIEN=$P(DATA,U,2) Q:'DGIEN
85 .;Branching logic call to determine if element should be suppress,
86 .;replace or left as is
87 .N TERMNODE,TERMSTAT
88 .S TERMNODE=$G(^PXRMD(801.41,DGIEN,49))
89 .I $G(TERMNODE)'="" D Q:TERMSTAT=0
90 ..S TERMSTAT=1
91 ..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DGIEN,.DATA,.TERMSTAT)
92 .;Exclude from P/N
93 .S DEXC=$P(DATA,U,8)
94 .I $P($G(^PXRMD(801.41,DGIEN,0)),U,16)'["WHR" D
95 ..K DTXT S SUB=0 F S SUB=$O(^PXRMD(801.41,DGIEN,25,SUB)) Q:'SUB D
96 ...S DTXT(SUB)=$G(^PXRMD(801.41,DGIEN,25,SUB,0))
97 .;Check if element is disabled/invalid
98 .S DATA=$G(^PXRMD(801.41,DGIEN,0)) Q:DATA="" Q:$P(DATA,U,3)]""
99 .;If the actual element is exclude from P/N override
100 .I $P($G(^PXRMD(801.41,DGIEN,2)),U,3) S DEXC=1
101 .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11) Q:"EG"'[DTYP
102 .S DMHEX=$P(DATA,U,14)
103 .S DRESL=$$RESGROUP^PXRMDLLB(DGIEN)
104 .;S DRESL=$P(DATA,U,15)
105 .S DRES=$P($G(^PXRMD(801.41,DGIEN,1)),U,3)
106 .;Done Elsewhere (historical)
107 .S DHIS=$$AHIS(DGIEN)
108 .S DFIND=$P($G(^PXRMD(801.41,DGIEN,1)),U,5)
109 .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
110 .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
111 .;If mental Health ignore if not GUI
112 .I DPCE="MH" Q:'$$OK(DFIEN)
113 .S DGRP=DSUB_"."_DGSUB
114 .;Taxonomy codes need expanding
115 .I DPCE="T" D EXP(DFIEN,DGIEN,DGRP) Q
116 .;Translate vitals ien to PCE code - This will need a DBIA
117 .I DPCE="VIT" S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
118 .;Embedded Dialog Group
119 .I DTYP="G" D GROUP(DGIEN,DGRP) Q
120 .S DDIS="S" I DSUPP=1 S DDIS="D"
121 .S DGRP=DSUB_"."_DGSUB,OCNT=OCNT+1
122 .S ORY(OCNT)=1_U_DGIEN_U_DGRP_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL_U_$G(DCOUNT)
123 .;
124 .N LAST,TEXT
125 .S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
126 ..D TXT
127 ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DGIEN_U_DGRP_U_TEXT
128 Q
129 ;
130LOAD(DIEN,DFN) ;Load dialog questions into array
131 N DARRAY,DATA,DITEM,DFIND,DFIEN,DFTYP,DPCE,DRES,DSEQ,DSUB,DTXT,DTYP,OCNT
132 N DDIS,DEXC,DHIDE,DCHECK,DDIS,DHIS,DMHEX,DRESL,DSUPP,SUB,IDENT,TXTCNT
133 ;Check Status of dialog
134 S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
135 ;If disabled ignore
136 I $P(DATA,U,3)]"" Q
137 ;Ignore if not a reminder dialog
138 I $P(DATA,U,4)'="R" Q
139 ;
140 ;List of PCE codes
141 S DARRAY("AUTTEDT(")="PED"
142 S DARRAY("AUTTEXAM(")="XAM"
143 S DARRAY("AUTTHF(")="HF"
144 S DARRAY("AUTTIMM(")="IMM"
145 S DARRAY("AUTTSK(")="SK"
146 S DARRAY("GMRD(120.51,")="VIT"
147 S DARRAY("ORD(101.41,")="Q"
148 S DARRAY("YTT(601.71,")="MH"
149 S DARRAY("ICD9(")="POV"
150 S DARRAY("ICPT(")="CPT"
151 S DARRAY("PXD(811.2,")="T"
152 S DARRAY("WV(790.1,")="WHR"
153 ;
154 ;Get elements for the dialog
155 S DSEQ=0,OCNT=0
156 F S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ D
157 .S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
158 .S DATA=$G(^PXRMD(801.41,DIEN,10,DSUB,0))
159 .S DITEM=$P(DATA,U,2) Q:DITEM=""
160 .;Ignore disabled elements
161 .S DATA=$G(^PXRMD(801.41,DITEM,0)) Q:DATA="" Q:$P(DATA,U,3)]""
162 .;Branching logic call to determine if element should be suppress,
163 .;replace or left as is
164 .S TERMNODE=$G(^PXRMD(801.41,DITEM,49))
165 .N TERMSTAT
166 .I $G(TERMNODE)'="" D Q:TERMSTAT=0
167 ..S TERMSTAT=1
168 ..D REPLACE^PXRMDLLB(DFN,TERMNODE,.DITEM,.DATA,.TERMSTAT)
169 .S DTYP=$P(DATA,U,4),DSUPP=$P(DATA,U,11)
170 .S DMHEX=$P(DATA,U,14)
171 .S DRESL=$$RESGROUP^PXRMDLLB(DITEM)
172 .;S DRESL=$P(DATA,U,15)
173 .K DTXT S SUB=0
174 .F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
175 ..S DTXT(SUB)=$G(^PXRMD(801.41,DITEM,25,SUB,0))
176 .S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
177 .S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
178 .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
179 .S DPCE="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
180 .;If mental Health ignore if not GUI
181 .I DPCE="MH" Q:'$$OK(DFIEN)
182 .;Exclude from PN
183 .S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
184 .;Taxonomy codes need expanding
185 .I DPCE="T" D EXP(DFIEN,DITEM,DSUB) Q
186 .;Translate vitals ien to PCE code - This will need a DBIA
187 .I DPCE="VIT" S DFIEN=$P($G(^GMRD(120.51,DFIEN,0)),U,7)
188 .;Done Elsewhere (historical)
189 .S DHIS=$$AHIS(DITEM)
190 .;Dialog Group
191 .I DTYP="G" D GROUP(DITEM,DSUB) Q
192 .;Dialog type/text and resolution
193 .S OCNT=OCNT+1,DDIS="S"
194 .I DSUPP=1 S DDIS="D"
195 .S ORY(OCNT)=1_U_DITEM_U_DSUB_U_DDIS_U_DEXC_U_U_U_DHIS_U_DMHEX_U_DRESL
196 .N LAST,TEXT
197 .S SUB=0,LAST=0 F S SUB=$O(DTXT(SUB)) Q:'SUB D
198 ..D TXT
199 ..S OCNT=OCNT+1,ORY(OCNT)=2_U_DITEM_U_DSUB_U_TEXT
200 Q
201 ;
202TAX(TXIEN,ARRAY) ;Return list of resolutions/codes for taxonomy
203 N CNT,DTXT,FNODE,RSUB,TDX,TNAME,TPAR,TPR,TYP
204 N TCUR,TDTXT,TDHTXT,THIS,TPTXT,TPHTXT
205 ;
206 ;Get taxonomy name
207 S TNAME=$P($G(^PXD(811.2,TXIEN,0)),U,1)
208 ;
209 ;Check what type of taxonomy codes exist
210 S TDX=$$TOK^PXRMDLLA(TXIEN,"SDX")
211 S TPR=$$TOK^PXRMDLLA(TXIEN,"SPR")
212 ;
213 ;Taxonomy dialog text
214 S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,3)
215 ;default to taxonomy description if null
216 I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,2)
217 ;default to taxonomy name if null
218 I DTXT="" S DTXT=$P($G(^PXD(811.2,TXIEN,0)),U,1)
219 ;
220 S CNT=0,ARRAY=DTXT
221 ;
222 ;Diagnoses
223 I TDX D
224 .;Diagnosis texts
225 .S TPAR=$G(^PXD(811.2,TXIEN,"SDZ"))
226 .;Get parameter file node for this finding type
227 .S FNODE=$O(^PXRMD(801.45,"B","POV","")) Q:FNODE=""
228 .;check if finding parameters are disabled
229 .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
230 .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
231 .;get category text (diagnoses)
232 .I 'TCUR D ; Current
233 ..S TDTXT=$P(TPAR,U,2) S:TDTXT="" TDTXT=TNAME
234 ..S CNT=CNT+1,ARRAY(CNT)=TDTXT_U_80_U_1_U_"POV"
235 .I 'THIS D ; Historical
236 ..S TDHTXT=$P(TPAR,U,3) S:TDHTXT="" TDHTXT=TNAME_" (HISTORICAL)"
237 ..S CNT=CNT+1,ARRAY(CNT)=TDHTXT_U_80_U_2_U_"POV"
238 ;Procedures
239 I TPR D
240 .;Procedure texts
241 .S TPAR=$G(^PXD(811.2,TXIEN,"SPZ"))
242 .;Get parameter file node for this finding type
243 .S FNODE=$O(^PXRMD(801.45,"B","CPT","")) Q:FNODE=""
244 .;check if finding parameters are disabled
245 .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
246 .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
247 .;get category text (procedures)
248 .I 'TCUR D ; Current
249 ..S TPTXT=$P(TPAR,U,2) S:TPTXT="" TPTXT=TNAME
250 ..S CNT=CNT+1,ARRAY(CNT)=TPTXT_U_81_U_1_U_"CPT"
251 .I 'THIS D ; Historical
252 ..S TPHTXT=$P(TPAR,U,3) S:TPHTXT="" TPHTXT=TNAME_" (HISTORICAL)"
253 ..S CNT=CNT+1,ARRAY(CNT)=TPHTXT_U_81_U_2_U_"CPT"
254 ;
255 Q
256 ;
257AHIS(DITEM) ;
258 N RSIEN,RSNAM
259 S RSIEN=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
260 I RSIEN="" Q 0
261 S RSNAM=$P($G(^PXRMD(801.9,RSIEN,0)),U)
262 I RSNAM["DONE ELSEWHERE" Q 1
263 N GUI,PIEN,PFOUND
264 S PIEN=0,PFOUND=0
265 F S PIEN=$O(^PXRMD(801.41,DITEM,10,"D",PIEN)) Q:'PIEN D Q:PFOUND
266 .;Ignore elements and groups
267 .I "EG"[$P($G(^PXRMD(801.41,PIEN,0)),U,4) Q
268 .;GUI Process
269 .S GUI=$P($G(^PXRMD(801.41,PIEN,46)),U) Q:'GUI
270 .;Check if this is PXRM VISIT DATE (or a copy of it)
271 .I $P($G(^PXRMD(801.42,GUI,0)),U)="VST_DATE" S PFOUND=1
272 Q PFOUND
Note: See TracBrowser for help on using the repository browser.