Produced by Araxis Merge on 2/19/2019 12:20:47 PM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | C:\AraxisMergeCompare\Pri_un\EPIP combined\GMRC_3.0_101 | EPIP_Remediation_Plan_(GMRC_3.0_101).doc | Tue Feb 12 17:06:54 2019 UTC |
2 | C:\AraxisMergeCompare\Pri_re\EPIP combined\GMRC_3.0_101 | EPIP_Remediation_Plan_(GMRC_3.0_101).doc | Tue Feb 19 12:43:42 2019 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 4 | 2670 |
Changed | 3 | 8 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | EPIP_Remed iation_Pla n_(PatchNu m)Existing Product I ntake Prog ram (EPIP) | |
2 | Patch GMRC *3.0*101 | |
3 | Remediatio n Plan | |
4 | ||
5 | Department of Vetera ns Affairs | |
6 | January 20 19 | |
7 | Version 2. 0 | |
8 | Revision H istory | |
9 | DateVersio nDescripti onAuthor01 /11/20192. 0Updates t hroughoutE PIP Projec t Team04/0 3/20181.0I nitial (dr aft) versi onEPIP Pro ject Team+ | |
10 | Table of C ontents | |
11 | 11. | |
12 | Introducti on | |
13 | ||
14 | ||
15 | 12. | |
16 | Purpose | |
17 | ||
18 | ||
19 | 13. | |
20 | Patch Desc ription | |
21 | ||
22 | ||
23 | 23.1. | |
24 | Business E pics and S ub-Epics | |
25 | ||
26 | ||
27 | 34. | |
28 | Points of Contact | |
29 | ||
30 | ||
31 | 35. | |
32 | Code Remed iation | |
33 | ||
34 | ||
35 | 35.1. | |
36 | Standards and Conven tions | |
37 | ||
38 | ||
39 | 35.2. | |
40 | Review and Analysis | |
41 | ||
42 | ||
43 | 35.3. | |
44 | Coding Cha nges | |
45 | ||
46 | ||
47 | 46. | |
48 | Testing | |
49 | ||
50 | ||
51 | 46.1. | |
52 | Test Plan | |
53 | ||
54 | ||
55 | 46.2. | |
56 | Test Envir onment | |
57 | ||
58 | ||
59 | 46.3. | |
60 | Test Readi ness Revie w | |
61 | ||
62 | ||
63 | 56.4. | |
64 | Testing Ph ases | |
65 | ||
66 | ||
67 | 56.4.1. | |
68 | Unit Testi ng | |
69 | ||
70 | ||
71 | 56.4.2. | |
72 | Component Integratio n and Syst ems Testin g (CI/ST) | |
73 | ||
74 | ||
75 | 56.4.3. | |
76 | Functional Testing | |
77 | ||
78 | ||
79 | 56.4.4. | |
80 | Regression Testing | |
81 | ||
82 | ||
83 | 56.4.5. | |
84 | Section 50 8 Complian ce Testing | |
85 | ||
86 | ||
87 | 57. | |
88 | Documentat ion Remedi ation | |
89 | ||
90 | ||
91 | 67.1. | |
92 | User Guide s | |
93 | ||
94 | ||
95 | 67.2. | |
96 | Installati on Guides | |
97 | ||
98 | ||
99 | 67.3. | |
100 | Technical Manuals | |
101 | ||
102 | ||
103 | 67.4. | |
104 | Operations Manuals | |
105 | ||
106 | ||
107 | 68. | |
108 | Project Re porting | |
109 | ||
110 | ||
111 | 69. | |
112 | Project Sc hedule | |
113 | ||
114 | ||
115 | 610. | |
116 | Deployment | |
117 | ||
118 | ||
119 | 611. | |
120 | Sustainmen t Requirem ents | |
121 | ||
122 | ||
123 | 712. | |
124 | Maintenanc e and Know ledge Tran sfer | |
125 | ||
126 | ||
127 | 8Appendix A: | |
128 | XINDEX Lis ting for M UMPS Code Changes | |
129 | ||
130 | ||
131 | 9Appendix B: | |
132 | Source Cod e Changes | |
133 | ||
134 | ||
135 | ||
136 | ||
137 | Introducti on | |
138 | The Depart ment of Ve terans Aff airs (VA) currently utilizes t he Veteran s Health I nformation Systems a nd Technol ogy Archit ecture (Vi stA) suite of applic ations to provide cl inical, fi nancial, i nfrastruct ure, and m anagement tools. The process o f advancin g “Class 3 ” field-de veloped Vi stA softwa re to “Cla ss 1” nati onally-dis tributed s tatus is r eferred to as the Ex isting Pro duct Intak e Program (EPIP). Th e VA’s goa l is to su pplement o ngoing act ivities as sociated w ith evalua ting and a dvancing f ield-devel oped softw are to a s tate that meets nati onal stand ards and f acilitates release f or Veteran s Health A dministrat ion (VHA)- wide use. | |
139 | Purpose | |
140 | The purpos e of this document i s to fully describe the remedi ation plan to be use d for the successful remediati on of the intake pro duct code to be depl oyed as pa tch GMRC*3 .0*101. Th is patch a ddresses t he followi ng NSRs: | |
141 | NSR2018011 1 Suppress CP Alerts for Perso n(s) that Ordered Co nsult | |
142 | This NSR h as been im plemented locally at the VA Me dical Cent ers in Dur ham NC and Richmond VA. | |
143 | NSR 201801 12 Consult Tracking for DOD | |
144 | This NSR h as been im plemented locally at the Capta in James A . Lovell F ederal Hea lth Care C enter in N orth Chica go IL. | |
145 | This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation, and delive ry of this remediati on effort. | |
146 | Patch Desc ription | |
147 | - ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --------- | |
148 | PLEASE NOT E | |
149 | To suppres s New Note alerts, e xisting sy stem param eter ORB S YSTEM ENAB LE/DISABLE must be s et to Enab le at the local site . | |
150 | To enable consult al erts via H L7 message s, the JVG MR 1.0 pac kage must already be installed at the lo cal site. This packa ge support s VA-to-Do D interfac e capabili ties and w as develop ed by the James A. L ovell Fede ral Health Care Cent er (JAL FH CC). | |
151 | - ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --------- | |
152 | GMRC*3.0*1 01 provide s the foll owing enha ncements t o VistA: | |
153 | Modifies t he GMRCTIU 1 routine to suppres s Consult Request/Re solution ( New Note) alerts for selected consultant services. This is n ecessary t o reduce t he number of alerts received b y the Orde ring Provi der for a Clinical P rocedure ( CP). For e xample, a Primary Ca re Physici an might r equest a G astroenter ology (GI) consultat ion to eva luate a pa tient. As a result o f this eva luation, t he GI phys ician asks a GI clin ical staff member to enter a C P order fo r an endos copy. In t his case, the GI sta ff member is the Ord ering Prov ider for t he CP, and the CP or der is tie d to a con sultant se rvice such as GI CLI NICAL PROC EDURES. Wh en the pro cedure is completed, the consu ltant serv ice transm its the re sults, clo ses the co nsult, and sends an alert to t he Orderin g Provider . However, the GI st aff member who acts as the Ord ering Prov ider might order a l arge numbe r of CPs f rom the co nsultant s ervice, an d does not need to b e alerted each time a CP is co mpleted. | |
154 | This patch adds para meter GMRC NEW NOTE ALERT DISA BLE to the PARAMETER DEFINITIO N file (#8 989.51). T he paramet er is used to add co nsultant s ervices an d enable o r disable the suppre ssion of a lerts for those serv ices. A Ph armacy Inf ormaticist or Automa ted Data P rocessing Applicatio n Coordina tor (ADPAC ) at each site can a ccess the parameter through th e new Cons ult New No te Suppres sion [GMRC NEW NOTE PARAMETER EDIT] opti on, locate d on the G MRC MGR me nu. | |
155 | Enables De partment o f Defense (DoD) prov iders who order cons ults throu gh VA to r eceive con sult alert s via Heal th Level 7 (HL7) mes sages rega rdless of the consul t status. Currently, VistA sen ds alerts to DoD pro viders onl y when a c onsult is completed. DoD provi ders do no t receive alerts gen erated for pending c onsults, s uch as ale rts regard ing schedu ling or si gnificant findings. By providi ng all nec essary con sult alert s, this pa tch enable s improved informati on exchang e between VA and DoD systems, and suppor ts ongoing integrati on between the two o rganizatio ns. | |
156 | This patch adds syst em-level p arameter G MRC DOD CM NT SIGF ME SSAGE to t he PARAMET ER DEFINIT ION file ( #8989.51). If the pa rameter is set to ON (Yes), an d if the J VGMR 1.0 p ackage is installed at the loc al site, t hen VistA will send pending co nsult aler ts to DoD providers via HL7 me ssages. If the param eter is se t to OFF ( No), then there are no changes to curren t function ality, and VistA wil l send ale rts to DoD providers only for completed consults. Initially, the param eter is se t to OFF ( No). A Pha rmacy Info rmaticist or ADPAC a t each sit e can acce ss the par ameter thr ough the n ew DOD Pen ding Consu lt Message s ON/OFF [ GMRC DOD C MNT MESSAG E ON/OFF] option, lo cated on t he GMRC MG R menu. | |
157 | Business E pics and S ub-Epics | |
158 | The Busine ss Epics a nd Sub-Epi cs for the NSR(s) ad dressed in this reme diation ar e: | |
159 | NSR2018011 1 Suppress CP Alerts for Perso n(s) that Ordered Co nsult: | |
160 | BUSINESS E PIC 971473 : Suppress CP Alerts for Order ing Provid er – For C linicians who order Clinical P rocedures, a modific ation to s uppress a New Note A lert that prevents a n alert fr om being s ent to the provider ordering t he procedu re. Unlike the curre nt solutio n that sen ds an aler t to the o rdering pr ovider who is alread y aware th at the pro cedure has been perf ormed, our process r educes the number of inefficie nt alerts/ notificati ons being sent to cl inical sta ff when th ose alerts /notificat ions are n ot necessa ry. | |
161 | NSR2018011 2 Consult Tracking f or DOD: | |
162 | BUSINESS E PIC 972722 : DoD Cons ult Update s on Patie nts Treate d at VA – For DoD Pr oviders wh o order co nsults for patients that will be perform ed at a VA facility, a communi cation tha t informs the DoD pr ovider of actions ta ken on the consult. Unlike the current s olution th at does no t send inf ormation s uch as whe n the cons ult is sch eduled, co mments abo ut resched uling, or other even ts such as when ther e are sign ificant fi ndings, ou r process enhances t he communi cation bet ween the D oD provide r requesti ng the con sult and t he VA staf f providin g the serv ice so tha t the orde ring provi der is kep t informed when acti ons are ta ken on the consult a nd the pat ient recei ves the be st care po ssible. | |
163 | Points of Contact | |
164 | The VA Poi nt of Cont act (POC) for NSR201 80111 Supp ress CP Al erts for P erson(s) t hat Ordere d Consult is Richard Reeves ( HYPE R LINK "PII " PII ) . | |
165 | The VA Poi nt of Cont act (POC) for NSR201 80112 Cons ult Tracki ng for DOD is David Douglas (
|
|
166 | Code Remed iation | |
167 | Leidos wil l review a nd analyze the intak e product code for c ompliance with codin g standard s, pointer s, shared tables, de pendencies , and any interferen ce with Vi stA system s. | |
168 | Standards and Conven tions | |
169 | Leidos wil l referenc e the http ://go. DNS /sacc webs ite for ap plicable d ocuments a nd will ad here to VA standards to comple te the ana lysis of t his intake product. The output of the VA XINDEX ut ility will be used t o analyze the MUMPS source cod e and docu ment the a ffected ro utines (se e Appendix A). | |
170 | The MUMPS coding sta ndards web site http: //71.174.6 2.16/Demo/ AnnoStd wi ll also be used to e nsure that the remed iated code conforms to VA stan dards. | |
171 | Review and Analysis | |
172 | Review and analysis of this in take produ ct involve s two part s: 1) veri fication t hat the so urce code changes sp ecified in this docu ment provi de the des ired effec t, and 2) verificati on that th e source c ode change s do not a dversely a ffect any other Vist A or CPRS functional ity. | |
173 | Testing wi ll be perf ormed to v alidate th at the int ended effe ct of thes e products is implem ented, and that no o ther VistA or CPRS G raphical U ser Interf ace (GUI) functional ity is adv ersely aff ected. | |
174 | Coding Cha nges | |
175 | The coding changes r equired fo r NSR20180 111 Suppre ss CP Aler ts for Per son(s) tha t Ordered Consult ar e in the f ollowing r outine: | |
176 | Modified M UMPS routi nes: GMRCT IU1 | |
177 | New MUMPS routines: GMRC101P | |
178 | The coding changes r equired fo r NSR20180 112 Consul t Tracking for DOD a re in the following routines: | |
179 | Modified M UMPS routi nes: GMRCA SF, GMRCAC MT, GMRCGU IB | |
180 | New MUMPS routines: None | |
181 | A detailed analysis of the cod ing change s is provi ded in App endix B. | |
182 | Testing | |
183 | Leidos wil l perform all testin g-related activities to ensure that the remediated code meet s the expe ctations o f the VA b usiness ow ner. | |
184 | Test Plan | |
185 | Leidos wil l configur e the test environme nt, provid e code mod ifications and end-t o-end test ing, and d eliver app licable te sting docu mentation, following Veteran-f ocused Int egration P rocess (VI P) guideli nes. | |
186 | The Leidos developer will modi fy the sof tware purs uant to th e VA stand ards defin ed in the Standards and Conven tions sect ion of thi s document , and will conduct f ull unit t esting of the functi onality an d verify p erformance of all so ftware cod e before i t is relea sed to Lei dos SQA. S QA will th en perform all appli cable test ing types as describ ed in the Testing Ph ases secti on of this document. The devel oper and S QA will re solve prob lems and a ddress iss ues as the y arise du ring testi ng and wil l document issues us ing the Ra tional Tea m Concert (RTC) defe ct trackin g tool. | |
187 | Test Envir onment | |
188 | Within fiv e working days of ap proval of this Remed iation Pla n, the dev eloper wil l configur e the deve lopment/te st environ ment on an Austin In formation Technology Center (A ITC) serve r or other VA-approv ed develop ment/test environmen t used for this inta ke product and insta ll the rem ediated Ke rnel Insta llation an d Distribu tion Syste m (KIDS) b uild or ho st file. T he environ ment will be restore d to its o riginal ba seline sta te by the VistA syst em adminis trator aft er develop ment testi ng is comp leted, fol lowed by i nstallatio n of the r emediated software. | |
189 | Upon notif ication fr om the dev eloper of test envir onment rea diness, SQ A will com mence with planned t esting act ivities. T he SQA tes t executio n and repo rting docu mentation will resid e in the R ational Qu ality Mana ger (QM) “ EPIP” Proj ect. In or der to per form testi ng of this VistA mod ification, the follo wing tools will be l everaged: Rational Q M, Reflect ions emula tor, CPRS GUI v31A ( 1.0.31.116 ), and Sna gIt. | |
190 | Test Readi ness Revie w | |
191 | Leidos wil l conduct a Test Rea diness Rev iew (TRR) at the con clusion of unit test ing to ver ify the co ntents of the softwa re to be t ested, the test sche dule, test environme nts, test participan ts, and as sociated l ogistics. Leidos wil l provide an agenda prior to t he TRR and written m inutes aft er complet ion of the TRR, in a ccordance with the P erformance Work Stat ement (PWS ). | |
192 | Testing Ph ases | |
193 | Leidos wil l perform developmen t and SQA testing ac tivities i n phases, and will p rovide all required testing do cumentatio n. | |
194 | Unit Testi ng | |
195 | The develo per will c onduct uni t testing of individ ual units of source code to de termine if they are fit for us e. | |
196 | Component Integratio n and Syst ems Testin g (CI/ST) | |
197 | Component Integratio n and Syst ems testin g will be conducted by SQA to ensure tha t connecti vity to th e VistA ap plication exists and is functi oning norm ally. SQA will recor d Passed/F ailed outc omes and c apture dis played con tent to do cument the system te sting effo rt. | |
198 | Functional Testing | |
199 | Functional testing w ill be per formed by SQA to tes t the code modificat ions. This testing w ill ensure that the software f unctionali ty is in a lignment w ith the Go vernment F urnished I nformation . SQA will record Pa ssed/Faile d outcomes and captu re display ed content to docume nt the fun ctional te sting effo rt. | |
200 | Regression Testing | |
201 | Regression testing w ill be per formed by SQA to ens ure that t he remedia ted code d oes not in troduce er rors to ex isting fun ctionality . The regr ession tes t framewor k will be kept up-to -date with manual te st cases a nd test sc ripts defi ning the i nputs and expected o utcomes. S QA will re cord Passe d/Failed o utcomes an d capture displayed content to document the regres sion testi ng effort. | |
202 | Section 50 8 Complian ce Testing | |
203 | Section 50 8 testing will be pe rformed on VistA and CPRS code when new user inter face chang es are int roduced by the devel oper. The VA-recomme nded Assis tive Techn ology tool , JAWS, wi ll be used to conduc t the 508 testing. T est result s and rela ted docume ntation wi ll be subm itted to t he VA Sect ion 508 te am in acco rdance wit h the VA 5 08 testing requireme nts. Defec ts found d uring test ing will b e assessed and remed iated by t he develop er. | |
204 | Documentat ion Remedi ation | |
205 | Leidos wil l review e xisting VA documenta tion for p ossible im pact as a result of this remed iation eff ort, and w ill make u pdates whe re applica ble. | |
206 | To determi ne the exi sting VA d ocumentati on that re quires mod ification, Leidos wi ll conduct a thoroug h review o f the docu ments curr ently avai lable from the VA So ftware Doc ument Libr ary (VDL) located at https://w ww. DNS /vdl/. Key word searc hes using terms rele vant to th is remedia tion effor t will be used to id entify doc uments tha t might be impacted; those doc uments wil l then be reviewed i n their en tirety for any neede d revision s. | |
207 | The follow ing sectio ns outline the VDL d ocuments t o be revis ed for thi s remediat ion. | |
208 | User Guide s | |
209 | The follow ing User G uide will be updated in the VD L: | |
210 | Consult/Re quest Trac king User Manual | |
211 | CPRS User Guide: GUI Version | |
212 | Installati on Guides | |
213 | The Nation al Patch M odule Patc h Descript ion docume nt for thi s remediat ion will p rovide the procedure for insta lling the KIDS build or host f ile into t he VA Pre- Production environme nts. There fore, no I nstallatio n Guides w ill be upd ated. | |
214 | Technical Manuals | |
215 | The follow ing Techni cal Manual will be u pdated in the VDL: | |
216 | Consult/Re quest Trac king Techn ical Manua l | |
217 | Operations Manuals | |
218 | No Operati ons Manual s require revision a s a result of this m odificatio n. | |
219 | Project Re porting | |
220 | Leidos wil l provide interim pr ogress upd ates durin g daily Sc rum calls and weekly managemen t calls wi th VA repr esentative s. | |
221 | Project Sc hedule | |
222 | Leidos wil l follow t he Scrum A gile metho dology for software developmen t. It is a nticipated that this patch wil l require five 2-wee k sprints. | |
223 | Deployment | |
224 | Leidos wil l create a KIDS buil d or host file conta ining the software c hanges nec essary to fulfill th e requirem ents for t his remedi ation effo rt. The ne w build or host file , along wi th all rel ated docum entation, will be de livered to the Contr acting Off ice Repres entative ( COR) for a cceptance. If accept ed, these deliverabl es can the n be relea sed for na tional VA consumptio n; otherwi se, Leidos will corr ect any de fects foun d and repe at the nec essary rem ediation a ctivities. | |
225 | Sustainmen t Requirem ents | |
226 | Leidos wil l provide maintenanc e support for 60 day s to the V A to suppo rt the fin al Class 1 product a fter it is nationall y released . | |
227 | Maintenanc e and Know ledge Tran sfer | |
228 | To facilit ate contin uous proce ss improve ment, Leid os will de liver Spri nt Review and Retros pective sl ides and a Lessons L earned Rep ort to VA upon compl etion of t he final s print. | |
229 | XINDEX Lis ting for M UMPS Code Changes | |
230 | The XINDEX tool is t he standar d tool use d by the V A to analy ze MUMPS s ource code . Followin g is a lis ting of th e results of the XIN DEX analys is of the affected r outines. | |
231 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
232 | [2008 V A Standard s & Conven tions] | |
233 | UC I: VISTA C PU: ROU Jan 09, 2 019@12:18: 46 | |
234 | The BUILD file Data Dictionari es are bei ng process ed. | |
235 | The option and funct ion files are being processed. | |
236 | Routines a re being p rocessed. | |
237 | Routines: 5 Faux Ro utines: 1 | |
238 | GMRC101P GMRCACMT GMRCASF GMRCGUIB GMRCTIU1 | |
239 | Data Dicti onaries | |
240 | |opt | |
241 | --- CROSS REFERENCIN G --- | |
242 | Compiled l ist of Err ors and Wa rnings Jan 09, 20 19@12:18:4 6 page 1 | |
243 | No errors or warning s to repor t | |
244 | --- END -- - | |
245 | Source Cod e Changes | |
246 | This appen dix displa ys the Vis tA code be fore and a fter the u pdates req uired for this code modificati on were im plemented. The follo wing routi nes were a ffected: | |
247 | Modified M UMPS routi nes: GMRCT IU1, GMRCA CMT, GMRCA SF, GMRCGU IB | |
248 | New MUMPS routines: GMRC101P | |
249 | GMRCTIU1 | |
250 | Before: | |
251 | GMRCTIU1 ; SLC/JER - More CT/TI U interfac e modules ;7/9/2003 [7/9/03 1: 51pm] | |
252 | ;;3.0;CONS ULT/REQUES T TRACKING ;**1,4,21, 17,34,46** ;DEC 27, 1 997;Build 23 | |
253 | ;CEM/DUR L ocal Mod a dded STATU S+25 4-8-2 013 | |
254 | ;Update or der | |
255 | S GMRCORNP =$P(^GMR(1 23,+GMRCO, 0),"^",14) | |
256 | D EN^GMRCH L7(GMRCDFN ,+GMRCO,$G (GMRCTYPE) ,$G(GMRCRB ),"RE",GMR CORNP,$G(G MRCVSIT),. GMRCOM) | |
257 | ; | |
258 | ;CEM/DUR N ext lines added to s et Request Service t o use it w hen making a paramet er call | |
259 | N GMRCRSV, NOALERT | |
260 | S GMRCRSV= $P(^GMR(12 3,+GMRCO,0 ),"^",5) | |
261 | ;Send a me ssage | |
262 | I $$COMPLE TE(GMRCA) D | |
263 | . N GMRCDA TA | |
264 | . S GMRCAT X="" | |
265 | . I GMRCA= 14 S GMRCA TX="New No te for " | |
266 | . ;I GMRCA =14 S GMRC ATX="New N ote for " ;local mod original line | |
267 | . I GMRCA= 14 D | |
268 | ..I $$GET^ XPAR("RSV. `"_GMRCRSV ,"GMRC NEW NOTE ALER T DISABLE" ) S NOALER T=1 Q | |
269 | ..S GMRCAT X="New Not e for " | |
270 | .Q:$G(NOAL ERT)=1 ;en d of local mods | |
271 | After: | |
272 | GMRCTIU1 ; SLC/JER - More CT/TI U interfac e modules ;7/9/2003 [7/9/03 1: 51pm] | |
273 | ;;3.0;CON SULT/REQUE ST TRACKIN G;**1,4,21 ,17,34,46, 101**;DEC 27, 1997;B uild 23 | |
274 | ;CEM/DUR Local Mod added STAT US+25 4-8- 2013 | |
275 | ; | |
276 | ;This rou tine invok es IA #269 3 | |
277 | ROLLBACK(D A,TIUDA) ; Roll-back a CT reco rd when re sult is de leted or | |
278 | ;reassign ed | |
279 | ;Disassoc iate Note logic | |
280 | ;The acti on removes the assoc iation of a TIU note with a co nsult. | |
281 | ;The new CPRS statu s will cha nge to "AC TIVE", unl ess one of the | |
282 | ;remainin g notes ha s a comple ted status . | |
283 | ;This act ion should send an a lert to th e service notificati on users. | |
284 | N DIE,DR, GMRCSTS,GM RCA,GMRCO, GMRCOM,GMR CORNP,GMRC DFN,GMRCNO DE,GMRCLIS T,GMRCD0,G MRCD1,GMRC SF,GMRCADU Z,MSGTOSRV ,GMRCATX,G MRCORTX,GM RCSTAR,GMR CERR,ACTDA ,ACTREC,GM RCLSCH,GMR CLER,GMRCR BDA,GMRCTD A,GMRCRSLT | |
285 | S GMRCNOD E=$G(^GMR( 123,+DA,0) ) | |
286 | ; If curr ent result has never been post ed, no nee d to roll back | |
287 | ; Patch G MRC*1*21 | |
288 | I '+$O(^G MR(123,+DA ,50,"B",+T IUDA_";TIU (8925,",0) ) Q | |
289 | I ($P(GMR CNODE,U,20 )=TIUDA) S DIE="^GMR (123,",DR= "16///@" D ^DIE | |
290 | S GMRCD0= DA,GMRCD1= 0 F S GMR CD1=$O(^GM R(123,GMRC D0,50,GMRC D1)) Q:'GM RCD1 D | |
291 | .N DA,DIK | |
292 | .Q:'(TIUD A=+$G(^GMR (123,GMRCD 0,50,GMRCD 1,0))) | |
293 | .S DA(1)= GMRCD0,DA= GMRCD1 | |
294 | .S DIK="^ GMR(123,"_ DA(1)_",50 ," | |
295 | .D ^DIK | |
296 | ; | |
297 | S GMRCA=1 2,GMRCO=DA | |
298 | D GETLIST ^GMRCTIUL( DA,2,1,.GM RCLIST) | |
299 | S GMRCSTS =9 | |
300 | ;Followin g if state ment and D O block ac complish t he followi ng | |
301 | ;If there are no ot her associ ated TIU D ocs then | |
302 | ;Set stat us to sche duled if i t was last status be fore the T IU doc | |
303 | ;Set stat us to pend ing if it was the la st status before the TIU doc | |
304 | ;Set stat us to acti ve otherwi se | |
305 | I '$G(GMR CLIST(0)) S GMRCSTS= 6 D | |
306 | .S ACTDA= 0,ACTREC=0 ,GMRCRBDA= 0,GMRCLER= -1,GMRCLSC H=-1 | |
307 | .F S ACT DA=$O(^GMR (123,DA,40 ,ACTDA)) Q :-ACTDA=0 D | |
308 | ..S ACTRE C=$G(^GMR( 123,DA,40, ACTDA,0)) | |
309 | ..I $P(AC TREC,U,2)= 9,$P($P(AC TREC,U,9), ";",1)=TIU DA S GMRCR BDA=ACTDA | |
310 | ..I $P(AC TREC,U,2)= 8 S GMRCLS CH=ACTDA | |
311 | ..I $P(AC TREC,U,2)= 11 S GMRCL ER=ACTDA | |
312 | .I GMRCLE R'=-1,GMRC LER>GMRCLS CH S GMRCS TS=5 | |
313 | .I GMRCLS CH'=-1,GMR CLSCH>GMRC LER S GMRC STS=8 | |
314 | E S GMRC D0="" F S GMRCD0=$O (^TMP("GMR C50",$J,GM RCD0)) Q:' $L(GMRCD0) D | |
315 | .Q:(+GMRC D0=TIUDA) | |
316 | .S GMRCD1 =0 F S GM RCD1=$O(^T MP("GMRC50 ",$J,GMRCD 0,GMRCD1)) Q:'GMRCD1 D | |
317 | ..S:($P($ G(^TMP("GM RC50",$J,G MRCD0,GMRC D1)),U,6)= "completed ") GMRCSTS =2 | |
318 | Q:$G(NOSA VE) | |
319 | ;Make sta tus comple ted if the Consult w as Admin. Completed | |
320 | S ACTDA=0 ,ACTREC=0 | |
321 | F S ACTD A=$O(^GMR( 123,DA,40, ACTDA)) Q: -ACTDA=0 D | |
322 | .S ACTREC =$G(^GMR(1 23,DA,40,A CTDA,0)) | |
323 | .I $P(ACT REC,U,2)=1 0,$P(ACTRE C,U,9)="" S GMRCSTS= 2 | |
324 | D STATUS^ GMRCP | |
325 | K ^TMP("G MRC50",$J) ,^TMP("GMR C50R",$J) | |
326 | ; | |
327 | S GMRCOM= 0,MSGTOSRV =0,GMRCRSL T=TIUDA_"; TIU(8925," D AUDIT^G MRCP | |
328 | ; | |
329 | ;Build me ssage info rmation if status ha s changed or sig fin ding="Y" | |
330 | S GMRCSF= $P(GMRCNOD E,U,19) | |
331 | I ($P(GMR CNODE,U,12 )=$P($G(^G MR(123,GMR CO,0)),U,1 2)) D Q:G MRCATX="" | |
332 | . S GMRCA TX="" Q:GM RCSF'="Y" | |
333 | . S GMRCA TX="*Remov ed consult note for " | |
334 | E S GMRC ATX=$S((GM RCSF="Y"): "*",1:"")_ "Reactivat ed consult , removed note for " ,MSGTOSRV= 1 | |
335 | S GMRCORN P=$P(GMRCN ODE,U,14), GMRCDFN=$P (GMRCNODE, U,2) | |
336 | S GMRCORT X=$$ORTX^G MRCAU(GMRC O) | |
337 | S GMRCORT X=GMRCATX_ GMRCORTX | |
338 | S:((GMRCO RNP)&(GMRC ORNP'=DUZ) ) GMRCADUZ (GMRCORNP) ="" | |
339 | S GMRCTDA =TIUDA | |
340 | D EXTRACT ^TIULQ(GMR CTDA,"GMRC STAR",.GMR CERR,.05) | |
341 | I '$G(GMR CERR) D | |
342 | .I $G(GMR CSTAR(GMRC TDA,.05,"I "))'=5 D | |
343 | ..D MSG^G MRCP(GMRCD FN,GMRCORT X,+GMRCO,2 3,.GMRCADU Z,MSGTOSRV ) | |
344 | Q:($P(GMR CNODE,U,12 )=$P($G(^G MR(123,+GM RCO,0)),U, 12)) | |
345 | ; | |
346 | ;On statu s change, send "SC" (status ch ange) HL7 msg to upd ate order | |
347 | D EN^GMRC HL7(GMRCDF N,+GMRCO,$ G(GMRCTYPE ),$G(GMRCR B),"SC",GM RCORNP,$G( GMRCVSIT), .GMRCOM) | |
348 | Q | |
349 | ; | |
350 | STATUS ;Up date the s tatus of a consult t hat has a TIU result | |
351 | N GMRCAD, GMRCATX,GM RCOA,GMRCO STS,GMRCOT FN,GMRC,GM RCSF,GMRCL AE,GMRCRSL T,GMRCADUZ ,GMRCOADT | |
352 | D GETOLD | |
353 | S GMRCORN P=$G(GMRCA UTH) ;auth or | |
354 | S GMRCRSL T=GMRCTUFN _";TIU(892 5," | |
355 | ; | |
356 | ;Evaluate whether a complete action is actually a n addendum or New no te | |
357 | I GMRCA=1 0 S GMRCA= $$EVALACT( GMRCOSTS,+ GMRCO,GMRC RSLT) | |
358 | ; | |
359 | ;Update t he status and last a ctivity fi eld | |
360 | ;Do not c hange the status if already co mpleted | |
361 | I GMRCOST S=2,GMRCST S=9 S GMRC STS=2 | |
362 | D STATUS^ GMRCP | |
363 | ; | |
364 | ;Update a ctivity lo g | |
365 | D AUDIT | |
366 | ; | |
367 | ;Update t he last TI U entry mo dified and add resul t to resul t multiple | |
368 | D ADD^GMR CTIUA(GMRC TUFN,GMRCO ) | |
369 | ; | |
370 | ;Update o rder | |
371 | S GMRCORN P=$P(^GMR( 123,+GMRCO ,0),"^",14 ) | |
372 | D EN^GMRC HL7(GMRCDF N,+GMRCO,$ G(GMRCTYPE ),$G(GMRCR B),"RE",GM RCORNP,$G( GMRCVSIT), .GMRCOM) | |
373 | ; | |
374 | N GMRCRSV ,NOALERT ; RTW NSR201 80111 | |
375 | S GMRCRSV =$P(^GMR(1 23,+GMRCO, 0),"^",5) ;RTW NSR20 180111 | |
376 | ; | |
377 | ;Send a m essage | |
378 | I $$COMPL ETE(GMRCA) D | |
379 | . N GMRCD ATA | |
380 | . S GMRCA TX="" | |
381 | . ;I GMR CA=14 S GM RCATX="New Note for " ;RTW NSR 20180111 S TART | |
382 | . I GMRCA =14 D | |
383 | . . I $$G ET^XPAR("R SV.`"_GMRC RSV,"GMRC NEW NOTE A LERT DISAB LE") S NOA LERT=1 Q | |
384 | . . S GMR CATX="New Note for " | |
385 | . Q:$G(NO ALERT)=1 ; RTW NSR201 80111 End | |
386 | . I GMRCA =13 S GMRC ATX="Adden dum Added for " | |
387 | . S GMRCA TX=$S((GMR CSF="Y"):" *",1:"")_G MRCATX | |
388 | . S GMRCO RTX=GMRCAT X_"Complet ed Consult "_$$ORTX^ GMRCAU(+GM RCO) | |
389 | . S GMRCD ATA=+GMRCO | |
390 | . S GMRCD ATA=GMRCDA TA_"|"_$G( GMRCRSLT) | |
391 | . I $P(GM RC(0),"^", 14),$P(GMR C(0),"^",1 4)'=DUZ S GMRCADUZ($ P(GMRC(0), "^",14))=" " | |
392 | . D MSG^G MRCP(GMRCD FN,GMRCORT X,GMRCDATA ,23,.GMRCA DUZ,0) | |
393 | . Q | |
394 | Q | |
395 | ; | |
396 | GETOLD ;sa ve the old values of status, a nd the las t activity data | |
397 | ;to deter mine how t o update s tatus and TIU activi ty log | |
398 | S GMRC(0) =$G(^GMR(1 23,+GMRCO, 0)) | |
399 | S GMRCDFN =$P(GMRC(0 ),"^",2) | |
400 | S GMRCSF= $P(GMRC(0) ,U,19) | |
401 | S GMRCOST S=$P(GMRC( 0),"^",12) ;status b efore acti vity | |
402 | S GMRCLAE =+$P($G(^G MR(123,+GM RCO,40,0)) ,U,3) ;las t activity entry | |
403 | S GMRC(40 )=$G(^GMR( 123,+GMRCO ,40,+GMRCL AE,0)) | |
404 | S GMRCOAD T=+$P(GMRC (40),U,1) ;last acti vity entry date | |
405 | S GMRCOA= $P(GMRC(40 ),"^",2) ; last activ ity | |
406 | S GMRCOTF N=$P(GMRC( 40),"^",9) ;last res ult | |
407 | Q | |
408 | ; | |
409 | AUDIT ;Det ermine app ropriate u pdate acti vity. | |
410 | ;Quit if new activi ty is same as previo us "Incomp lete Rpt" activity | |
411 | I GMRCOTF N=GMRCRSLT ,GMRCOA=9, GMRCOA=GMR CA,GMRCOST S=GMRCSTS Q | |
412 | ; | |
413 | S GMRCOM= 0 | |
414 | S GMRCDT= $$NOW^XLFD T | |
415 | ;Check fo r overwrit e of incom plete rpt activity i f the new | |
416 | ;activity occurs wi thin 15 mi nutes of t he last. | |
417 | S GMRCOAD T=$$FMADD^ XLFDT(GMRC OADT,0,0,1 5) | |
418 | I GMRCOTF N=GMRCRSLT ,GMRCOA=9, $$COMPLETE (GMRCA),GM RCDT<GMRCO ADT D AUDI T1 Q | |
419 | D AUDIT^G MRCP Q | |
420 | Q | |
421 | ; | |
422 | AUDIT1 ;ov erwrite la st activit y | |
423 | L +^GMR(1 23,+GMRCO, 40):5 I '$ T S GMRCUT =1,GMRCERR =1,GMRCERM S="Activit y Trail No t filed - Consult In Use By An other User ." L -^GMR (123,+GMRC O,40) Q | |
424 | S DA=$P(^ GMR(123,+G MRCO,40,0) ,"^",3) | |
425 | D AUDIT1^ GMRCP | |
426 | Q | |
427 | ; | |
428 | COMPLETE(G MRCA) ;Det ermine if the action is a comp lete actio n (10,13,1 4) | |
429 | Q $S(GMRC A=13:1,GMR CA=14:1,GM RCA=10:1,1 :0) | |
430 | ; | |
431 | EVALACT(GM RCOSTS,GMR CO,GMRCRSL T) ;Evalua te complet e action b ased on pr ev results and sts | |
432 | N EVALA,G MRCLAE | |
433 | I '$D(^GM R(123,+GMR CO,50)) Q 10 | |
434 | I GMRCOST S'=2 Q 10 | |
435 | I '$D(^GM R(123,+GMR CO,50,"B", GMRCRSLT)) Q 14 | |
436 | S EVALA=0 ,GMRCLAE=+ $P($G(^GMR (123,+GMRC O,40,0)),U ,3)+1 | |
437 | F S GMRC LAE=$O(^GM R(123,+GMR CO,40,GMRC LAE),-1) Q :'GMRCLAE D Q:+EVA LA | |
438 | . S GMRCL AE(40)=^GM R(123,+GMR CO,40,GMRC LAE,0) | |
439 | . I $P(GM RCLAE(40), U,9)=GMRCR SLT D | |
440 | .. I $P(G MRCLAE(40) ,U,2)=9 S EVALA=14 Q | |
441 | .. I $$CO MPLETE($P( GMRCLAE(40 ),U,2)) S EVALA=13 Q | |
442 | I +EVALA Q EVALA | |
443 | Q 10 | |
444 | EDPAR ; Ed it SUPPRES SION OF AL ERTS FOR A REQUEST S ERVICE. RT W NSR20181 011 | |
445 | N DIC,DA, DIE,DR,DID EL,DTOUT,G MRCPAR,GMT SCNT,GMTST ,GMTSI,GMT SORD | |
446 | S GMTSCNT =0 | |
447 | S GMRCPAR =$$FIND1^D IC(8989.51 ,"","","GM RC NEW NOT E ALERT DI SABLE") | |
448 | L ; Lock R ecord | |
449 | L +^XTV(8 989.51,GMR CPAR) S GM TSCNT=GMTS CNT+1,GMTS T=$T | |
450 | I 'GMTST, GMTSCNT'>3 H 2 G L | |
451 | I 'GMTST, GMTSCNT>3 W !," Anot her user i s editing this entry .",!," Una ble to res equence at this time ." Q | |
452 | S GMTSI=0 F S GMTS I=$O(GMTSO RD(GMTSI)) Q:+GMTSI= 0 D | |
453 | . S GMTSF I=$P(GMTSO RD(GMTSI), "^",2),GMT SEQ=$P(GMT SORD(GMTSI ),"^",1) | |
454 | D EDITPAR ^XPAREDIT( GMRCPAR) | |
455 | L -^XTV(8 989.51,GMR CPAR) | |
456 | Q ;RTW E ND NSR2018 0111 | |
457 | ========== ========== ========== ========== ========== ========== ======== | |
458 | GMRCACMT | |
459 | Before: | |
460 | GMRCACMT ; SLC/DLT,DC M,MA,JFR - Comment A ction and alerting ; 4/29/14 | |
461 | GMRCACMT ; SLC/DLT,DC M,MA,JFR - Comment A ction and alerting ; 5/26/15 1 0:51am | |
462 | ;;3.0;CONS ULT/REQUES T TRACKING ;**4,14,18 ,20,22,29, 35,47,55,7 5**;DEC 27 , 1997;Bui ld 22 | |
463 | ; | |
464 | ; This rou tine invok es IA #100 60 | |
465 | . D STATUS ^GMRCP | |
466 | S G=^GMR(1 23,GMRCO,0 ),DFN=$P(G ,"^",2),GM RCORNP=GMR CPROV | |
467 | D EN^GMRCH L7(DFN,GMR CO,$G(GMRC TYPE),$G(G MRCWARD)," SC",GMRCOR NP,$G(GMRC VIST),.GMR COM,,$G(GM RCAD)) | |
468 | D END | |
469 | Q | |
470 | After: | |
471 | GMRCACMT ; SLC/DLT,DC M,MA,JFR - Comment A ction and alerting ; 4/29/14 | |
472 | ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,14,1 8,20,22,29 ,35,47,55, 75,101**;D EC 27, 199 7;Build 22 | |
473 | ; | |
474 | ; This ro utine invo kes IA #10 060 | |
475 | ; | |
476 | COMMENT(GM RCO) ;Add a comment without ch anging the status | |
477 | K GMRCQIT ,GMRCQUT N GMRCA | |
478 | I $D(IOTM ),$D(IOBM) ,$D(IOSTBM ) D FULL^V ALM1 | |
479 | S GMRCNOW =$$NOW^XLF DT,GMRCAD= GMRCNOW | |
480 | S GMRCOM= 1,GMRCA=20 ,GMRCPROV= $P(^GMR(12 3,GMRCO,0) ,"^",14) D AUDIT^GMR CP | |
481 | ; GMRCOM= 1 defined the variab le and tel ls AUDIT^G MRCP that the | |
482 | ; word-pr ocessing l ogic shoul d be execu ted. If an actual co mment is | |
483 | ; added, $P(GMRCOM, "^",2)=1 ( send alert ), if not GMRCOM=1 a nd no '^' | |
484 | ; exists (do not se nd alert) | |
485 | I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q | |
486 | ;continue if no loc k problems occurred | |
487 | I $P(GMRC OM,"^",2) D | |
488 | . I $P($G (^GMR(123, GMRCO,12)) ,U,5)="F" D | |
489 | .. W !!," The orderi ng provide r for this inter-fac ility cons ult will" | |
490 | .. W " au tomaticall y be ",!," notified." ,! | |
491 | . D PROCA LRT("",1,2 0,GMRCO) | |
492 | . ;if a N on VA Care consult, notify HCP of the co mment | |
493 | . I $$FEE ^GMRCHL7H( $$GET1^DIQ (123,GMRCO ,1,"I")) D COMMENT^G MRCHL7H(GM RCO) | |
494 | . ;update LAST ACTI ON field e ven though no status change | |
495 | . N GMRCD R,GMRCSTS | |
496 | . S GMRCS TS="",GMRC DR="9////2 0" | |
497 | . D STATU S^GMRCP | |
498 | I $D(^XPD( 9.7,"B","J VGMR 1.0") ),$$GET^XP AR("SYS"," GMRC DOD C MNT SIGF M ESSAGE",1) D ;RTW NS R20180112 | |
499 | . D EN^GM RCHL7(DFN, GMRCO,$G(G MRCTYPE),$ G(GMRCWARD ),"SC",GMR CORNP,$G(G MRCVIST),. GMRCOM,,$G (GMRCAD)) ;RTW NSR20 180112 ORD ERS PORTAB ILITY | |
500 | ||
501 | D END | |
502 | Q | |
503 | ; | |
504 | PROCALRT(G MRCORTX,GM RCDELR,ACT ION,GMRCO) ;Process alert for comments | |
505 | ;If GMRCD ELR=1, the ordering provider c an be dele ted from t he list. | |
506 | N GMRCADU Z,GMRCANS, NOTIF,GMRC QIT,GMRCTM | |
507 | ;S GMRCAN S=$$READ(" Y","Do You Wish To S end An Ale rt With Th is Comment ","N","Ent er Y to co ntinue wit h recipien t prompts. Otherwise , enter N. ",1) | |
508 | ;I (GMRCA NS[U)!(GMR CANS=0) D END Q | |
509 | ; | |
510 | D WHOTO | |
511 | ;I $G(GMR CQIT) D EN D Q ;User "^" at req uesting pr ovider. | |
512 | ; | |
513 | N GMRCALT | |
514 | S NOTIF=$ S(ACTION=2 0:63,ACTIO N=8:63,1:2 3) | |
515 | ; | |
516 | D SENDMSG (NOTIF,+GM RCO,$G(GMR CTM)) | |
517 | Q | |
518 | ; | |
519 | SENDMSG(NO TIF,GMRCO, GMRCATM) ; Send the a lert | |
520 | N GMRCDFN | |
521 | I '$D(GMR CADUZ) S G MRCADUZ="" | |
522 | W !,"Proc essing Ale rts..." | |
523 | S GMRCDFN =$P($G(^GM R(123,+GMR CO,0)),"^" ,2) | |
524 | I '$L(GMR CORTX) D | |
525 | . N TXT | |
526 | . S TXT=" Comment Ad ded to " | |
527 | . I $P($G (^GMR(123, GMRCO,12)) ,U,5)'="P" S GMRCORT X=TXT_"con sult " Q | |
528 | . S GMRCO RTX=TXT_"r emote cons ult " | |
529 | S GMRCORT X=GMRCORTX _$$ORTX^GM RCAU(+GMRC O) | |
530 | D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,NOT IF,.GMRCAD UZ,$G(GMRC ATM)) | |
531 | Q | |
532 | ; | |
533 | END ;kill off variab les and ex it | |
534 | K GMRC,GM RCA,GMRCMS G,GMRCOM,G MRCO,GMRCO RTX,GMRCER R,GMRCERMS ,GMRCQUT,G MRCUT | |
535 | I $D(DTOU T)!$D(DIRO UT) S GMRC QIT="" | |
536 | K DTOUT,D IROUT,DUOU T,DIRUT | |
537 | S:$D(^TMP ("GMRC",$J ,"CURRENT" ,"MENU")) XQORM("HIJ ACK")=^("M ENU") | |
538 | Q | |
539 | ; | |
540 | WHOTO ;Get the users who shoul d receive an alert | |
541 | ;Asks abo ut request ing provid er first, then promp ts for add itional us ers | |
542 | ;Returns GMRCADUZ a rray of us ers to sen d an alert to and GM RCQIT if " ^" | |
543 | N GMRCRP, GMRCANS,GM RCUPD | |
544 | S GMRCRP= +$P($G(^GM R(123,+GMR CO,0)),U,1 4) ;reques ting provi der entry | |
545 | S GMRCUPD =$$VALID^G MRCAU($P(^ GMR(123,+G MRCO,0),U, 5),GMRCO,D UZ) | |
546 | I GMRCRP= DUZ D ;al ert team i f ord. pro v. takes t he action | |
547 | . S GMRCT M=1 | |
548 | . W !,"Se rvice upda te users w ill be not ified.",! | |
549 | I +GMRCUP D>1,GMRCRP '=DUZ D ; alert ord . prov if update use rs takes a ction | |
550 | . S GMRCA DUZ(GMRCRP )="" | |
551 | . W !,"Re questing p rovider wi ll be noti fied.",! | |
552 | I '$G(GMR CTM),+GMRC UPD<2 D ; alert both if not or d. prov or update us er | |
553 | . S GMRCT M=1,GMRCAD UZ(GMRCRP) ="" | |
554 | . W !,"Re questing p rovider an d service update use rs will be notified. ",! | |
555 | ; | |
556 | ; | |
557 | ANDTO ;Ask for addit ional reci pients | |
558 | D NAMELIS T("Additio nal alert recipients : ",.GMRCA DUZ,GMRCDE LR) | |
559 | Q | |
560 | ; | |
561 | NAMELIST(G MRCP,GMRCO LD,GMRCDEL R) ;manage the list of recipie nts | |
562 | ; | |
563 | ; GMRCP - Prompt | |
564 | ; GMRCOLD - Origina l list wit h ordering provider. | |
565 | ; GMRCDEL R - 1 mean s the orig inal list may have n ames delet ed | |
566 | ; Returns final lis t in GMRCO LD array | |
567 | ; | |
568 | N GMRCNEW ,GMRCNT,GM RCDUZ,GMRC USER,GMRCQ ,GMRCADD,D IC,X,Y | |
569 | ; | |
570 | M GMRCNEW =GMRCOLD | |
571 | I GMRCDEL R=1 K GMRC OLD S GMRC OLD="" ;Re move manda tory users from GMRC OLD | |
572 | S GMRCNT= 0 F D Q: (GMRCUSER[ U) | |
573 | .S GMRCUS ER=$$READ( "FAO;3;46" ,$S(GMRCNT :"And ",1: "")_GMRCP, "","^D NAM EHELP^GMRC ACMT") | |
574 | .S:'$L(GM RCUSER) GM RCUSER=U Q :(GMRCUSER [U) | |
575 | .I ($E(GM RCUSER,1)= "-") S GMR CADD=0,GMR CUSER=$E(G MRCUSER,2, $L(GMRCUSE R)) | |
576 | .E S GMR CADD=1 | |
577 | .; | |
578 | .S X=GMRC USER,DIC=2 00,DIC(0)= "EMQ" D ^D IC | |
579 | .; | |
580 | .I (Y>0) D I 1 | |
581 | ..;W $E($ P(Y,U,2),$ L(GMRCUSER )+1,$L($P( Y,U,2))) | |
582 | ..; | |
583 | ..I GMRCA DD D | |
584 | ...I $D(G MRCNEW(+Y) ) W " alre ady in the list." Q | |
585 | ...S GMRC NEW(+Y)="" W " added to the li st." S GMR CNT=GMRCNT +1 | |
586 | ..; | |
587 | ..I 'GMRC ADD D | |
588 | ...I $D(G MRCOLD(+Y) ) W " can' t delete t his name f rom the li st." Q | |
589 | ...I '$D( GMRCNEW(+Y )) W " not currently in the li st." Q | |
590 | ...K GMRC NEW(+Y) S GMRCNT=GMR CNT-1 W " deleted fr om the lis t." | |
591 | .; | |
592 | .E I $L( GMRCUSER) W " Name n ot found." | |
593 | ; | |
594 | M GMRCOLD =GMRCNEW | |
595 | Q | |
596 | ; | |
597 | READ(GMRC0 ,GMRCA,GMR CB,GMRCH,G MRCL) ;rea d logic | |
598 | ; | |
599 | ; GMRC0 - > DIR(0) - -- Type of read | |
600 | ; GMRCA - > DIR("A") - Prompt | |
601 | ; GMRCB - > DIR("B") - Default Answer | |
602 | ; GMRCH - > DIR("?") - Help te xt or ^Exe cute code | |
603 | ; GMRCL - > Number o f blank li nes to put before Pr ompt | |
604 | ; | |
605 | ; Returns "^" or an swer | |
606 | ; | |
607 | N GMRCLIN E,DIR,DTOU T,DUOUT,DI RUT,DIROUT | |
608 | Q:'$L($G( GMRC0)) U | |
609 | S DIR(0)= GMRC0 | |
610 | S:$L($G(G MRCA)) DIR ("A")=GMRC A | |
611 | S:$L($G(G MRCB)) DIR ("B")=GMRC B | |
612 | S:$L($G(G MRCH)) DIR ("?")=GMRC H | |
613 | F GMRCLIN E=1:1:($G( GMRCL)-1) W ! | |
614 | D ^DIR | |
615 | I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q U | |
616 | Q Y | |
617 | ; | |
618 | ; | |
619 | NAMEHELP ; Help for t he recipie nt list lo gic | |
620 | N GMRCDUZ | |
621 | W !,"Ente r the name of the us er to send the alert to," | |
622 | W !," or put a '-' in front o f a name t o delete f rom the li st." | |
623 | W ! | |
624 | W !," Exa mple:" | |
625 | W !," SMI TH,FRED -> to add Fr ed to the list." | |
626 | W !," -SM ITH,FRED - > to delet e Fred fro m the list ." | |
627 | W !,"Alre ady select ed: " | |
628 | W ! | |
629 | S GMRCDUZ =0 F S GM RCDUZ=$O(G MRCNEW(GMR CDUZ)) Q:' GMRCDUZ D | |
630 | .W !,?5,$ P(^VA(200, GMRCDUZ,0) ,U,1) | |
631 | .W:$D(GMR COLD(GMRCD UZ)) " <ma ndatory>" | |
632 | W ! | |
633 | Q | |
634 | ; | |
635 | EDPAR ; E dit SUPPRE SSION OF D OD ALERTS FOR COMMEN T OR SIG F INDING ON PENDING CO NSULT. ;RT W NSR20180 112 | |
636 | N DIC,DA, DIE,DR,DID EL,DTOUT,G MRCPAR,GMT SCNT,GMTST ,GMTSI,GMT SORD | |
637 | S GMTSCNT =0 | |
638 | S GMRCPAR =$$FIND1^D IC(8989.51 ,"","","GM RC DOD CMN T SIGF MES SAGE") | |
639 | L ; Lock R ecord | |
640 | L +^XTV(8 989.51,GMR CPAR) S GM TSCNT=GMTS CNT+1,GMTS T=$T | |
641 | I 'GMTST, GMTSCNT'>3 H 2 G L | |
642 | I 'GMTST, GMTSCNT>3 W !," Anot her user i s editing this entry .",!," Una ble to res equence at this time ." Q | |
643 | S GMTSI=0 F S GMTS I=$O(GMTSO RD(GMTSI)) Q:+GMTSI= 0 D | |
644 | . S GMTSF I=$P(GMTSO RD(GMTSI), "^",2),GMT SEQ=$P(GMT SORD(GMTSI ),"^",1) | |
645 | D EDITPAR ^XPAREDIT( GMRCPAR) | |
646 | L -^XTV(8 989.51,GMR CPAR) | |
647 | Q ;;RTW END NSR201 80112 | |
648 | ========== ========== ========== ========== ========== ========== ======== | |
649 | GMRCASF | |
650 | Before: | |
651 | GMRCASF ;S LC/DLT - S ignificant Findings Action ;7/ 11/03 13:2 8 | |
652 | ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,10,1 4,22,29,35 ,46**;DEC 27, 1997;B uild 23 | |
653 | SF(GMRCO) ;Evaluate Significan t Findings and updat e accordin gly | |
654 | ;GMRCO is the selec ted consul t | |
655 | N GMRCQIT ,GMRCLCK | |
656 | I '$L($G( GMRCO)) D SELECT^GMR CA2(.GMRCO ) I $D(GMR CQUT) D EN D Q | |
657 | I '+($G(G MRCO)) D E ND Q | |
658 | I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D Q | |
659 | . N DIR | |
660 | . W !,"Th e requesti ng facilit y may not take this action on an " | |
661 | . W "inte r-facility consult." | |
662 | . S DIR(0 )="E" D ^D IR | |
663 | . D END | |
664 | I '$$LOCK ^GMRCA1(GM RCO) D END Q | |
665 | S GMRCLCK =1 | |
666 | ; | |
667 | I $D(IOTM ),$D(IOBM) ,$D(IOSTBM ) D FULL^V ALM1 | |
668 | N GMRC,GM RCSTS,GMRC SF,GMRCSFO ,GMRCORTX, GMRCDR | |
669 | S GMRC(0) =$G(^GMR(1 23,+GMRCO, 0)) Q:GMRC (0)="" | |
670 | ; | |
671 | S GMRCSFO =$P(GMRC(0 ),"^",19) | |
672 | W !!,"Cur rent Signi ficant Fin dings = "_ $S(GMRCSFO ="U":"Unkn own",GMRCS FO="Y":"Ye s",GMRCSFO ="N":"No", 1:"not ent ered yet") ,!! | |
673 | S GMRCSF= $$GETSIGF( GMRCSFO) | |
674 | I GMRCSF= 0 D END Q | |
675 | ; If no c hange in o ld and new value ask if should continue | |
676 | I GMRCSF= GMRCSFO D I 'Y D EN D Q | |
677 | . W !,"Th e old and new Signif icant Find ings are t he same." | |
678 | . N DIR,D A,DTOUT,DU OUT,DIRUT, DIROUT | |
679 | . S DIR(" A")="Do yo u want to proceed wi th this ac tion" | |
680 | . S DIR(0 )="Y" | |
681 | . S DIR(" B")="NO" | |
682 | . D ^DIR | |
683 | . I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S Y= 0 Q | |
684 | . I Y=0 Q | |
685 | ; | |
686 | ;Update l ast action and sig f indings bu t don't ch ange the s tatus | |
687 | S GMRCSTS =$P(GMRC(0 ),"^",12), GMRCA=4 | |
688 | S GMRCDR= "8////^S X =GMRCSTS;9 ////^S X=G MRCA;15/// /^S X=GMRC SF" | |
689 | D STATUS^ GMRCP | |
690 | I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q | |
691 | ; | |
692 | ;GMRCOM=1 tells AUD IT^GMRCP t o do the w ord-proces sing logic | |
693 | ;If an ac tual comme nt is adde d, $P(GMRC OM,"^",2)= 1 (send al ert), | |
694 | ; if not GMRCOM=1 a nd no '^' exists (do not send alert) | |
695 | S GMRCOM= 1 D AUDIT^ GMRCP | |
696 | I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q | |
697 | ; | |
698 | I GMRCSTS =2 D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),U,2 ),GMRCO,$G (GMRCTYPE) ,$G(GMRCRB ),"RE",GMR CORNP,$G(G MRCVSIT),, ,$G(GMRCAD )) | |
699 | D SETORTX | |
700 | I GMRCSTS =2 D SENDA LRT(GMRCOR TX) Q | |
701 | I +$P(GMR COM,"^",2) D | |
702 | . W !,"An alert wit h the foll owing text will be s ent if rec ipients ar e selected : " | |
703 | . W !," " _GMRCORTX_ $$ORTX^GMR CAU(+GMRCO ) | |
704 | . W ! | |
705 | . I GMRCS TS'=2 W !, "or the al ert will b e sent whe n the orde r is compl eted.",! | |
706 | . I $P($G (^GMR(123, GMRCO,12)) ,U,5)="F" D | |
707 | . W !!,"T he orderin g provider for this inter-faci lity consu lt will " | |
708 | . W "auto matically be ",!,"no tified.",! | |
709 | . D PROCA LRT^GMRCAC MT(GMRCORT X,1,4,GMRC O) | |
710 | . ;For co nsults not completed , the orig inal provi der may be deleted f rom | |
711 | . ;the re cipient li st for the alert. | |
712 | D END | |
713 | Q | |
714 | ; | |
715 | SETORTX ;S et prefix text for t he alert | |
716 | S GMRCORT X=$S(GMRCS F="N":"No ",GMRCSF=" Y":"",1:"U nknown ") | |
717 | S GMRCORT X=GMRCORTX _"Sig Find ings for " _$P($G(^OR D(100.01,+ GMRCSTS,0) ),"^",2)_" consult " Q | |
718 | Q | |
719 | ; | |
720 | SENDALRT(G MRCORTX) ; Send to th e requesti ng provide r | |
721 | N GMRCRP, GMRCADUZ,G MRCDELR | |
722 | S GMRCRP= $P($G(^GMR (123,+GMRC O,0)),U,14 ) ;request ing clinic ian | |
723 | I +GMRCRP ,GMRCRP'=D UZ D | |
724 | . S GMRCA DUZ(+GMRCR P)="" | |
725 | . W !,"Al ert will b e sent to Requesting Provider: "_$P($G(^ VA(200,+GM RCRP,0)),U ,1) | |
726 | E W !,"N o automati c alerts w ill be sen t to the R equesting Provider." | |
727 | S GMRCDEL R=0 | |
728 | D ANDTO^G MRCACMT | |
729 | D SENDMSG ^GMRCACMT( 23,+GMRCO) | |
730 | ;Sig Find ings uses the CONSUL T/REQUEST RESOLUTION (23) noti fication | |
731 | Q | |
732 | ; | |
733 | GETSIGF(GM RCSFO) ;Ge t the sign ificant fi ndings | |
734 | ;GMRCSFO is the old significa nt finding s value | |
735 | N DIR,DA, DTOUT,DUOU T,DIRUT,DI ROUT | |
736 | S DIR(0)= "123,15" | |
737 | S DIR("B" )=GMRCSFO | |
738 | S:DIR("B" )="" DIR(" B")="unkno wn" | |
739 | S DIR("A" )="Are the re signifi cant findi ngs? (Y/N/ U)" | |
740 | D ^DIR | |
741 | I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q 0 | |
742 | Q Y | |
743 | ; | |
744 | END ;clean up variabl es | |
745 | I $G(GMRC LCK) D UNL OCK^GMRCA1 (GMRCO) | |
746 | K GMRCO,G MRCA,GMRCM SG,GMRCOM, GMRCSEL,GM RCERR,GMRC ERMS | |
747 | I $D(DTOU T)!$D(DIRO UT) S GMRC QIT="" | |
748 | S:$D(^TMP ("GMRC",$J ,"CURRENT" ,"MENU")) XQORM("HIJ ACK")=^("M ENU") | |
749 | Q | |
750 | After: | |
751 | GMRCASF ;S LC/DLT - S ignificant Findings Action ;7/ 11/03 13:2 8 | |
752 | ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,10,1 4,22,29,35 ,46,101**; DEC 27, 19 97;Build 2 3 | |
753 | SF(GMRCO) ;Evaluate Significan t Findings and updat e accordin gly | |
754 | ;GMRCO is the selec ted consul t | |
755 | N GMRCQIT ,GMRCLCK | |
756 | I '$L($G( GMRCO)) D SELECT^GMR CA2(.GMRCO ) I $D(GMR CQUT) D EN D Q | |
757 | I '+($G(G MRCO)) D E ND Q | |
758 | I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D Q | |
759 | . N DIR | |
760 | . W !,"Th e requesti ng facilit y may not take this action on an " | |
761 | . W "inte r-facility consult." | |
762 | . S DIR(0 )="E" D ^D IR | |
763 | . D END | |
764 | I '$$LOCK ^GMRCA1(GM RCO) D END Q | |
765 | S GMRCLCK =1 | |
766 | ; | |
767 | I $D(IOTM ),$D(IOBM) ,$D(IOSTBM ) D FULL^V ALM1 | |
768 | N GMRC,GM RCSTS,GMRC SF,GMRCSFO ,GMRCORTX, GMRCDR | |
769 | S GMRC(0) =$G(^GMR(1 23,+GMRCO, 0)) Q:GMRC (0)="" | |
770 | ; | |
771 | S GMRCSFO =$P(GMRC(0 ),"^",19) | |
772 | W !!,"Cur rent Signi ficant Fin dings = "_ $S(GMRCSFO ="U":"Unkn own",GMRCS FO="Y":"Ye s",GMRCSFO ="N":"No", 1:"not ent ered yet") ,!! | |
773 | S GMRCSF= $$GETSIGF( GMRCSFO) | |
774 | I GMRCSF= 0 D END Q | |
775 | ; If no c hange in o ld and new value ask if should continue | |
776 | I GMRCSF= GMRCSFO D I 'Y D EN D Q | |
777 | . W !,"Th e old and new Signif icant Find ings are t he same." | |
778 | . N DIR,D A,DTOUT,DU OUT,DIRUT, DIROUT | |
779 | . S DIR(" A")="Do yo u want to proceed wi th this ac tion" | |
780 | . S DIR(0 )="Y" | |
781 | . S DIR(" B")="NO" | |
782 | . D ^DIR | |
783 | . I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S Y= 0 Q | |
784 | . I Y=0 Q | |
785 | ; | |
786 | ;Update l ast action and sig f indings bu t don't ch ange the s tatus | |
787 | S GMRCSTS =$P(GMRC(0 ),"^",12), GMRCA=4 | |
788 | S GMRCDR= "8////^S X =GMRCSTS;9 ////^S X=G MRCA;15/// /^S X=GMRC SF" | |
789 | D STATUS^ GMRCP | |
790 | I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q | |
791 | ; | |
792 | ;GMRCOM=1 tells AUD IT^GMRCP t o do the w ord-proces sing logic | |
793 | ;If an ac tual comme nt is adde d, $P(GMRC OM,"^",2)= 1 (send al ert), | |
794 | ; if not GMRCOM=1 a nd no '^' exists (do not send alert) | |
795 | S GMRCOM= 1 D AUDIT^ GMRCP | |
796 | I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q | |
797 | ; RTW NSR2 0180112 ST ART send s ignificant findings to DoD reg ardless of GMRCSTS v alue/statu s | |
798 | ; I GMRCS TS=2 D EN^ GMRCHL7($P (^GMR(123, GMRCO,0),U ,2),GMRCO, $G(GMRCTYP E),$G(GMRC RB),"RE",G MRCORNP,$G (GMRCVSIT) ,,,$G(GMRC AD)) | |
799 | I $D(^XPD (9.7,"B"," JVGMR 1.0" )),$$GET^X PAR("SYS", "GMRC DOD CMNT SIGF MESSAGE",1 ) D ;RTW N SR20180112 | |
800 | . S TP="S C" | |
801 | . D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),U,2 ),GMRCO,$G (GMRCTYPE) ,$G(GMRCRB ),TP,GMRCO RNP,$G(GMR CVSIT),,,$ G(GMRCAD)) | |
802 | D SETORTX | |
803 | ;I GMRCST S=2 D SEND ALRT(GMRCO RTX) Q | |
804 | D SENDALR T(GMRCORTX ) Q | |
805 | ;RTW NSR2 0180112 EN D | |
806 | I +$P(GMR COM,"^",2) D | |
807 | . W !,"An alert wit h the foll owing text will be s ent if rec ipients ar e selected : " | |
808 | . W !," " _GMRCORTX_ $$ORTX^GMR CAU(+GMRCO ) | |
809 | . W ! | |
810 | . I GMRCS TS'=2 W !, "or the al ert will b e sent whe n the orde r is compl eted.",! | |
811 | . I $P($G (^GMR(123, GMRCO,12)) ,U,5)="F" D | |
812 | . W !!,"T he orderin g provider for this inter-faci lity consu lt will " | |
813 | . W "auto matically be ",!,"no tified.",! | |
814 | . D PROCA LRT^GMRCAC MT(GMRCORT X,1,4,GMRC O) | |
815 | . ;For co nsults not completed , the orig inal provi der may be deleted f rom | |
816 | . ;the re cipient li st for the alert. | |
817 | D END | |
818 | Q | |
819 | ; | |
820 | SETORTX ;S et prefix text for t he alert | |
821 | S GMRCORT X=$S(GMRCS F="N":"No ",GMRCSF=" Y":"",1:"U nknown ") | |
822 | S GMRCORT X=GMRCORTX _"Sig Find ings for " _$P($G(^OR D(100.01,+ GMRCSTS,0) ),"^",2)_" consult " Q | |
823 | Q | |
824 | ; | |
825 | SENDALRT(G MRCORTX) ; Send to th e requesti ng provide r | |
826 | N GMRCRP, GMRCADUZ,G MRCDELR | |
827 | S GMRCRP= $P($G(^GMR (123,+GMRC O,0)),U,14 ) ;request ing clinic ian | |
828 | I +GMRCRP ,GMRCRP'=D UZ D | |
829 | . S GMRCA DUZ(+GMRCR P)="" | |
830 | . W !,"Al ert will b e sent to Requesting Provider: "_$P($G(^ VA(200,+GM RCRP,0)),U ,1) | |
831 | E W !,"N o automati c alerts w ill be sen t to the R equesting Provider." | |
832 | S GMRCDEL R=0 | |
833 | D ANDTO^G MRCACMT | |
834 | D SENDMSG ^GMRCACMT( 23,+GMRCO) | |
835 | ;Sig Find ings uses the CONSUL T/REQUEST RESOLUTION (23) noti fication | |
836 | Q | |
837 | ; | |
838 | GETSIGF(GM RCSFO) ;Ge t the sign ificant fi ndings | |
839 | ;GMRCSFO is the old significa nt finding s value | |
840 | N DIR,DA, DTOUT,DUOU T,DIRUT,DI ROUT | |
841 | S DIR(0)= "123,15" | |
842 | S DIR("B" )=GMRCSFO | |
843 | S:DIR("B" )="" DIR(" B")="unkno wn" | |
844 | S DIR("A" )="Are the re signifi cant findi ngs? (Y/N/ U)" | |
845 | D ^DIR | |
846 | I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q 0 | |
847 | Q Y | |
848 | ; | |
849 | END ;clean up variabl es | |
850 | I $G(GMRC LCK) D UNL OCK^GMRCA1 (GMRCO) | |
851 | K GMRCO,G MRCA,GMRCM SG,GMRCOM, GMRCSEL,GM RCERR,GMRC ERMS | |
852 | I $D(DTOU T)!$D(DIRO UT) S GMRC QIT="" | |
853 | S:$D(^TMP ("GMRC",$J ,"CURRENT" ,"MENU")) XQORM("HIJ ACK")=^("M ENU") | |
854 | Q | |
855 | ========== ========== ========== ========== ========== ========== ======== | |
856 | GMRCGUIB | |
857 | Before: | |
858 | GMRCGUIB ; SLC/DCM,JF R,MA/AFS,P B - GUI ac tions for consults ; 01/10/18 1 3:55 | |
859 | ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,12,1 8,20,17,22 ,29,30,35, 45,53,55,6 4,46,75,86 ,90,91**;D EC 27, 199 7;Build 4 | |
860 | ; | |
861 | ; This ro utine invo kes IA #29 80 | |
862 | ; This ro utine invo kes IA #67 55 - DE674 5 - PB Apr 12, 2017 | |
863 | ; | |
864 | SETDA() ;s et DA of w here audit actions a re to be f iled | |
865 | S:'$D(^GM R(123,+GMR CO,40,0)) ^GMR(123,G MRCO,40,0) ="^123.02D A^^" | |
866 | S DA=$S($ P(^GMR(123 ,+GMRCO,40 ,0),"^",3) :$P(^(0)," ^",3)+1,1: 1) | |
867 | S $P(^GMR (123,+GMRC O,40,0),"^ ",3,4)=DA_ "^"_DA | |
868 | Q DA | |
869 | REASON(GMR CFN,GMRCRQ ,GMRCDT) ; Load the r eason for the reques t into ^GM R(123,GMRC O,20 | |
870 | ;GMRCFN=F ile 123 IF N; GMRCRQ= Array cont aining Rea son For Re quest | |
871 | ;GMRCDT=D ate time o f entry | |
872 | S ^GMR(12 3,GMRCFN,2 0,0)="^^^" _GMRCDT_"^ " | |
873 | S L=0,LN= 1 F S L=$ O(GMRCRQ(L )) Q:L="" S ^GMR(12 3,GMRCFN,2 0,LN,0)=GM RCRQ(L),LN =LN+1 | |
874 | S LN=LN-1 ,$P(^GMR(1 23,GMRCFN, 20,0),"^", 3)=LN | |
875 | K LN,L | |
876 | Q | |
877 | SETCOM(COM MENT,WHO) ;Set comme nt array i nto tracki ng actions | |
878 | N GMRCNOW ,DR,DIE | |
879 | S GMRCNOW =$$NOW^XLF DT | |
880 | I $P($G(^ GMR(123,+G MRCO,0))," ^",11)=$G( GMRCPA) S GMRCPA="" | |
881 | S DIE="^G MR(123,GMR CO,40,",DA (1)=GMRCO, DR=".01/// /^S X=GMRC NOW;1////^ S X=GMRCA; 2////^S X= GMRCAD;3// //^S X=$G( GMRCORNP); 4////^S X= $S($G(WHO) :WHO,1:DUZ );6////^S X=$G(GMRCF R);8////^S X=$G(GMRC FF);7////^ S X=$G(GMR CPA)" | |
882 | D ^DIE | |
883 | S ^GMR(12 3,GMRCO,40 ,DA,1,0)=" ^^^^"_GMRC AD_"^" | |
884 | S (GMRCND ,GMRCND1)= 0 F S GMR CND1=$O(CO MMENT(GMRC ND1)) Q:GM RCND1="" S GMRCND=G MRCND+1,^G MR(123,GMR CO,40,DA,1 ,GMRCND,0) =COMMENT(G MRCND) | |
885 | S $P(^GMR (123,GMRCO ,40,DA,1,0 ),"^",3)=G MRCND,$P(^ (0),"^",4) =GMRCND,^G MR(123,GMR CO,40,"B", GMRCNOW,DA )="" | |
886 | D:$D(^GMR (123,+GMRC O,0)) AG12 3S1^GMRCXR (+GMRCO) ; alb/sat 86 - update AG xref | |
887 | ; | |
888 | ; if an I FC, call e vent handl er to gene rate a msg to remote site | |
889 | I $D(^GMR (123,+GMRC O,12)),$D( ^(40,DA)) D TRIGR^GM RCIEVT(GMR CO,DA) | |
890 | ; | |
891 | K GMRCND, GMRCND1 | |
892 | Q | |
893 | CMT(GMRCO, GMRCOM,GMR CADUZ,GMRC WHN,GMRCWH O) ;add co mment to c onsult | |
894 | ; GMRCO = IEN from file 123 | |
895 | ; GMRCOM = array of comments in format GMRCOM(1)= "xxxx", GM RCOM(2)="x xx" | |
896 | ; GMRCADU Z = array of alert r ecipients as GMRCADU Z(DUZ)="" (optional) | |
897 | ; GMRCWHO = IEN fro m file 200 who's res ponsible a ctivity (o ptional) | |
898 | ; GMRCWHN = date ti me of acti vity in FM format | |
899 | ; GMRCFOR C = copy o f GMRCADUZ ; these us ers will r ecieve ale rt 63 even if alert is turned OFF; optio nal argume nt to MSG^ GMRCP | |
900 | ; | |
901 | N DA,GMRC A,GMRCAD,G MRCORTX,GM RCDFN,GMRC TM,GMRCRP, GMRCUPD,GM RCFORC | |
902 | M GMRCFOR C=GMRCADUZ | |
903 | S DA=$$SE TDA ; get next activ ity tracki ng entry | |
904 | S GMRCA=2 0,GMRCAD=G MRCWHN S:$ G(GMRCWHO) GMRCORNP= GMRCWHO | |
905 | D SETCOM( .GMRCOM,$G (GMRCWHO)) | |
906 | ;if a Non VA Care c onsult, no tify HCP o f the comm ent | |
907 | I $$FEE^G MRCHL7H($$ GET1^DIQ(1 23,+GMRCO, 1,"I")) D COMMENT^GM RCHL7H(+GM RCO) | |
908 | D ;updat e LAST ACT ION field even thoug h no statu s change | |
909 | . N GMRCD R,GMRCSTS | |
910 | . S GMRCS TS="",GMRC DR="9////2 0" | |
911 | . D STATU S^GMRCP | |
912 | S GMRCDFN =$P(^GMR(1 23,+GMRCO, 0),"^",2) | |
913 | S GMRCORT X="Comment Added to Consult " | |
914 | D POST^HM PEVNT(GMRC DFN,"consu lt",GMRCO, "") ; DE67 45 PB - Ad ded to mak e a call t o HMP to s ync the pa tient comm ents | |
915 | I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D | |
916 | . S GMRCO RTX="Comme nt Added t o remote c onsult " | |
917 | S GMRCORT X=GMRCORTX _$$ORTX^GM RCAU(+GMRC O) | |
918 | S GMRCRP= +$P(^GMR(1 23,GMRCO,0 ),U,14) | |
919 | S GMRCUPD =$$VALID^G MRCAU($P(^ GMR(123,+G MRCO,0),U, 5),GMRCO,D UZ) | |
920 | I GMRCRP= DUZ D ;al ert team i f ord. pro v. takes t he action | |
921 | . S GMRCT M=1 | |
922 | I GMRCUPD >1,GMRCRP' =DUZ D ; alert ord. prov if u pdate user s takes ac tion | |
923 | . S GMRCA DUZ(GMRCRP )="" | |
924 | I '$G(GMR CTM),GMRCU PD<2 D ;a lert both if not ord . prov or update use r | |
925 | . S GMRCT M=1,GMRCAD UZ(GMRCRP) ="" | |
926 | D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,63, .GMRCADUZ, $G(GMRCTM) ,.GMRCFORC ) | |
927 | Q | |
928 | SFILE(GMRC O,GMRCA,GM RCSF,GMRCO RNP,GMRCDU Z,GMRCOM,G MRCALF,GMR CATO,GMRCA D) ;Proces s various file updat e function s from the GUI for a consult | |
929 | ; ADMIN C OMPLETE or SIGNIFICA NT FINDING S | |
930 | ;Input va riables: | |
931 | ;GMRCO=Fi le 123 IEN of the co nsult reco rd | |
932 | ;GMRCA=po inter to R EQUEST ACT ION TYPES (#123.1) 1 0=complete , 4=Sig fi nd. | |
933 | ;GMRCSF=S ignificant Findings flag: 'Y'= significa nt finding | |
934 | ; : 'N'= no signifi cant findi ng | |
935 | ; : 'U'=u nknown sig nificant f inding | |
936 | ;GMRCORNP =Provider Responsibl e for acti on | |
937 | ;GMRCDUZ= Person act ually doin g the acti on | |
938 | ;GMRCOM=A n array of comments by referen ce ARRAY(1 )="xxx",AR RAY(2)="xx x" | |
939 | ;GMRCALF= Flag to si gnal that alerts are to be sen t; 'N'=NO, 'Y'=YES | |
940 | ;GMRCATO= Who alerts are to be sent to; a comma de limited st ring of DU Z's | |
941 | ;GMRCAD = FM date/ti me of acti vity | |
942 | ; | |
943 | ;Output: | |
944 | ; GMRCERR =Error Fla g: 0 if no error, 1 if error o ccurred | |
945 | ; GMRCERM S - Error message or null | |
946 | ; returne d as GMRCE RR^GMRCERM S | |
947 | ; | |
948 | N GMRCERR ,GMRCERMS, GMRCTM | |
949 | L +^GMR(1 23,GMRCO): 5 I '$T S GMRCERR=1, GMRCERMS=" Record Loc ked. File Update Not Accomplis hed." Q GM RCERR_"^"_ GMRCERMS | |
950 | S GMRCERR =0,GMRCTM= 0,GMRCERMS ="",DR="", GMRCORTX=" " | |
951 | N GMRCADU Z S GMRCAD UZ="" | |
952 | S GMRCNOW =$$NOW^XLF DT,GMRCSTS =$P(^GMR(1 23,+GMRCO, 0),"^",12) ,GMRCDFN=$ P(^(0),"^" ,2) | |
953 | I '$G(GMR CDUZ) S GM RCDUZ=DUZ | |
954 | I '$G(GMR CAD) S GMR CAD=GMRCNO W | |
955 | ;Insure c omment arr ay contain s text for Complete action. | |
956 | I GMRCA=1 0 D I GMR CERR=1 S G MRCERMS="C omment fie ld must co ntain a te xt value!" Q GMRCERR _"^"_GMRCE RMS | |
957 | . S GMRCE RR=1 | |
958 | . I '$D(G MRCOM) Q | |
959 | . N GMRCO M1 S GMRCO M1="" | |
960 | . F S GM RCOM1=$O(G MRCOM(GMRC OM1)) Q:(G MRCOM1=""! (GMRCERR=0 )) D | |
961 | .. I $TR( $G(GMRCOM( GMRCOM1)), " ","")'=" " S GMRCER R=0 Q | |
962 | I +$G(GMR CA),GMRCA= 10 D | |
963 | .S GMRCSF =$G(GMRCSF ,"") | |
964 | .S GMRCST S=2 | |
965 | .S DR="8/ ///^S X=GM RCSTS;9/// /^S X=GMRC A;15////^S X=GMRCSF" | |
966 | .S GMRCOR TX="Comple ted Consul t "_$$ORTX ^GMRCAU(+G MRCO)_$S(G MRCSF="Y": " with Sig Findings" ,GMRCSF="N ":" with n o Sig Find ings",1:"" ) | |
967 | .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))="" | |
968 | .Q | |
969 | I $G(GMRC ALF)=1 D | |
970 | .N I | |
971 | .F I=1:1 S X=$P(GMR CATO,";",I ) Q:X="" S GMRCADUZ (X)="" | |
972 | .Q | |
973 | I $L(GMRC A),GMRCA=4 S DR=DR_$ S($L(DR):" ;",1:"")_" 9////^S X= GMRCA;15// //^S X=GMR CSF" D | |
974 | .S GMRCOR TX=$S(GMRC SF="Y":"Si g Findings ",GMRCSF= "N":"No Si g Findings ",1:"Unkn own Sig Fi ndings ")_ "for consu lt "_$$ORT X^GMRCAU(G MRCO) | |
975 | .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))="" | |
976 | .S GMRCUP D=$$VALID^ GMRCAU($P( ^GMR(123,+ GMRCO,0),U ,5),GMRCO, DUZ) | |
977 | .I +GMRCU PD<2 S GMR CTM=1 | |
978 | .I +GMRCU PD>1,+$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)=DU Z S GMRCTM =1 | |
979 | .Q | |
980 | I $L(DR) S DIE="^GM R(123,",DA =GMRCO D ^ DIE K DIE, DR | |
981 | I '$O(GMR COM(0)) D AUDIT^GMRC P | |
982 | I $D(GMRC OM),$O(GMR COM(0)) D | |
983 | .N DA | |
984 | .S DA=$$S ETDA() | |
985 | .D SETCOM (.GMRCOM,G MRCDUZ) | |
986 | .Q | |
987 | L -^GMR(1 23,GMRCO) | |
988 | ; | |
989 | D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,$S( GMRCA=20:6 3,1:23),.G MRCADUZ,GM RCTM) | |
990 | ; | |
991 | I $S(GMRC A=10:1,(GM RCA=4&($P( ^GMR(123,G MRCO,0),U, 12)=2)):1, 1:0) D | |
992 | . D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),"^" ,2),GMRCO, $G(GMRCTYP E),$G(GMRC RB),"RE",G MRCORNP,$G (GMRCVSIT) ,.GMRCOM,, GMRCAD) | |
993 | K DIE,DR, DA,GMRCDT, GMRCNOW,GM RCAD,GMRCO RNP,GMRCDU Z,GMRCRSLT ,GMRCSTS,G MRCADUZ,GM RCORTX,GMR CDFN | |
994 | Q GMRCERR _"^"_GMRCE RMS | |
995 | ; | |
996 | SCH(GMRCO, GMRCORNP,G MRCAD,GMRC ADUZ,GMRCM T) ;schedu le a consu lt API | |
997 | ; Input v ariables: | |
998 | ;GMRCO - The intern al file nu mber of th e consult from File 123 | |
999 | ;GMRCORNP - Name of the perso n who actu ally 'Rece ived' the consult | |
1000 | ;GMRCAD - Actual da te time th at consult was recei ved into t he service . | |
1001 | ;GMRCADUZ - array o f alert re cipients a s chosen b y user (by reference ) | |
1002 | ; ARRAY(D UZ)="" | |
1003 | ;GMRCMT - array of comments i f entered (by refere nce) | |
1004 | ; ARRAY(1 )="FIRST L INE OF COM MENT" | |
1005 | ; ARRAY(2 )="SECOND LINE OF CO MMENT" | |
1006 | ; | |
1007 | ;Output: | |
1008 | ;GMRCERR - Error Co ndition Co de: 0 = NO error, 1= error | |
1009 | ;GMRCERMS - Error m essage or null | |
1010 | ; returne d as GMRCE RR^GMRCERM S | |
1011 | ; | |
1012 | N DFN,GMR CSTS,GMRCN OW,GMRCERR ,GMRCERMS | |
1013 | S GMRCERR =0,GMRCERM S="",GMRCN OW=$$NOW^X LFDT | |
1014 | S:$G(GMRC AD)="" GMR CAD=GMRCNO W | |
1015 | S:'$G(GMR CDUZ) GMRC DUZ=DUZ | |
1016 | S DFN=$P( $G(^GMR(12 3,GMRCO,0) ),"^",2) I DFN="" D Q GMRCERR _"^"_GMRCE RMS | |
1017 | . S GMRCE RR="1",GMR CERMS="Not A Valid C onsult - F ile Not Fo und." | |
1018 | . D EXIT^ GMRCGUIA | |
1019 | S GMRCSTS =8,GMRCA=8 | |
1020 | D STATUS^ GMRCP I $D (GMRCQUT) D EXIT^GMR CGUIA Q GM RCERR_"^"_ GMRCERMS | |
1021 | I '$O(GMR CMT(0)) D AUDIT^GMRC P | |
1022 | I $O(GMRC MT(0)) D | |
1023 | . S DA=$$ SETDA | |
1024 | . D SETCO M(.GMRCMT, GMRCDUZ) | |
1025 | D EN^GMRC HL7(DFN,GM RCO,"","", "SC",GMRCO RNP,"","", "",GMRCAD) | |
1026 | D ;send alerts | |
1027 | . N GMRCU PD,GMRCTM, TXT | |
1028 | . S TXT=" Scheduled Consult: " _$$ORTX^GM RCAU(GMRCO ) | |
1029 | . S GMRCT M=0 | |
1030 | . I $P(^G MR(123,+GM RCO,0),U,1 4),$P(^GMR (123,+GMRC O,0),U,14) '=DUZ S GM RCADUZ($P( ^(0),U,14) )="" | |
1031 | . S GMRCU PD=$$VALID ^GMRCAU($P (^GMR(123, +GMRCO,0), U,5),GMRCO ,DUZ) | |
1032 | . I +GMRC UPD<2 S GM RCTM=1 | |
1033 | . I +GMRC UPD>1,+$P( $G(^GMR(12 3,+GMRCO,0 )),U,14)=D UZ S GMRCT M=1 | |
1034 | . D MSG^G MRCP(DFN,T XT,GMRCO,6 3,.GMRCADU Z,GMRCTM) | |
1035 | D EXIT^GM RCGUIA | |
1036 | Q GMRCERR _"^"_GMRCE RMS | |
1037 | DOCLIST(GM RCAR,GMRCD A,GMRCMED) ;return l ist of lin ked result s | |
1038 | ; Input: | |
1039 | ; GMRCAR - array to return li st, passed by refere nce | |
1040 | ; GMRCDA - ien from file 123 | |
1041 | ; GMRCMED - 1 = incl ude med re sults; 0 = only TIU docs | |
1042 | ; | |
1043 | ; Output: | |
1044 | ; GMRCAR - array in format | |
1045 | ; GMRCAR( 0)=zero no de of reco rd | |
1046 | ; GMRCAR( 50,1)="ien ;global re f," e.g. 5 ;TIU(8925, or 3;MCAR (691, | |
1047 | ; GMRCAR( 50,2)="ien ;global re f," | |
1048 | ; | |
1049 | I '$D(^GM R(123,GMRC DA,0)) Q | |
1050 | S GMRCAR( 0)=^GMR(12 3,GMRCDA,0 ),$P(GMRCA R(0),U,20) ="" | |
1051 | N RES,CNT S RES="", CNT=1 | |
1052 | F S RES= $O(^GMR(12 3,GMRCDA,5 0,"B",RES) ) Q:RES="" D | |
1053 | . I '$G(G MRCMED) Q: RES'["TIU( 8925" | |
1054 | . S GMRCA R(50,CNT)= RES | |
1055 | . I RES[" MCAR" D | |
1056 | .. N ARR, STR | |
1057 | .. D MEDL KUP^MCARUT L3(.ARR,+$ P(RES,"MCA R(",2),+RE S) | |
1058 | .. I '+AR R K GMRCAR (50,CNT) Q | |
1059 | .. S STR= $P(ARR,U,9 )_U_$P(ARR ,U,6)_$S($ P(ARR,U,10 ):"^^^^^^^ ^1",1:"") | |
1060 | .. S GMRC AR(50,CNT) =GMRCAR(50 ,CNT)_U_ST R | |
1061 | . S CNT=C NT+1 | |
1062 | Q | |
1063 | After: | |
1064 | GMRCGUIB ; SLC/DCM,JF R,MA/AFS,P B - GUI ac tions for consults ; 01/10/18 1 3:55 | |
1065 | ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,12,1 8,20,17,22 ,29,30,35, 45,53,55,6 4,46,75,86 ,90,91,101 **;DEC 27, 1997;Buil d 4 | |
1066 | ; | |
1067 | ; This ro utine invo kes IA #29 80 | |
1068 | ; This ro utine invo kes IA #67 55 - DE674 5 - PB Apr 12, 2017 | |
1069 | ; | |
1070 | SETDA() ;s et DA of w here audit actions a re to be f iled | |
1071 | S:'$D(^GM R(123,+GMR CO,40,0)) ^GMR(123,G MRCO,40,0) ="^123.02D A^^" | |
1072 | S DA=$S($ P(^GMR(123 ,+GMRCO,40 ,0),"^",3) :$P(^(0)," ^",3)+1,1: 1) | |
1073 | S $P(^GMR (123,+GMRC O,40,0),"^ ",3,4)=DA_ "^"_DA | |
1074 | Q DA | |
1075 | REASON(GMR CFN,GMRCRQ ,GMRCDT) ; Load the r eason for the reques t into ^GM R(123,GMRC O,20 | |
1076 | ;GMRCFN=F ile 123 IF N; GMRCRQ= Array cont aining Rea son For Re quest | |
1077 | ;GMRCDT=D ate time o f entry | |
1078 | S ^GMR(12 3,GMRCFN,2 0,0)="^^^" _GMRCDT_"^ " | |
1079 | S L=0,LN= 1 F S L=$ O(GMRCRQ(L )) Q:L="" S ^GMR(12 3,GMRCFN,2 0,LN,0)=GM RCRQ(L),LN =LN+1 | |
1080 | S LN=LN-1 ,$P(^GMR(1 23,GMRCFN, 20,0),"^", 3)=LN | |
1081 | K LN,L | |
1082 | Q | |
1083 | SETCOM(COM MENT,WHO) ;Set comme nt array i nto tracki ng actions | |
1084 | N GMRCNOW ,DR,DIE | |
1085 | S GMRCNOW =$$NOW^XLF DT | |
1086 | I $P($G(^ GMR(123,+G MRCO,0))," ^",11)=$G( GMRCPA) S GMRCPA="" | |
1087 | S DIE="^G MR(123,GMR CO,40,",DA (1)=GMRCO, DR=".01/// /^S X=GMRC NOW;1////^ S X=GMRCA; 2////^S X= GMRCAD;3// //^S X=$G( GMRCORNP); 4////^S X= $S($G(WHO) :WHO,1:DUZ );6////^S X=$G(GMRCF R);8////^S X=$G(GMRC FF);7////^ S X=$G(GMR CPA)" | |
1088 | D ^DIE | |
1089 | S ^GMR(12 3,GMRCO,40 ,DA,1,0)=" ^^^^"_GMRC AD_"^" | |
1090 | S (GMRCND ,GMRCND1)= 0 F S GMR CND1=$O(CO MMENT(GMRC ND1)) Q:GM RCND1="" S GMRCND=G MRCND+1,^G MR(123,GMR CO,40,DA,1 ,GMRCND,0) =COMMENT(G MRCND) | |
1091 | S $P(^GMR (123,GMRCO ,40,DA,1,0 ),"^",3)=G MRCND,$P(^ (0),"^",4) =GMRCND,^G MR(123,GMR CO,40,"B", GMRCNOW,DA )="" | |
1092 | D:$D(^GMR (123,+GMRC O,0)) AG12 3S1^GMRCXR (+GMRCO) ; alb/sat 86 - update AG xref | |
1093 | ; | |
1094 | ; if an I FC, call e vent handl er to gene rate a msg to remote site | |
1095 | I $D(^GMR (123,+GMRC O,12)),$D( ^(40,DA)) D TRIGR^GM RCIEVT(GMR CO,DA) | |
1096 | ; | |
1097 | K GMRCND, GMRCND1 | |
1098 | Q | |
1099 | CMT(GMRCO, GMRCOM,GMR CADUZ,GMRC WHN,GMRCWH O) ;add co mment to c onsult | |
1100 | ; GMRCO = IEN from file 123 | |
1101 | ; GMRCOM = array of comments in format GMRCOM(1)= "xxxx", GM RCOM(2)="x xx" | |
1102 | ; GMRCADU Z = array of alert r ecipients as GMRCADU Z(DUZ)="" (optional) | |
1103 | ; GMRCWHO = IEN fro m file 200 who's res ponsible a ctivity (o ptional) | |
1104 | ; GMRCWHN = date ti me of acti vity in FM format | |
1105 | ; GMRCFOR C = copy o f GMRCADUZ ; these us ers will r ecieve ale rt 63 even if alert is turned OFF; optio nal argume nt to MSG^ GMRCP | |
1106 | ; | |
1107 | N DA,GMRC A,GMRCAD,G MRCORTX,GM RCDFN,GMRC TM,GMRCRP, GMRCUPD,GM RCFORC | |
1108 | M GMRCFOR C=GMRCADUZ | |
1109 | S DA=$$SE TDA ; get next activ ity tracki ng entry | |
1110 | S GMRCA=2 0,GMRCAD=G MRCWHN S:$ G(GMRCWHO) GMRCORNP= GMRCWHO | |
1111 | D SETCOM( .GMRCOM,$G (GMRCWHO)) | |
1112 | ;if a Non VA Care c onsult, no tify HCP o f the comm ent | |
1113 | I $$FEE^G MRCHL7H($$ GET1^DIQ(1 23,+GMRCO, 1,"I")) D COMMENT^GM RCHL7H(+GM RCO) | |
1114 | D ;updat e LAST ACT ION field even thoug h no statu s change | |
1115 | . N GMRCD R,GMRCSTS | |
1116 | . S GMRCS TS="",GMRC DR="9////2 0" | |
1117 | . D STATU S^GMRCP | |
1118 | S GMRCDFN =$P(^GMR(1 23,+GMRCO, 0),"^",2) | |
1119 | S GMRCORT X="Comment Added to Consult " | |
1120 | D POST^HM PEVNT(GMRC DFN,"consu lt",GMRCO, "") ; DE67 45 PB - Ad ded to mak e a call t o HMP to s ync the pa tient comm ents | |
1121 | I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D | |
1122 | . S GMRCO RTX="Comme nt Added t o remote c onsult " | |
1123 | S GMRCORT X=GMRCORTX _$$ORTX^GM RCAU(+GMRC O) | |
1124 | S GMRCRP= +$P(^GMR(1 23,GMRCO,0 ),U,14) | |
1125 | S GMRCUPD =$$VALID^G MRCAU($P(^ GMR(123,+G MRCO,0),U, 5),GMRCO,D UZ) | |
1126 | I GMRCRP= DUZ D ;al ert team i f ord. pro v. takes t he action | |
1127 | . S GMRCT M=1 | |
1128 | I GMRCUPD >1,GMRCRP' =DUZ D ; alert ord. prov if u pdate user s takes ac tion | |
1129 | . S GMRCA DUZ(GMRCRP )="" | |
1130 | I '$G(GMR CTM),GMRCU PD<2 D ;a lert both if not ord . prov or update use r | |
1131 | . S GMRCT M=1,GMRCAD UZ(GMRCRP) ="" | |
1132 | D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,63, .GMRCADUZ, $G(GMRCTM) ,.GMRCFORC ) | |
1133 | I $D(^XPD( 9.7,"B","J VGMR 1.0") ),$$GET^XP AR("SYS"," GMRC DOD C MNT SIGF M ESSAGE",1) D ;RTW NS R2018011 | |
1134 | . D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),"^" ,2),GMRCO, $G(GMRCTYP E),$G(GMRC RB),"SC",G MRCORNP,$G (GMRCVSIT) ,.GMRCOM,, GMRCAD) ;R TW NSR2018 0112 | |
1135 | Q | |
1136 | SFILE(GMRC O,GMRCA,GM RCSF,GMRCO RNP,GMRCDU Z,GMRCOM,G MRCALF,GMR CATO,GMRCA D) ;Proces s various file updat e function s from the GUI for a consult | |
1137 | ; ADMIN C OMPLETE or SIGNIFICA NT FINDING S | |
1138 | ;Input va riables: | |
1139 | ;GMRCO=Fi le 123 IEN of the co nsult reco rd | |
1140 | ;GMRCA=po inter to R EQUEST ACT ION TYPES (#123.1) 1 0=complete , 4=Sig fi nd. | |
1141 | ;GMRCSF=S ignificant Findings flag: 'Y'= significa nt finding | |
1142 | ; : 'N'= no signifi cant findi ng | |
1143 | ; : 'U'=u nknown sig nificant f inding | |
1144 | ;GMRCORNP =Provider Responsibl e for acti on | |
1145 | ;GMRCDUZ= Person act ually doin g the acti on | |
1146 | ;GMRCOM=A n array of comments by referen ce ARRAY(1 )="xxx",AR RAY(2)="xx x" | |
1147 | ;GMRCALF= Flag to si gnal that alerts are to be sen t; 'N'=NO, 'Y'=YES | |
1148 | ;GMRCATO= Who alerts are to be sent to; a comma de limited st ring of DU Z's | |
1149 | ;GMRCAD = FM date/ti me of acti vity | |
1150 | ; | |
1151 | ;Output: | |
1152 | ; GMRCERR =Error Fla g: 0 if no error, 1 if error o ccurred | |
1153 | ; GMRCERM S - Error message or null | |
1154 | ; returne d as GMRCE RR^GMRCERM S | |
1155 | ; | |
1156 | N GMRCERR ,GMRCERMS, GMRCTM | |
1157 | L +^GMR(1 23,GMRCO): 5 I '$T S GMRCERR=1, GMRCERMS=" Record Loc ked. File Update Not Accomplis hed." Q GM RCERR_"^"_ GMRCERMS | |
1158 | S GMRCERR =0,GMRCTM= 0,GMRCERMS ="",DR="", GMRCORTX=" " | |
1159 | N GMRCADU Z S GMRCAD UZ="" | |
1160 | S GMRCNOW =$$NOW^XLF DT,GMRCSTS =$P(^GMR(1 23,+GMRCO, 0),"^",12) ,GMRCDFN=$ P(^(0),"^" ,2) | |
1161 | I '$G(GMR CDUZ) S GM RCDUZ=DUZ | |
1162 | I '$G(GMR CAD) S GMR CAD=GMRCNO W | |
1163 | ;Insure c omment arr ay contain s text for Complete action. | |
1164 | I GMRCA=1 0 D I GMR CERR=1 S G MRCERMS="C omment fie ld must co ntain a te xt value!" Q GMRCERR _"^"_GMRCE RMS | |
1165 | . S GMRCE RR=1 | |
1166 | . I '$D(G MRCOM) Q | |
1167 | . N GMRCO M1 S GMRCO M1="" | |
1168 | . F S GM RCOM1=$O(G MRCOM(GMRC OM1)) Q:(G MRCOM1=""! (GMRCERR=0 )) D | |
1169 | .. I $TR( $G(GMRCOM( GMRCOM1)), " ","")'=" " S GMRCER R=0 Q | |
1170 | I +$G(GMR CA),GMRCA= 10 D | |
1171 | .S GMRCSF =$G(GMRCSF ,"") | |
1172 | .S GMRCST S=2 | |
1173 | .S DR="8/ ///^S X=GM RCSTS;9/// /^S X=GMRC A;15////^S X=GMRCSF" | |
1174 | .S GMRCOR TX="Comple ted Consul t "_$$ORTX ^GMRCAU(+G MRCO)_$S(G MRCSF="Y": " with Sig Findings" ,GMRCSF="N ":" with n o Sig Find ings",1:"" ) | |
1175 | .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))="" | |
1176 | .Q | |
1177 | I $G(GMRC ALF)=1 D | |
1178 | .N I | |
1179 | .F I=1:1 S X=$P(GMR CATO,";",I ) Q:X="" S GMRCADUZ (X)="" | |
1180 | .Q | |
1181 | I $L(GMRC A),GMRCA=4 S DR=DR_$ S($L(DR):" ;",1:"")_" 9////^S X= GMRCA;15// //^S X=GMR CSF" D | |
1182 | .S GMRCOR TX=$S(GMRC SF="Y":"Si g Findings ",GMRCSF= "N":"No Si g Findings ",1:"Unkn own Sig Fi ndings ")_ "for consu lt "_$$ORT X^GMRCAU(G MRCO) | |
1183 | .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))="" | |
1184 | .S GMRCUP D=$$VALID^ GMRCAU($P( ^GMR(123,+ GMRCO,0),U ,5),GMRCO, DUZ) | |
1185 | .I +GMRCU PD<2 S GMR CTM=1 | |
1186 | .I +GMRCU PD>1,+$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)=DU Z S GMRCTM =1 | |
1187 | .Q | |
1188 | I $L(DR) S DIE="^GM R(123,",DA =GMRCO D ^ DIE K DIE, DR | |
1189 | I '$O(GMR COM(0)) D AUDIT^GMRC P | |
1190 | I $D(GMRC OM),$O(GMR COM(0)) D | |
1191 | .N DA | |
1192 | .S DA=$$S ETDA() | |
1193 | .D SETCOM (.GMRCOM,G MRCDUZ) | |
1194 | .Q | |
1195 | L -^GMR(1 23,GMRCO) | |
1196 | ; | |
1197 | D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,$S( GMRCA=20:6 3,1:23),.G MRCADUZ,GM RCTM) | |
1198 | ; | |
1199 | ;RTW BEGIN NSR201801 12 | |
1200 | ;I $S(GMR CA=10:1,(G MRCA=4&($P (^GMR(123, GMRCO,0),U ,12)=2)):1 ,1:0) D | |
1201 | I $D(^XPD (9.7,"B"," JVGMR 1.0" )),$$GET^X PAR("SYS", "GMRC DOD CMNT SIGF MESSAGE",1 ) D ;RTW NSR2018011 2 | |
1202 | .D EN^GMR CHL7($P(^G MR(123,GMR CO,0),"^", 2),GMRCO,$ G(GMRCTYPE ),$G(GMRCR B),"SC",GM RCORNP,$G( GMRCVSIT), .GMRCOM,,G MRCAD) ;RT W NSR20180 112 | |
1203 | K DIE,DR, DA,GMRCDT, GMRCNOW,GM RCAD,GMRCO RNP,GMRCDU Z,GMRCRSLT ,GMRCSTS,G MRCADUZ,GM RCORTX,GMR CDFN | |
1204 | Q GMRCERR _"^"_GMRCE RMS | |
1205 | ; | |
1206 | SCH(GMRCO, GMRCORNP,G MRCAD,GMRC ADUZ,GMRCM T) ;schedu le a consu lt API | |
1207 | ; Input v ariables: | |
1208 | ;GMRCO - The intern al file nu mber of th e consult from File 123 | |
1209 | ;GMRCORNP - Name of the perso n who actu ally 'Rece ived' the consult | |
1210 | ;GMRCAD - Actual da te time th at consult was recei ved into t he service . | |
1211 | ;GMRCADUZ - array o f alert re cipients a s chosen b y user (by reference ) | |
1212 | ; ARRAY(D UZ)="" | |
1213 | ;GMRCMT - array of comments i f entered (by refere nce) | |
1214 | ; ARRAY(1 )="FIRST L INE OF COM MENT" | |
1215 | ; ARRAY(2 )="SECOND LINE OF CO MMENT" | |
1216 | ; | |
1217 | ;Output: | |
1218 | ;GMRCERR - Error Co ndition Co de: 0 = NO error, 1= error | |
1219 | ;GMRCERMS - Error m essage or null | |
1220 | ; returne d as GMRCE RR^GMRCERM S | |
1221 | ; | |
1222 | N DFN,GMR CSTS,GMRCN OW,GMRCERR ,GMRCERMS | |
1223 | S GMRCERR =0,GMRCERM S="",GMRCN OW=$$NOW^X LFDT | |
1224 | S:$G(GMRC AD)="" GMR CAD=GMRCNO W | |
1225 | S:'$G(GMR CDUZ) GMRC DUZ=DUZ | |
1226 | S DFN=$P( $G(^GMR(12 3,GMRCO,0) ),"^",2) I DFN="" D Q GMRCERR _"^"_GMRCE RMS | |
1227 | . S GMRCE RR="1",GMR CERMS="Not A Valid C onsult - F ile Not Fo und." | |
1228 | . D EXIT^ GMRCGUIA | |
1229 | S GMRCSTS =8,GMRCA=8 | |
1230 | D STATUS^ GMRCP I $D (GMRCQUT) D EXIT^GMR CGUIA Q GM RCERR_"^"_ GMRCERMS | |
1231 | I '$O(GMR CMT(0)) D AUDIT^GMRC P | |
1232 | I $O(GMRC MT(0)) D | |
1233 | . S DA=$$ SETDA | |
1234 | . D SETCO M(.GMRCMT, GMRCDUZ) | |
1235 | D EN^GMRC HL7(DFN,GM RCO,"","", "SC",GMRCO RNP,"","", "",GMRCAD) | |
1236 | D ;send alerts | |
1237 | . N GMRCU PD,GMRCTM, TXT | |
1238 | . S TXT=" Scheduled Consult: " _$$ORTX^GM RCAU(GMRCO ) | |
1239 | . S GMRCT M=0 | |
1240 | . I $P(^G MR(123,+GM RCO,0),U,1 4),$P(^GMR (123,+GMRC O,0),U,14) '=DUZ S GM RCADUZ($P( ^(0),U,14) )="" | |
1241 | . S GMRCU PD=$$VALID ^GMRCAU($P (^GMR(123, +GMRCO,0), U,5),GMRCO ,DUZ) | |
1242 | . I +GMRC UPD<2 S GM RCTM=1 | |
1243 | . I +GMRC UPD>1,+$P( $G(^GMR(12 3,+GMRCO,0 )),U,14)=D UZ S GMRCT M=1 | |
1244 | . D MSG^G MRCP(DFN,T XT,GMRCO,6 3,.GMRCADU Z,GMRCTM) | |
1245 | D EXIT^GM RCGUIA | |
1246 | Q GMRCERR _"^"_GMRCE RMS | |
1247 | DOCLIST(GM RCAR,GMRCD A,GMRCMED) ;return l ist of lin ked result s | |
1248 | ; Input: | |
1249 | ; GMRCAR - array to return li st, passed by refere nce | |
1250 | ; GMRCDA - ien from file 123 | |
1251 | ; GMRCMED - 1 = incl ude med re sults; 0 = only TIU docs | |
1252 | ; | |
1253 | ; Output: | |
1254 | ; GMRCAR - array in format | |
1255 | ; GMRCAR( 0)=zero no de of reco rd | |
1256 | ; GMRCAR( 50,1)="ien ;global re f," e.g. 5 ;TIU(8925, or 3;MCAR (691, | |
1257 | ; GMRCAR( 50,2)="ien ;global re f," | |
1258 | ; | |
1259 | I '$D(^GM R(123,GMRC DA,0)) Q | |
1260 | S GMRCAR( 0)=^GMR(12 3,GMRCDA,0 ),$P(GMRCA R(0),U,20) ="" | |
1261 | N RES,CNT S RES="", CNT=1 | |
1262 | F S RES= $O(^GMR(12 3,GMRCDA,5 0,"B",RES) ) Q:RES="" D | |
1263 | . I '$G(G MRCMED) Q: RES'["TIU( 8925" | |
1264 | . S GMRCA R(50,CNT)= RES | |
1265 | . I RES[" MCAR" D | |
1266 | .. N ARR, STR | |
1267 | .. D MEDL KUP^MCARUT L3(.ARR,+$ P(RES,"MCA R(",2),+RE S) | |
1268 | .. I '+AR R K GMRCAR (50,CNT) Q | |
1269 | .. S STR= $P(ARR,U,9 )_U_$P(ARR ,U,6)_$S($ P(ARR,U,10 ):"^^^^^^^ ^1",1:"") | |
1270 | .. S GMRC AR(50,CNT) =GMRCAR(50 ,CNT)_U_ST R | |
1271 | . S CNT=C NT+1 | |
1272 | Q | |
1273 | ========== ========== ========== ========== ========== ========== ======== | |
1274 | GMRC101P ( New) | |
1275 | GMRC101P ; EPIP/RTW - Post inst all for GM RC*3.0*101 consults ;12/12/18 13:55 | |
1276 | ;;3.0;CON SULT/REQUE ST TRACKIN G;**101**; DEC 27, 19 97;Build 2 9 | |
1277 | ; | |
1278 | ADDPAR ; | |
1279 | ;N GMRCNM ,GMRCDTXT, GMRCVT,GMR CVDT,GMRCV DOM,GMRCVH ,GMRX,MSG, FDA2,FDA,G MRCMSG,GMR CGIEN,GMRC IDT,GMRCID OM,GMRCIH, GMRCKW,GMR CIT,GMRCPR EC,GMRCENT | |
1280 | N FDA,FDA 2,GMRCDTXT ,GMRCENT,G MRCGIEN,GM RCIDOM,GMR CIDT,GMRCI H,GMRCIT,G MRCKW,GMRC MSG,GMRCMV ,GMRCNM,GM RCPREC,GMR CVDOM,GMRC VDT,GMRCVH ,GMRCVT,GM RX,GMRXMV, GRMCMV,MSG | |
1281 | S (GMRCID T,GMRCIDOM ,GMRCIH,GM RCKW,GMRCI T,GMRCPREC ,GMRCENT)= "" | |
1282 | S GMRCNM= "" F GMRCN M="GMRC DO D CMNT SIG F MESSAGE" ,"GMRC NEW NOTE ALER T DISABLE" Q:GMRCNM= "" D | |
1283 | . Q:$D(^X TV(8989.51 ,"B",GMRCN M)) | |
1284 | . I GMRCN M="GMRC DO D CMNT SIG F MESSAGE" D | |
1285 | . . S GMR CDTXT="DOD CMT SF ME SSAGE ON O FF",GMRCMV =0,GMRCVT= "GENERATE DOD COMMEN T MESSAGE OFF",GMRCV DOM="0:OFF ;1:ON",GMR CVH="Enter a 1 to tu rn on the DOD COMMEN T MESSAGE GENERATION or a 0 to turn it o ff." | |
1286 | . . S GMR CMSG(1)="D oD provide rs may ord er consult s that are acted upo n by VA st aff. This " | |
1287 | . . S GMR CMSG(2)="f unction al lows updat e messages to be sen t to infor m the DoD provider w hen" | |
1288 | . . S GMR CMSG(3)="a comment o r signific ant findin g was adde d to the c onsult by VA staff. " | |
1289 | . . S GMR CMSG(4)="T hese comme nts commun icate info rmation su ch as when the consu lt is" | |
1290 | . . S GMR CMSG(5)="s cheduled, comments a bout resch eduling, a nd other e vents such as when t he" | |
1291 | . . S GMR CMSG(6)="p atient doe s not show up for th eir appoin tment. DoD integrati on require s" | |
1292 | . . S GMR CMSG(7)="t he exchang e of order s and info rmation be tween the VA and DoD systems." | |
1293 | . I GMRCN M="GMRC NE W NOTE ALE RT DISABLE " D | |
1294 | . . S GMR CDTXT="Sup press New TIU Note A lert",GMRC MV=1,GMRCV T="TIU Ale rt (Enable /Disable) suppressio n." | |
1295 | . . S GMR CVDOM="E:E nable;D:Di sable",GMR CVH="Enter 'E' to en able, or ' D' to disa ble TIU ne w note pro vider aler t supressi on.",GMRCK W="REQUEST SERVICE", GMRCIDT="P ",GMRCIDOM =123.5 | |
1296 | . . S GMR CIH="Selec t a REQUES T SERVICE Consult to suppress alerts.",G MRCIT="REQ UEST SERVI CE" | |
1297 | . . S GMR CMSG(1)="T his is use d in consu lt trackin g to suppr ess alerts generated when a ne w" | |
1298 | . . S GMR CMSG(2)="T IU note is added dur ing comple tion. This can suppr ess sendin g an alert " | |
1299 | . . S GMR CMSG(3)="t o the crea tor of the consult w hen a new note is ad ded." | |
1300 | . S GMRCP REC=1,GMRC ENT=4.2,GM RCVDT="S" | |
1301 | . S FDA(8 989.51,"+1 ,",.01)=GM RCNM | |
1302 | . S FDA(8 989.51,"+1 ,",.02)=GM RCDTXT | |
1303 | . S FDA(8 989.51,"+1 ,",.03)=GM RCMV | |
1304 | . S FDA(8 989.51,"+1 ,",.04)=GM RCIT | |
1305 | . S FDA(8 989.51,"+1 ,",.05)=GM RCVT | |
1306 | . S FDA(8 989.51,"+1 ,",1.1)=GM RCVDT | |
1307 | . S FDA(8 989.51,"+1 ,",1.2)=GM RCVDOM | |
1308 | . S FDA(8 989.51,"+1 ,",1.3)=GM RCVH | |
1309 | . S FDA(8 989.51,"+1 ,",6.1)=GM RCIDT | |
1310 | . S FDA(8 989.51,"+1 ,",6.2)=GM RCIDOM | |
1311 | . S FDA(8 989.51,"+1 ,",6.3)=GM RCIH | |
1312 | . D UPDAT E^DIE(""," FDA","FDAI EN","MSG") | |
1313 | . S GMRCG IEN=+$P($Q (^XTV(8989 .51,"B",GM RCNM)),"," ,4) | |
1314 | . D WP^DI E(8989.51, GMRCGIEN_" ,",20,,"GM RCMSG") | |
1315 | . S FDA2( 1,8989.513 ,"+2,"_GMR CGIEN_",", .01)=GMRCP REC | |
1316 | . S FDA2( 1,8989.513 ,"+2,"_GMR CGIEN_",", .02)=GMRCE NT | |
1317 | . D UPDAT E^DIE(""," FDA2(1)") | |
1318 | . K FDA,F DAIEN | |
1319 | I $D(MSG) D Q | |
1320 | . S GMRX= "Parameter definitio n failed t o load. Th e followin g error me ssage was returned:" | |
1321 | . W ! | |
1322 | . D MES^X PDUTL(GMRX ) | |
1323 | S GMRX="P arameter d efinitions created s uccessfull y." | |
1324 | D MES^XPD UTL(GMRX) | |
1325 | Q | |
1326 | MENU ;add new option s to the G MRC MGR me nu | |
1327 | ;GMRC MGR class 1 M ENU | |
1328 | ;GMRC DOD CMNT MESS AGE ON/OFF new class 1 option | |
1329 | ;GMRC NEW NOTE PARA METER EDIT new class 1 option | |
1330 | N FDA,GMR COP,GMRCIE N,GMRCOPNM | |
1331 | S GMRCOP= +$P($Q(^DI C(19,"B"," GMRC MGR") ),",",4) | |
1332 | S GMRCOPN M="" F GMR COPNM="GMR C DOD CMNT MESSAGE O N/OFF","GM RC NEW NOT E PARAMETE R EDIT" Q: GMRCOPNM=" " D | |
1333 | . S GMRCI EN=0 S GMR CIEN=+$P($ Q(^DIC(19, "B",GMRCOP NM)),",",4 ) | |
1334 | . S GMRCS YN=$S(GMRC OPNM["DOD" :"DOD",GMR COPNM["NEW ":"NN",1:0 ) | |
1335 | . Q:$D(^D IC(19,GMRC OP,10,"B", GMRCIEN)) | |
1336 | . S FDA(1 ,19.01,"+2 ,"_GMRCOP_ ",",.01)=G MRCIEN | |
1337 | . S FDA(1 ,19.01,"+2 ,"_GMRCOP_ ",",2)=GMR CSYN | |
1338 | . D UPDAT E^DIE(""," FDA(1)") | |
1339 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.