source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLL.m@ 1800

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

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