source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMCSD.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.4 KB
Line 
1PXRMCSD ; SLC/JVS - Code Set Version-dialog file ; 02/22/2007
2 ;;2.0;CLINICAL REMINDERS;**9**;Feb 04, 2005;Build 4
3 ;Variable List
4 ;TMP =Mail message array
5 ;DLGNAME =Dialogue Name .01 field
6 ;EFFDATE =Effective Date
7 ;FILE =Name of the Glpbal (ie ICPT or ICD9)
8 ;VAR,VAR3 =Variable Pointer
9 ;VARIEN =Ien from Variable Pointer
10 ;VRSTATUS =Status of Code in form 1 or 0
11 ;VARDESC =Code Text Description
12 ;STATUS =External form of Code Status
13 ;NUM =Line Number
14 ;
15 Q
16TASKALL ;TASK for all codes
17 S ZTRTN="DLG^PXRMCSD(""ALL"")"
18 S ZTDESC="Finding Inactive Codes in Dialog file"
19 S ZTIO=""
20 S ZTDTH=$H
21 D ^%ZTLOAD
22 Q
23TASKCPT ;TASK for Icpt codes Diagnosis
24 S ZTRTN="DLG^PXRMCSD(""ICPT"")"
25 S ZTDESC="Finding Inactive Codes in Dialog file"
26 S ZTIO=""
27 S ZTDTH=$H
28 D ^%ZTLOAD
29 Q
30TASKICD ;TASK for ICD codes
31 S ZTRTN="DLG^PXRMCSD(""ICD9"")"
32 S ZTDESC="Finding Inactive Codes in Dialog file"
33 S ZTIO=""
34 S ZTDTH=$H
35 D ^%ZTLOAD
36 Q
37OPTION ;Option entry point for dir call
38 N X,Y,%,%H,X
39 K DIR,Y,%I
40 S DIR(0)="SX^1:ICPT Codes;2:ICD9 Codes;3:ALL Codes"
41 S DIR("A")="Select Codes or All of the codes or ""^"" to exit"
42 S DIR("?",1)="This option is use to evaluate the various codes"
43 S DIR("?",2)="used in the reminder dialogs as Finding Items and"
44 S DIR("?",3)="Additonal Finding Items. It will report by mail message"
45 S DIR("?",4)="which codes are now inactive or are set to become"
46 S DIR("?",5)="in the future."
47 S DIR("B")="3"
48 S DIR("?")="Select a code set to be evaluated"
49 D ^DIR
50 I Y=1 W !,"Check Mail for results....." S ZTRTN="DLG^PXRMCSD(""ICPT"",1)"
51 I Y=2 W !,"Check Mail for results....." S ZTRTN="DLG^PXRMCSD(""ICD9"",1)"
52 I Y=3 W !,"Check Mail for results....." S ZTRTN="DLG^PXRMCSD(""ALL"",1)"
53 S ZTDESC="Finding Inactive Codes in Dialog file"
54 S ZTIO=""
55 D NOW^%DTC S ZTDTH=%H
56 D ^%ZTLOAD
57 K DIR,Y,%I,X
58 Q
59 ;
60DLG(GLOBAL,OPTION) ;ENTRY POINT
61 ;Test entry point to $O through dialogues
62 ;GLOBAL = Which code set to check out.
63 ;GLOBAL ="ICPT" OR "ICD9" OR "ALL"
64 ;OPTION = From and option 1=yes null=no
65 ;^PXRMD(801.41,IEN,1) 5TH PIECE
66 Q:'$D(GLOBAL)
67 N IEN,VAR,STATUS,NUM,ITEM,FILE,VARDIS,LINE,VARTYP
68 N VARIEN,VRSTATUS,VARDESC,DLGNAME,VARIENX,ARRY,VARDIS
69 N TMP,TYPE,XMDUN,XMSUB,XMUSB
70 ;=====Set variables====================================
71 S TMP="^TMP(""PXRMXMZ"",$J,NUM,0)"
72 S NUM=0
73 S LINE="S NUM=NUM+1"
74 D TEXT
75 S IEN=0 F S IEN=$O(^PXRMD(801.41,IEN)) Q:IEN'>0 D
76 .S VAR=$P($G(^PXRMD(801.41,IEN,1)),"^",5) ;varable pointer
77 .S DLGNAME=$P($G(^PXRMD(801.41,IEN,0)),"^",1)
78 .S TYPE=$P($G(^PXRMD(801.41,IEN,0)),"^",4)
79 .I +VAR'=0 S ITEM=" FI" D
80 ..;============ICPT(=================================
81 ..N VARIEN,CPTDATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
82 ..I $P(VAR,";",2)="ICPT(",((GLOBAL="ICPT")!(GLOBAL="ALL")) D
83 ...S FILE=" CPT"
84 ...S VARIEN=$P(VAR,";",1) ;Ien from variable pointer
85 ...S CPTDATA=$$CPTA^PXRMCSU(VARIEN) ;ALL Cpt data
86 ...I ($P(CPTDATA,"^",7)=0) D
87 ....S IADATE=$$CONV^PXRMCSU($P(CPTDATA,"^",8)) ;Convert Inactive date
88 ....S VARCODE=$$CPT^PXRMCSU(VARIEN) ;Code value
89 ....S VARDESC=$$CPTD^PXRMCSU(VARIEN) ;Description
90 ....S VARPAST=$P(CPTDATA,"^",11)
91 ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
92 .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
93 .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element disabled
94 ....D TMP
95 ..;============ICD9(=================================
96 ..N VARIEN,ICD9DATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
97 ..I $P(VAR,";",2)="ICD9(",((GLOBAL="ICD9")!(GLOBAL="ALL")) D
98 ...S FILE="ICD9"
99 ...S VARIEN=$P(VAR,";",1) ;Ien from variable pointer
100 ...S ICD9DATA=$$ICD9A^PXRMCSU(VARIEN) ;All ICD9 data
101 ...I ($P(ICD9DATA,"^",10)=0) D
102 ....S IADATE=$$CONV^PXRMCSU($P(ICD9DATA,"^",12)) ;Conver Inact date
103 ....S VARCODE=$$ICD9^PXRMCSU(VARIEN) ;Code
104 ....S VARDESC=$$ICD9D^PXRMCSU(VARIEN) ;Description
105 ....S VARPAST=$P(ICD9DATA,"^",19)
106 ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
107 .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
108 .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element description
109 ....D TMP
110 .D DLG3
111 S XMSUB="Reminder Dialog "_$S(GLOBAL="ALL":"ICD9 AND CPT",GLOBAL="ICPT":"CPT",1:GLOBAL)_" Code changes"
112 I '$D(^TMP("PXRMXMZ",$J)) D
113 . S ^TMP("PXRMXMZ",$J,1,0)="No dialog elements using inactive codes were found."
114 . S ^TMP("PXRMXMZ",$J,2,0)="No action is necessary."
115 D SEND^PXRMMSG(XMSUB)
116 K ^TMP("PXRMXMZ",$J)
117 S ZTREQ="@"
118 Q
119DLG3 ;^PXRMD(801.41,IEN,3,IEN3,0) 1ST PIECE
120 N IEN3,VAR3
121 S IEN3=0 F S IEN3=$O(^PXRMD(801.41,IEN,3,IEN3)) Q:IEN3'>0 D
122 .S VAR3=$P($G(^PXRMD(801.41,IEN,3,IEN3,0)),"^",1)
123 .I +VAR3'=0 S ITEM="AFI" D
124 ..;================ICPT=================================
125 ..N VARIEN,CPTDATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
126 ..I $P(VAR3,";",2)="ICPT(",((GLOBAL="ICPT")!(GLOBAL="ALL")) D
127 ...S FILE=" CPT"
128 ...S VARIEN=$P(VAR3,";",1) ;Ien from variable pointer
129 ...S CPTDATA=$$CPTA^PXRMCSU(VARIEN) ;All CPT data
130 ...I ($P(CPTDATA,"^",7)=0) D
131 ....S IADATE=$$CONV^PXRMCSU($P(CPTDATA,"^",8)) ;Convert Inac Date
132 ....S VARCODE=$$CPT^PXRMCSU(VARIEN) ;Code
133 ....S VARDESC=$$CPTD^PXRMCSU(VARIEN) ;Description
134 ....S VARPAST=$P(CPTDATA,"^",11)
135 ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
136 .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
137 .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element description
138 ....D TMP
139 ..;================ICD9=================================
140 ..N VARIEN,ICD9DATA,IADATE,VARCODE,VARDESC,VARPAST,VARTYP,VARDIS,VART
141 ..I $P(VAR3,";",2)="ICD9(",((GLOBAL="ICD9")!(GLOBAL="ALL")) D
142 ...S FILE="ICD9"
143 ...S VARIEN=$P(VAR3,";",1) ;Ien from variable pointer
144 ...S ICD9DATA=$$ICD9A^PXRMCSU(VARIEN) ;All ICD9 data
145 ...I ($P(ICD9DATA,"^",10)=0) D
146 ....S IADATE=$$CONV^PXRMCSU($P(ICD9DATA,"^",12)) ;Conver Inac date
147 ....S VARCODE=$$ICD9^PXRMCSU(VARIEN) ;Code
148 ....S VARDESC=$$ICD9D^PXRMCSU(VARIEN) ;Description
149 ....S VARPAST=$P(ICD9DATA,"^",19)
150 ....D GETS^DIQ(801.41,IEN,"3;4","E","VART") S VARIENX=IEN_"," D
151 .....S VARTYP=$G(VART(801.41,VARIENX,4,"E")) ;element type
152 .....S VARDIS=$G(VART(801.41,VARIENX,3,"E")) ;element desc
153 ....D TMP
154 Q
155SUB ;==============Sub Routines=============================
156 ;SET MAIL MESSAGE LINE
157TMP ;Set tmp global lines
158 X LINE S @TMP=" "_FILE_" "_ITEM_": "_VARCODE_" (Inactive "_$G(IADATE)_")"
159 S VARDIS=$S($G(VARDIS)'="":"(Disabled)",1:"(Enabled)")
160 S VARTYP=$G(VARTYP)
161 X LINE S @TMP=" Found in: "_DLGNAME_" ["_VARTYP_"]"_" "_VARDIS
162 D PARENT(IEN)
163 Q
164MESS ;Mail Message Static Text
165 Q
166MESS1 ;
167 N GLOBALX
168 S GLOBALX=$S(GLOBAL="ICPT":"CPT",GLOBAL="ICD9":"ICD9",GLOBAL="ALL":"CPT and/or ICD9",1:"")
169 I $G(OPTION)=1 S MESS1="Review of inactive codes as of "_$$CONV^PXRMCSU(DT)
170 I $G(OPTION)="" S MESS1="There was a "_GLOBALX_" code set update on "_$$CONV^PXRMCSU(DT)
171 Q
172MESS2 ;
173 ;;
174 ;;Please review the FINDING ITEM and ADDITIONAL FINDING items
175 ;;currently used by REMINDER DIALOGS that may need changes.
176 ;;
177 ;;Consider adding another ADDITIONAL FINDING item to the reminder dialog
178 ;;entry which will be active. This will allow the dialog to have old
179 ;;and new codes associated with a dialog element, which will use
180 ;;the item that is active for the encounter date.
181 ;;Eventually, the inactive FINDING ITEM or ADDITIONAL FINDING items
182 ;;should be removed from the dialog element.
183 ;;
184 ;;Note: FI=FINDING ITEM field AFI=ADDITIONAL FINDING ITEMS field
185 ;;Note: [finding type] (status)
186 ;;_______________________________________________________________________________
187 Q
188MESS3 ;
189 ;;Report of Inactive ICD9 and CPT Codes referenced in the Reminder
190 ;;Dialog file.
191 ;;
192 ;;Note: FI=FINDING ITEM field AFI=ADDITIONAL FINDING ITEMS field
193 ;;Note: [finding type] (status)
194 ;;_______________________________________________________________________________
195 Q
196TEXT ;display text
197 N MESS1,PXRMI
198 I GLOBAL="ALL" D
199 .F PXRMI=1:1:6 X LINE S @TMP=$P($T(MESS3+PXRMI),";",3)
200 I GLOBAL'="ALL" D
201 .D MESS1 X LINE S @TMP=MESS1
202 .F PXRMI=1:1:14 D
203 ..X LINE S @TMP=$P($T(MESS2+PXRMI),";",3)
204 Q
205PARENT(PARXY) ;Get the Parent Dialog Element of the Dialog Element
206 N PARY,PARXYVAR,PARX,PXRMTYPE
207 S PARX=0 F S PARX=$O(^PXRMD(801.41,PARX)) Q:PARX<1 D
208 .S PARY=0 F S PARY=$O(^PXRMD(801.41,PARX,10,"D",PARY)) Q:PARY<1 D
209 ..I PARXY=PARY D GETS^DIQ(801.41,PARX,"3;4","E","PXRMTYPE") D
210 ...S PARXYVAR=PARX_",",VARDIS=$G(PXRMTYPE(801.41,PARXYVAR,3,"E")),VARDIS=$S($G(VARDIS)'="":"(Disabled)",1:"(Enabled)")
211 ...X LINE S @TMP=" Used by: "_$P($G(^PXRMD(801.41,PARX,0)),"^",1)_" ["_$G(PXRMTYPE(801.41,PARXYVAR,4,"E"))_"]"_" "_VARDIS
212 X LINE S @TMP="___________________________________________________________________________"
213 Q
Note: See TracBrowser for help on using the repository browser.