source: FOIAVistA/trunk/r/PROBLEM_LIST-GMPL/GMPLBLCK.m@ 1114

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1GMPLBLCK ;SLC/JFR - check selection list ICD9 codes; 3/20/03 09:05
2 ;;2.0;Problem List;**28**;Aug 25, 1994
3 ;
4 ; This routine invokes IA #3990
5 Q
6CSVPEP ;called from protocol GMPL SELECTION LIST CSV EVENT
7 N CAT,LN,LST,LIST,XMSUB,XMTEXT,XMDUZ,XMY
8 D CKLISTS,CKCODES
9 K ^TMP("GMPLMSG",$J)
10 S LN=1
11 I $D(^TMP("GMPLSL",$J,"I")) D
12 . S ^TMP("GMPLMSG",$J,LN)="The following Problem Selection Lists contain one or more problems that",LN=LN+1
13 . S ^TMP("GMPLMSG",$J,LN)="have inactive ICD-9 codes attached to them. Any current users or clinics using",LN=LN+1
14 . S ^TMP("GMPLMSG",$J,LN)="these Selection Lists, will not be able to add the problems with inactive ",LN=LN+1
15 . S ^TMP("GMPLMSG",$J,LN)="codes, until the list and the inactive codes are updated. The list may not be",LN=LN+1
16 . S ^TMP("GMPLMSG",$J,LN)="assigned to any additional users or clinics until updated.",LN=LN+1
17 . S LST=0
18 . F S LST=$O(^TMP("GMPLSL",$J,"I",LST)) Q:'LST D
19 .. S ^TMP("GMPLMSG",$J,LN)=" "_^TMP("GMPLSL",$J,"I",LST)
20 .. S LN=LN+1
21 ;
22 I $D(^TMP("GMPLSL",$J,"F")) D ;no future inact. dates
23 . S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
24 . S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
25 . S ^TMP("GMPLMSG",$J,LN)="The following Problem Selection List categories contain problems with ICD9 ",LN=LN+1
26 . S ^TMP("GMPLMSG",$J,LN)="codes that have a future inactivation date. These Categories should be updated",LN=LN+1
27 . S ^TMP("GMPLMSG",$J,LN)="as soon as possible after the inactivation date to reduce the interruption of",LN=LN+1
28 . S ^TMP("GMPLMSG",$J,LN)="use of the selection list(s) by users or clinics.",LN=LN+1
29 . S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
30 . S CAT=0
31 . F S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT D
32 .. S ^TMP("GMPLMSG",$J,LN)=" Category name: "_$$GET1^DIQ(125.11,CAT,.01)
33 .. S LN=LN+1
34 .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
35 .. S ^TMP("GMPLMSG",$J,LN)=" Problems with ICD9 codes due to be inactivated:",LN=LN+1
36 .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
37 .. N PROB,TXT
38 .. S PROB=0
39 .. F S PROB=$O(^TMP("GMPLSL",$J,"F",CAT,PROB)) Q:'PROB D
40 ... S TXT=^TMP("GMPLSL",$J,"F",CAT,PROB)
41 ... S ^TMP("GMPLMSG",$J,LN)=" Problem text: "_$P(TXT,U),LN=LN+1
42 ... S ^TMP("GMPLMSG",$J,LN)=" Display text: "_$P(TXT,U,2),LN=LN+1
43 ... S ^TMP("GMPLMSG",$J,LN)=" Code: "_$P(TXT,U,3),LN=LN+1
44 ... S ^TMP("GMPLMSG",$J,LN)=" Inactive Date: "_$$FMTE^XLFDT($P(TXT,U,4),2),LN=LN+1
45 ... S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
46 .. I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q ; category not part of lists
47 .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
48 .. S ^TMP("GMPLMSG",$J,LN)=" This Category is part of the following Problem Selection Lists:",LN=LN+1
49 .. S LIST=0
50 .. F S LIST=$O(^TMP("GMPLSL",$J,"F",CAT,"L",LIST)) Q:'LIST D
51 ... S ^TMP("GMPLMSG",$J,LN)=" "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST)
52 ... S LN=LN+1
53 .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
54 .. S ^TMP("GMPLMSG",$J,LN)="",LN=LN+1
55 .. Q
56 I '$D(^TMP("GMPLSL",$J)) D ; no problems found
57 . S ^TMP("GMPLMSG",$J,LN)="No Problems Selection List corrections/review required"
58 . S LN=LN+1
59 S XMY("G.GMPL CODE SET VERSION UPDATES")=""
60 S XMSUB="Problem Selection List Code Set Version review"
61 S XMDUZ="Code Set Version Install"
62 S XMTEXT="^TMP(""GMPLMSG"",$J,"
63 D ^XMD
64 K ^TMP("GMPLSL",$J),^TMP("GMPLMSG",$J)
65 Q
66 ;
67CSVOPT ; called from option GMPL SELECTION LIST CSV CHECK
68 ;
69 N %ZIS,POP
70 S %ZIS="QM" D ^%ZIS Q:POP
71 I $D(IO("Q")) D D ^%ZISC,HOME^%ZIS Q
72 . N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
73 . S ZTDESC="Review of GMPL SEL LISTS for CSV"
74 . S ZTRTN="QUEUE^GMPLBLCK",ZTIO=ION,ZTDTH=$H
75 . D ^%ZTLOAD
76 . I '$G(ZTSK) W !,"Unable to task report"
77 . Q
78 ;
79QUEUE ; entry point for tasked report
80 I $D(ZTQUEUED) S ZTREQ="@"
81 U IO
82 N CAT,LN,LST,LIST,PAGE
83 D CKLISTS,CKCODES
84 S PAGE=1 D PAGE(.PAGE)
85 I '$D(^TMP("GMPLSL",$J)) D ; no problems found
86 . W !,"No Problems Selection List corrections/review required"
87 . I $E(IOST,1,2)="C-" D
88 .. N DIR,DTOUT,DIRUT,DUOUT,X,Y
89 .. S DIR(0)="E" D ^DIR
90 . Q
91 ;
92 I $D(^TMP("GMPLSL",$J,"I")) D ; some inactive problem codes
93 . W !,"The following Problem Selection List(s) contain one or more problems that"
94 . W !,"have inactive ICD-9 codes attached to them. Any current users or clinics using"
95 . W !,"these Selection Lists, will not be able to add the problems with inactive "
96 . W !,"codes, until the list and the inactive codes are updated. The list may not be"
97 . W !,"assigned to any additional users or clinics until updated.",!
98 . S LST=0
99 . F S LST=$O(^TMP("GMPLSL",$J,"I",LST)) Q:'LST!(PAGE<1) D
100 .. I IOSL-$Y<3 D PAGE(.PAGE) Q:'PAGE
101 .. W !," "_^TMP("GMPLSL",$J,"I",LST)
102 ;
103 I $D(^TMP("GMPLSL",$J,"F")) D ; future inact. dates
104 . D PAGE(.PAGE) Q:'PAGE
105 . W !,"The following Problem Selection List categories contain problems with ICD9 "
106 . W !,"codes that have a future inactivation date. These Categories should be updated"
107 . W !,"as soon as possible after the inactivation date to reduce the interruption of"
108 . W !,"use of the selection list(s) by users or clinics.",!
109 . S CAT=0
110 . F S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT D
111 .. I IOSL-$Y<8 D PAGE(.PAGE) Q:'PAGE
112 .. W !!!," Category name: "_$$GET1^DIQ(125.11,CAT,.01),!
113 .. W !," Problems with ICD9 codes due to be inactivated:",!
114 .. N PROB,TXT
115 .. S PROB=0
116 .. F S PROB=$O(^TMP("GMPLSL",$J,"F",CAT,PROB)) Q:'PROB!(PAGE<1) D
117 ... S TXT=^TMP("GMPLSL",$J,"F",CAT,PROB)
118 ... I IOSL-$Y<5 D PAGE(.PAGE) Q:'PAGE
119 ... W !," Problem text: "_$P(TXT,U)
120 ... W !," Display text: "_$P(TXT,U,2)
121 ... W !," Code: "_$P(TXT,U,3)
122 ... W !," Inactive Date: "_$P(TXT,U,4),!
123 .. I '$D(^TMP("GMPLSL",$J,"F",CAT,"L")) Q ; category not part of lists
124 .. I IOSL-$Y<3 D PAGE(.PAGE) Q:'PAGE
125 .. W !!," This Category is part of the following Problem Selection Lists:",!
126 .. S LIST=0
127 .. F S LIST=$O(^TMP("GMPLSL",$J,"F",CAT,"L",LIST)) Q:'LIST!(PAGE<1) D
128 ... I IOSL-$Y<3 D PAGE(.PAGE) Q:'PAGE
129 ... W !," "_^TMP("GMPLSL",$J,"F",CAT,"L",LIST)
130 .. Q
131 . Q
132 D:$E(IOST,1,2)'="C-" ^%ZISC
133 D HOME^%ZIS
134 K ^TMP("GMPLSL",$J)
135 Q
136 ;
137CKLISTS ; loop lists and see if any inactive problems
138 ;
139 ; returns ^TMP("GMPLSL",$J,"I"
140 ;
141 K ^TMP("GMPLSL",$J,"I")
142 N LST
143 S LST=0
144 F S LST=$O(^GMPL(125,LST)) Q:'LST I '$$VALLIST^GMPLBLD2(LST) D
145 . S ^TMP("GMPLSL",$J,"I",LST)=$P(^GMPL(125,LST,0),U)
146 . Q
147 Q
148 ;
149CKCODES ; check probs on lists for future inactivation dates
150 ;
151 ; returns:
152 ; ^TMP("GMPLSL",$J,"F",category,problem)
153 ; ^TMP("GMPLSL",$J,"F",category,"L",list)
154 ;
155 K ^TMP("GMPLSL",$J,"F")
156 N PROB,CAT,LIST
157 S PROB=0
158 F S PROB=$O(^GMPL(125.12,PROB)) Q:'PROB I $L($P(^(PROB,0),U,5)) D
159 . N PROB0,PROBTX,APIDATA,PROBCAT,ACTDT
160 . S PROB0=^GMPL(125.12,PROB,0)
161 . I '$$STATCHK^ICDAPIU($P(PROB0,U,5),DT) Q ;already inactive
162 . S APIDATA=$$HIST^ICDAPIU($P(PROB0,U,5),.APIDATA)
163 . S ACTDT=+$O(APIDATA(DT))
164 . Q:'ACTDT ; no future activity
165 . I $G(APIDATA(ACTDT)) Q ; no future inactivation = OK
166 . S PROBTX=$$GET1^DIQ(125.12,PROB,2)
167 . S PROBCAT=$P(PROB0,U)
168 . S ^TMP("GMPLSL",$J,"F",PROBCAT,PROB)=PROBTX_U_$P(PROB0,U,4)_U_$P(PROB0,U,5)_U_$$FMTE^XLFDT(ACTDT)
169 . Q
170 ;
171 ; find lists that contain the categories
172 S CAT=0
173 F S CAT=$O(^TMP("GMPLSL",$J,"F",CAT)) Q:'CAT D
174 . I '$D(^GMPL(125.1,"G",CAT)) Q ; category not part of any lists
175 . N LIST S LIST=0
176 . F S LIST=$O(^GMPL(125.1,"G",CAT,LIST)) Q:'LIST D
177 .. S ^TMP("GMPLSL",$J,"F",CAT,"L",LIST)=$$GET1^DIQ(125.1,LIST,.01)
178 .. Q
179 . Q
180 Q
181 ;
182PAGE(NUM) ;print header and raise page number
183 Q:'$G(NUM)
184 I NUM'=1,$E(IOST,1,2)="C-" D Q:'NUM
185 . N DIR,DTOUT,DIRUT,DUOUT,X,Y
186 . S DIR(0)="E" D ^DIR
187 . I $D(DTOUT)!($D(DUOUT)) S NUM=0
188 W @IOF
189 W "Code Set Version review of Problem Selection Lists"
190 W ?70,"Page: ",NUM
191 W !,$$REPEAT^XLFSTR("-",78)
192 S NUM=NUM+1
193 Q
Note: See TracBrowser for help on using the repository browser.