Produced by Araxis Merge on 3/31/2017 1:06:33 PM Central Daylight 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 | EPIP_submissions.zip\EPIP_submissions\docs\OR_3.0_441 | EPIP_Remediation_Plan_(OR_3.0_441)_201612.docx | Fri Mar 31 16:50:48 2017 UTC |
| 2 | EPIP_submissions.zip\EPIP_submissions\docs\OR_3.0_441 | EPIP_Remediation_Plan_(OR_3.0_441)_201612.docx | Fri Mar 31 17:55:16 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 4 | 598 |
| 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 | Existing P roduct Int ake Progra m (EPIP) | |
| 2 | Patch OR*3 .0*441 | |
| 3 | Remediatio n Plan | |
| 4 | ||
| 5 | Department of Vetera ns Affairs | |
| 6 | December 2 016 | |
| 7 | Version 2. 0 | |
| 8 | ||
| 9 | Revision H istory | |
| 10 | Date | |
| 11 | Version | |
| 12 | Descriptio n | |
| 13 | Author | |
| 14 | 12/22/2016 | |
| 15 | 2.0 | |
| 16 | Updated en tire docum ent | |
| 17 | EPIP Proje ct Team | |
| 18 | 11/28/2016 | |
| 19 | 1.0 | |
| 20 | Initial ve rsion | |
| 21 | EPIP Proje ct Team | |
| 22 | ||
| 23 | Table of C ontents | |
| 24 | 1.Introduc tion1 | |
| 25 | 2.Purpose1 | |
| 26 | 3.Patch De scription1 | |
| 27 | 3.1.Needs and Requir ements2 | |
| 28 | 4.Points o f Contact2 | |
| 29 | 5.Code Rem ediation2 | |
| 30 | 5.1.Standa rds and Co nventions2 | |
| 31 | 5.2.Review and Analy sis3 | |
| 32 | 5.3.Coding Changes3 | |
| 33 | 6.Testing3 | |
| 34 | 6.1.Test P lan3 | |
| 35 | 6.2.Test E nvironment 4 | |
| 36 | 6.3.Test R eadiness R eview4 | |
| 37 | 6.4.Testin g Phases4 | |
| 38 | 6.4.1.Unit Testing4 | |
| 39 | 6.4.2.Comp onent Inte gration an d Systems Testing (C I/ST)4 | |
| 40 | 6.4.3.Func tional Tes ting4 | |
| 41 | 6.4.4.Regr ession Tes ting5 | |
| 42 | 6.4.5.Sect ion 508 Co mpliance T esting5 | |
| 43 | 7.Document ation Reme diation5 | |
| 44 | 7.1.User G uides5 | |
| 45 | 7.2.Instal lation Gui des5 | |
| 46 | 7.3.Techni cal Manual s6 | |
| 47 | 7.4.Operat ions Manua ls6 | |
| 48 | 8.Project Reporting6 | |
| 49 | 9.Project Schedule6 | |
| 50 | 10.Deploym ent6 | |
| 51 | 11.Sustain ment Requi rements6 | |
| 52 | 12.Mainten ance and K nowledge T ransfer6 | |
| 53 | Appendix A :XINDEX Li sting for MUMPS Code Changes7 | |
| 54 | Appendix B :Source Co de Changes 10 | |
| 55 | ||
| 56 | ||
| 57 | ||
| 58 | Introducti on | |
| 59 | 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. | |
| 60 | Purpose | |
| 61 | 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 OR*3.0 *441. This patch add resses the following NSRs: | |
| 62 | NSR2015010 3 Display Flagged an d Ward Com ments | |
| 63 | This NSR h as been im plemented locally at the VA Me dical Cent er in Milw aukee, WI. | |
| 64 | NSR2016061 3 Anti-Mic robial Dec ision Tree Interface Hook | |
| 65 | This NSR h as been im plemented locally at multiple Region 2 V A Medical Centers. | |
| 66 | This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation, and delive ry of this remediati on effort. | |
| 67 | Patch Desc ription | |
| 68 | OR*3.0*441 provides the follow ing enhanc ements to VistA: | |
| 69 | Modifies t he display of flagge d Order co mments and Ward comm ents to ma ke them re adily avai lable on t he Compute rized Pati ent Record System (C PRS) Order s tab wher e Clinica l staff ca n plainly see Order comments a nd Ward co mments tha t impact p atient saf ety and ca re. | |
| 70 | Currently, the clini cian must double-cli ck the ord er and sea rch throug h activity details t o find the flagged O rder comme nt or Ward comment. Not only i s this sea rch time-c onsuming, but it req uires that the clini cian recog nize the n eed to act ively sear ch. This c an result in comment s being ov erlooked a nd not add ressed in a timely m anner. | |
| 71 | Enables su pport for tracking a ntimicrobi al medicat ion quick orders by adding a t racking ho ok to enha nce auditi ng of anti microbial drug order s. The hoo k function ality is e nabled by two TIU Ob jects prov ided with this enhan cement: th e |ZZ QUIC K ORDER AU DIT| hook tracks cli nically pr eferred an timicrobia l drug ord ers; the | ZZ QUICK O RDER AUDIT (ALT)| hoo k tracks o rders that prescribe an altern ative to a clinicall y preferre d antimicr obial drug . | |
| 72 | When creat ing an ant imicrobial drug quic k order, t he clinici an or othe r authoriz ed user mu st add eit her the |Z Z QUICK OR DER AUDIT| or the |Z Z QUICK OR DER AUDIT( ALT)| hook to the or der Commen ts field t o enable q uick order audit cap abilities. When an a ntimicrobi al drug qu ick order containing the hook is created , the loca l Quick Or der Audit file is po pulated wi th detaile d informat ion about the antimi crobial dr ug order a nd a Pharm acy Confir mation num ber is dis played on the CPRS O rders tab. | |
| 73 | The Audit report in VistA can be used to determine how often clinician s place an timicrobia l quick or ders, the pharmacy c onfirmatio n number f or each or der, and w hether the order was dispensed . Addition ally, two VistA quic k order au diting opt ions are p rovided wi th this en hancement. The ORQOA QUICK ORD ER AUDIT P RINT optio n enables printing o f usage re ports and export of statistics to a spre adsheet ap plication. The ORQOA QUICK ORD ER AUDIT o ption retr ieves orde r details in VistA. | |
| 74 | Note: Site s that are utilizing the Compu ter Decisi on Support System (C DSS) softw are to sel ect quick orders ass ociated wi th antimic robial dru gs can con tinue usin g the CDSS system wi thout inte rruption f ollowing i mplementat ion of thi s enhancem ent. | |
| 75 | Needs and Requiremen ts | |
| 76 | The Needs and Requir ements for the NSRs addressed in this re mediation are: | |
| 77 | NSR2015010 3 Display Flagged an d Ward Com ments | |
| 78 | NEED – Non e provided | |
| 79 | NSR2016061 3 Anti-Mic robial Dec ision Tree Interface Hook | |
| 80 | NEED 74339 1: Hook To Anti-Micr obial Clin ical Decis ion Suppor t – For he althcare c linicians who utiliz e a Clinic al Decisio n Support System (CD SS) to ord er antimic robials fo r patients . The abil ity to tra ck when an antimicro bial medic ation is o rdered thr ough the C DSS applic ation. | |
| 81 | Points of Contact | |
| 82 | The VA Poi nt of Cont act (POC) for NSR201 50103 Disp lay Flagge d and Ward Comments
|
|
| 83 | The VA POC (s) for NS R20160613 Anti-Micro bial Decis ion Tree I nterface H ook | |
| 84 | Code Remed iation | |
| 85 | 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. | |
| 86 | Standards and Conven tions | |
| 87 | Leidos wil l referenc e the
|
|
| 88 | 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. | |
| 89 | Review and Analysis | |
| 90 | 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. | |
| 91 | 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. | |
| 92 | Coding Cha nges | |
| 93 | The coding changes r equired fo r NSR20150 103 Displa y Flagged and Ward C omments ar e in the f ollowing M UMPS routi nes: | |
| 94 | Modified r outines: O RQ12 | |
| 95 | New routin es: None | |
| 96 | The coding changes f or NSR2016 0613 Anti- Microbial Decision T ree Interf ace Hook a re in the following MUMPS rout ines: | |
| 97 | Modified r outines: O RWDXM3,ORW PT | |
| 98 | New routin es: ORQOAU IA, ORQOAU IB, ORQOAU IC | |
| 99 | New Option s: ORQOA Q UICK ANTI- MICROBIAL LST, ORQOA QUICK NIG HTLY BACKG ROUND, ORQ OA QUICK O RDER AUDIT , ORQOA QU ICK ORDER AUDIT PRIN T, ORQOA Q UICK ORDER AUDIT MEN U | |
| 100 | New Data O bjects: ZZ QUICK ORD ER AUDIT, ZZ QUICK O RDER AUDIT (ALT) | |
| 101 | A detailed analysis of the mod ified and new routin es include d in this modificati on is prov ided in Ap pendix B. | |
| 102 | Testing | |
| 103 | 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. | |
| 104 | Test Plan | |
| 105 | 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. | |
| 106 | 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. | |
| 107 | Test Envir onment | |
| 108 | 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. The environmen t will be restored t o its orig inal basel ine state by the Vis tA system administra tor after developmen t testing is complet ed, follow ed by inst allation o f the reme diated sof tware. | |
| 109 | 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 (RQM) “EPIP” Pro ject. In o rder to pe rform test ing of thi s VistA in take produ ct modific ation, the following tools wil l be lever aged: RQM, Reflectio ns emulato r, CPRS GU I v31 (1.0 .30.75), a nd SnagIt. | |
| 110 | Test Readi ness Revie w | |
| 111 | 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 ). | |
| 112 | Testing Ph ases | |
| 113 | Leidos wil l perform developmen t and SQA testing ac tivities i n phases, and will p rovide all required testing do cumentatio n. | |
| 114 | Unit Testi ng | |
| 115 | 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. | |
| 116 | Component Integratio n and Syst ems Testin g (CI/ST) | |
| 117 | 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. | |
| 118 | Functional Testing | |
| 119 | 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. | |
| 120 | Regression Testing | |
| 121 | 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. | |
| 122 | Section 50 8 Complian ce Testing | |
| 123 | 508 Testin g will be performed on VistA a nd CPRS co de when ne w CPRS GUI changes a re introdu ced by the developer . The VA-r ecommended Assistive Technolog y tool, JA WS, will b e used to conduct th e 508 test ing. Test results an d related documentat ion will b e submitte d to the V A Section 508 team i n accordan ce with th e VA 508 t esting req uirements. Defects f ound durin g testing will be as sessed and remediate d by the d eveloper. | |
| 124 | Documentat ion Remedi ation | |
| 125 | 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. | |
| 126 | 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
|
|
| 127 | The follow ing sectio ns outline the VDL d ocuments t o be revis ed for thi s remediat ion. | |
| 128 | User Guide s | |
| 129 | The follow ing User G uide will be updated in the VD L: | |
| 130 | Computeriz ed Patient Record Sy stem (CPRS ) User Man ual: GUI V ersion (Te ntative) | |
| 131 | Installati on Guides | |
| 132 | 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 KIDS packages migrated f rom the te st environ ment to th e VA Pre-P roduction environmen ts. Theref ore, no In stallation Guides wi ll be upda ted. | |
| 133 | Technical Manuals | |
| 134 | The follow ing Techni cal Manual will be u pdated in the VDL: | |
| 135 | Computeriz ed Patient Record Sy stem (CPRS ) Technica l Manual: GUI Versio n | |
| 136 | Operations Manuals | |
| 137 | No Operati ons Manual s require revision a s a result of this m odificatio n. | |
| 138 | Project Re porting | |
| 139 | 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. | |
| 140 | Project Sc hedule | |
| 141 | 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. | |
| 142 | Deployment | |
| 143 | Leidos wil l create a KIDS pack age contai ning the s oftware ch anges nece ssary to f ulfill the requireme nts for th is remedia tion effor t. A KIDS package, a long with all relate d document ation, wil l be deliv ered to th e Contract ing Office Represent ative (COR ) for acce ptance. If accepted, the KIDS package ca n then be released f or nationa l VA consu mption; ot herwise, L eidos will correct a ny defects found and repeat th e necessar y remediat ion activi ties. | |
| 144 | Sustainmen t Requirem ents | |
| 145 | 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 . | |
| 146 | Maintenanc e and Know ledge Tran sfer | |
| 147 | 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. | |
| 148 | ||
| 149 | XINDEX Lis ting for M UMPS Code Changes | |
| 150 | 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. | |
| 151 | NSR2015010 3 | |
| 152 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 153 | [2008 V A Standard s & Conven tions] | |
| 154 | UC I: VISTA C PU: ROU Dec 13, 2 016@19:18: 59 | |
| 155 | Routines: 1 Faux Ro utines: 0 | |
| 156 | ||
| 157 | ORQ12 | |
| 158 | ||
| 159 | --- CROSS REFERENCIN G --- | |
| 160 | ||
| 161 | Press r eturn to c ontinue: | |
| 162 | ||
| 163 | Compiled l ist of Err ors and Wa rnings Dec 13, 20 16@19:18:5 9 page 1 | |
| 164 | No errors or warning s to repor t | |
| 165 | ||
| 166 | ||
| 167 | --- END -- - | |
| 168 | ||
| 169 | NSR2016061 3 | |
| 170 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 171 | [2008 V A Standard s & Conven tions] | |
| 172 | UC I: VISTA C PU: ROU Dec 13, 2 016@14:56: 21 | |
| 173 | Routines: 1 Faux Ro utines: 0 | |
| 174 | ||
| 175 | ORQOAUIA | |
| 176 | ||
| 177 | --- CROSS REFERENCIN G --- | |
| 178 | ||
| 179 | Press r eturn to c ontinue: | |
| 180 | ||
| 181 | Compiled l ist of Err ors and Wa rnings Dec 13, 20 16@14:56:2 1 page 1 | |
| 182 | No errors or warning s to repor t | |
| 183 | ||
| 184 | ||
| 185 | --- END -- - | |
| 186 | ||
| 187 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 188 | [2008 V A Standard s & Conven tions] | |
| 189 | UC I: VISTA C PU: ROU Dec 13, 2 016@19:15: 14 | |
| 190 | Routines: 1 Faux Ro utines: 0 | |
| 191 | ||
| 192 | ORQOAUIB | |
| 193 | ||
| 194 | --- CROSS REFERENCIN G --- | |
| 195 | ||
| 196 | Press r eturn to c ontinue | |
| 197 | ||
| 198 | Compiled l ist of Err ors and Wa rnings Dec 13, 20 16@19:15:1 4 page 1 | |
| 199 | No errors or warning s to repor t | |
| 200 | ||
| 201 | ||
| 202 | --- END -- - | |
| 203 | ||
| 204 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 205 | [2008 V A Standard s & Conven tions] | |
| 206 | UC I: VISTA C PU: ROU Dec 13, 2 016@19:17: 09 | |
| 207 | Routines: 1 Faux Ro utines: 0 | |
| 208 | ||
| 209 | ORQOAUIC | |
| 210 | ||
| 211 | --- CROSS REFERENCIN G --- | |
| 212 | ||
| 213 | Press r eturn to c ontinue: | |
| 214 | ||
| 215 | Compiled l ist of Err ors and Wa rnings Dec 13, 20 16@19:17:0 9 page 1 | |
| 216 | No errors or warning s to repor t | |
| 217 | ||
| 218 | ||
| 219 | --- END -- - | |
| 220 | V. A. C R O S S R E F E R E N C E R 7.3 | |
| 221 | [2008 V A Standard s & Conven tions] | |
| 222 | UC I: VISTA C PU: ROU Dec 13, 2 016@19:20: 15 | |
| 223 | Routines: 1 Faux Ro utines: 0 | |
| 224 | ||
| 225 | ORWDXM3 | |
| 226 | ||
| 227 | --- CROSS REFERENCIN G --- | |
| 228 | ||
| 229 | Press r eturn to c ontinue: | |
| 230 | ||
| 231 | ||
| 232 | Compiled l ist of Err ors and Wa rnings Dec 13, 20 16@19:20:1 5 page 1 | |
| 233 | No errors or warning s to repor t | |
| 234 | ||
| 235 | ||
| 236 | --- END -- - | |
| 237 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 238 | [2008 V A Standard s & Conven tions] | |
| 239 | UC I: VISTA C PU: ROU Dec 13, 2 016@19:21: 19 | |
| 240 | ||
| 241 | All Routin es? No => No | |
| 242 | ||
| 243 | Routine: O RWPT | |
| 244 | Routine: | |
| 245 | 1 routine | |
| 246 | ||
| 247 | Select BUI LD NAME: | |
| 248 | Select INS TALL NAME: | |
| 249 | Select PAC KAGE NAME: | |
| 250 | ||
| 251 | Print more than comp iled error s and warn ings? YES/ /N | |
| 252 | ||
| 253 | Save param eters in R OUTINE fil e? NO// | |
| 254 | ||
| 255 | Index all called rou tines? NO/ / | |
| 256 | DEVICE: HOME (CRT ) Right Margin: 8 0// | |
| 257 | ||
| 258 | ||
| 259 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 260 | [2008 V A Standard s & Conven tions] | |
| 261 | UC I: VISTA C PU: ROU Dec 13, 2 016@19:21: 19 | |
| 262 | Routines: 1 Faux Ro utines: 0 | |
| 263 | ||
| 264 | ORWPT | |
| 265 | ||
| 266 | --- CROSS REFERENCIN G --- | |
| 267 | ||
| 268 | Press ret urn to con tinue: | |
| 269 | ||
| 270 | Compiled l ist of Err ors and Wa rnings Dec 13, 20 16@19:21:1 9 page 1 | |
| 271 | No errors or warning s to repor t | |
| 272 | ||
| 273 | ||
| 274 | --- END -- - | |
| 275 | ||
| 276 | Source Cod e Changes | |
| 277 | 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: | |
| 278 | Modified r outines: O RQ12, ORWD XM3, ORWPT | |
| 279 | New routin es: ORQOAU IA, ORQOAU IB, ORQOAU IC | |
| 280 | ORQ12 | |
| 281 | Before: | |
| 282 | ORQ12 ; sl c/dcm - Ge t patient orders in context ;0 8/05/15 11 :03 ;;3.0; ORDER ENTR Y/RESULTS REPORTING; **12,27,78 ,92,116,19 0,220,215, 243,356,37 7**;Dec 17 , 1997;Bui ld 299GET( IFN,NEWD,D ETAIL,ACTO R) ; -- Se tup TMP ar ray ; IFN= ifn of ord er ; NEWD= 3rd subscr ipt in ^TM P("ORR",$J , node (OR LIST) ; DE TAIL=see d escription in ^ORQ1 ; N X0,X3, X4,X6,TXT, STAT,START ,DG,STOP,E NTERD S OR LST=ORLST+ 1,^TMP("OR GOTIT",$J, IFN,+$G(AC TOR))="" I '$G(DETAI L) S ^TMP( "ORR",$J,N EWD,ORLST) =IFN_$S($G (ACTOR):"; "_ACTOR,1: "") Q S X0 =^OR(100,I FN,0),X3=$ G(^(3)),X4 =$G(^(4)), X6=$G(^(6) ) S DG=$P( X0,U,11),D G=$P($G(^O RD(100.98, +DG,0)),U, 3) S STAT= $S($P(X3,U ,3):$P(^OR D(100.01,$ P(X3,U,3), 0),U,1,2), 1:"") ;.01 ^abbr S EN TERD=$P(X0 ,U,7),STAR T=$P(X0,U, 8),STOP=$P (X0,U,9) ; S FLAGREA =$P(X6,U,7 ) S ^TMP(" ORR",$J,NE WD,ORLST)= IFN_$S($G( ACTOR):";" _ACTOR,1:" ")_U_DG_U_ ENTERD_U_S TART_U_STO P_U_STAT D TEXT(.TXT ,IFN_";"_$ G(ACTOR)) M ^TMP("OR R",$J,NEWD ,ORLST,"TX ")=TXT Q ; TEXT(ORTX, ORIFN,WIDT H) ; -- Re turns text of order ORIFN in O RTX(#) N O R0,OR3,OR6 ,X,Y,FIRST ,ORI,ORJ,D LG,ORX,ORA CT,ORTA K ORTX S:'$G (WIDTH) WI DTH=244 S ORACT=+$P( ORIFN,";", 2),ORIFN=+ ORIFN I OR ACT<1 S OR ACT=+$P($G (^OR(100,O RIFN,3)),U ,7) S:'ORA CT ORACT=1 ;D:$O(^OR (100,ORIFN ,1,0)) CNV ^ORY92(ORI FN) ;conve rt text ot f S OR0=$G (^OR(100,O RIFN,0)),O R3=$G(^(3) ),OR6=$G(^ (6)),ORX=$ G(^(8,ORAC T,0)) S OR TX=1,ORTX( 1)="" I $P ($G(OR0),U ,11)'="",( $P(^ORD(10 0.98,$P(OR 0,U,11),0) ,U)="NON-V A MEDICATI ONS") S X= "Non-VA" D ADD G:$G( ORIGVIEW)> 1 T1 S:$P( OR0,U,14)= $O(^DIC(9. 4,"C","OR" ,0)) ORTX( 1)=">>" ;g eneric S X =$$ACTION( $P(ORX,U,2 )) D:$L(X) ADD I $P( ORX,U,2)=" NW",$P(OR3 ,U,11),'$G (ORIGVIEW) D ; Chan ged or Ren ewed . I $ P(OR3,U,11 )=2 S X="R enew" D AD D Q . N OR IG,ORIGTA S ORIG=+$P (OR3,U,5) Q:'ORIG Q :$P(OR3,U, 11)'=1 . S X="Change " D ADD S ORI=0 . I $G(IOST)'= "P-OTHER" D . .S ORI GTA=$$LAST XT(ORIG) ; D:$O(^OR(1 00,ORIG,1, 0)) CNV^OR Y92(ORIG) . .F S OR I=$O(^OR(1 00,ORIG,8, ORIGTA,.1, ORI)) Q:OR I'>0 S X=$ G(^(ORI,0) ) S:$E(X,1 ,3)=">> " X=$E(X,4,9 99) D ADD . .S X=" t o" D ADDT1 S ORTA=+$ P(ORX,U,14 ),FIRST=+$ O(^OR(100, ORIFN,8,OR TA,.1,0)) S ORI=0 F S ORI=$O( ^OR(100,OR IFN,8,ORTA ,.1,ORI)) Q:ORI'>0 S X=$G(^(OR I,0)) S:(F IRST=ORI)& ($E(X,1,3) =">> ") X= $E(X,4,999 ) D:$L(X) ADD Q:$G(O RIGVIEW)>1 ;contents of global only S DL G=$P(OR0,U ,5) K Y I DLG,$P(DLG ,";",2)["1 01.41",$D( ^ORD(101.4 1,+DLG,9)) X ^(9) I $L($G(Y)) S X=Y D AD D ; additi onal text ; I $P(OR3 ,U,11)=2 S X="(Renew al)" D ADD I $P(ORX, U,4)=2 S X ="*UNSIGNE D*" D ADD I $P(ORX,U ,2)="DC"!( "^1^13^"[( U_$P(OR3,U ,3)_U)),$L (OR6) S X= " <"_$S($L ($P(OR6,U, 5)):$P(OR6 ,U,5),$P(O R6,U,4):$P ($G(^ORD(1 00.03,+$P( OR6,U,4),0 )),U),1:"" )_">" D:$L (X)>3 ADD ; DC Reaso n I $D(XQA ID),$G(ORF LG)=12 S O RX=$G(^OR( 100,ORIFN, 8,ORACT,3) ) I $P(ORX ,U) S X=" Flagged "_ $$DATETIME ($P(ORX,U, 3))_$S($P( ORX,U,4):" by "_$$NA ME($P(ORX, U,4)),1:"" )_": "_$P( ORX,U,5) D ADD ; Fla gged - sho w in FUP Q ;LASTXT(I FN) ; -- R eturns act ion with l atest text for order IFN N I,Y S Y=1 S I =0 F S I= $O(^OR(100 ,IFN,8,I)) Q:I'>0 S: $O(^(I,.1, 0)) Y=I Q Y ;LAST(CO DE) ; -- R eturn DA o f last occ urence of CODE actio n N DA I ' $L($G(CODE )) S DA=$O (^OR(100,O RIFN,8,"A" ),-1) ; la st entry E S DA=$O( ^OR(100,OR IFN,8,"C", CODE,"?"), -1) ; last CODE entr y Q DA ;AC TION(X) ; -- Returns text of a ction X N Y S Y=$S(X ="DC":"Dis continue", X="HD":"Ho ld",X="RL" &'$G(ORIGV IEW):"Rele ase Hold o f",X="FL": "Flag",X=" UF":"Unfla g",X="RN"& '$G(ORIGVI EW):"Renew ",1:"") Q Y ;DATETIM E(X) ; -- Returns da te/time in format 00 /00/00@00: 00am N Y,D ,T,T1,Z S D=$P(X,"." ),T=$E($P( X,".",2)_" 0000",1,4) ,T1=$E(T,1 ,2),Z="AM" S:T1>12 T 1=T1-12,Z= "PM" S Y=$ E(D,4,5)_" /"_$E(D,6, 7)_"/"_(17 00+$E(D,1, 3))_"@"_T1 _":"_$E(T, 3,4)_Z Q Y ;NAME(X) ; -- Retur ns name as Lname,F N Y,Z S Z=$ P($G(^VA(2 00,+X,0)), U) Q:Z="" "" S Y=$P( Z,",")_"," F I=$F(Z, ","):1:$L( Z) I $E(Z, I)'=" " S Y=Y_$E(Z,I ) Q S Y=$$ LOWER^VALM 1(Y) ; mix ed case Q Y ;ADD ; - - Add text X to ORTX () N I,Y S Y=$L(ORTX (ORTX)) S: Y Y=Y+1 ;a llow for s pace I $E( X)=" ",Y S ORTX=ORTX +1,ORTX(OR TX)="",Y=0 ,X=$E(X,2, 999) ;new line I Y+$ L(X)'>WIDT H S ORTX(O RTX)=ORTX( ORTX)_$S(Y :" ",1:"") _X Q F I=1 :1:$L(X," ") S Z=$P( X," ",I) D :(Y+$L(Z)) >WIDTH S ORTX(ORTX) =$G(ORTX(O RTX))_$S(Y :" ",1:"") _Z,Y=$L(OR TX(ORTX)) S:Y Y=Y+1 . I $L(Z)> WIDTH F S ORTX(ORTX )=$G(ORTX( ORTX))_$S( Y:" ",1:"" )_$E(Z,1,W IDTH-Y),Z= $E(Z,WIDTH -Y+1,999) Q:$L(Z)'>W IDTH S OR TX=ORTX+1, Y=0 . S OR TX=ORTX+1, Y=0 Q ;EXP D ; -- loo p through ^XTMP("ORA E" to get expired or ders K ^TM P("ORGOTIT ",$J),^TMP ("ORSORT", $J) N TM,T O,IFN,X0,X 3,X7,X8,US TS,NOW,ACT OR,X,ORREP S NOW=+$E ($$NOW^XLF DT,1,12),T O=0,SDATE= 9999999-SD ATE,EDATE= 9999999-ED ATE F S T O=$O(^XTMP ("ORAE",PA T,TO)) Q:' TO I $D(O RGRP(TO)) S TM=EDATE F S TM=$ O(^XTMP("O RAE",PAT,T O,TM)) Q:' TM!(TM>SDA TE)!(+TM<E DATE) D . S IFN=0 F S IFN=$O( ^XTMP("ORA E",PAT,TO, TM,IFN)) Q :'IFN I ( '$D(^TMP(" ORGOTIT",$ J,IFN))!MU LT) D .. ; *356 Prote ct if x-re f dangles. .. I '$D( ^OR(100,IF N)) K ^XTM P("ORAE",P AT,TO,TM,I FN) Q .. S USTS=$P(^ OR(100,IFN ,3),U,3) . . Q:+$G(US TS)'=7 ;qu it if orde r no longe r expired .. S ORREP =$P(^OR(10 0,IFN,3),U ,6) .. Q:+ $G(ORREP)> 0 ;quit if order has been repl aced .. S ^TMP("ORSO RT",$J,999 9999-TM,TO ,IFN)="" S TM=0 F S TM=$O(^TM P("ORSORT" ,$J,TM)) Q :'TM S TO =0 F S TO =$O(^TMP(" ORSORT",$J ,TM,TO)) Q :'TO D .S IFN=0 F S IFN=$O(^ TMP("ORSOR T",$J,TM,T O,IFN)) Q: 'IFN I $D (^OR(100,I FN,0)),$D( ^(3)) S X0 =^(0),X3=^ (3) D ..S ACTOR=+$P( X3,U,7) D LP1^ORQ11 ..;S ACTOR =0 F S ACT OR=$O(^OR( 100,"ACT", PAT,999999 9-$P(X0,U, 7),TO,IFN, ACTOR)) Q: ACTOR<1 I '$D(^TMP(" ORGOTIT",$ J,IFN,ACTO R)),$D(^OR (100,IFN,8 ,ACTOR,0)) ,$P(^(0),U ,15)'=13 S X8=^(0),X 7=$G(^(7)) D LP1^ORQ 11 S ^TMP( "ORR",$J,O RLIST,"TOT ")=$G(ORLS T) K ^TMP( "ORSORT",$ J),^TMP("O RGOTIT",$J ) QGETEIE( IFN,NEWD,D ETAIL,ACTO R) ; -- Se tup TMP ar ray ; IFN= ifn of ord er ; NEWD= 3rd subscr ipt in ^TM P("ORR",$J , node (OR LIST) ; DE TAIL=see d escription in ^ORQ1 ; N X0,X3, X4,X6,TXT, STAT,START ,DG,STOP,E NTERD,DCRE AS S X0=^O R(100,IFN, 0),X3=$G(^ (3)),X4=$G (^(4)),X6= $G(^(6)) S DG=$P(X0, U,11),DG=$ P($G(^ORD( 100.98,+DG ,0)),U,3) S STAT=$S( $P(X3,U,3) :$P(^ORD(1 00.01,$P(X 3,U,3),0), U,1,2),1:" ") S ENTER D=$P(X0,U, 7),START=$ P(X0,U,8), STOP=$P(X0 ,U,9) S DC REAS=$P($G (X6),U,4) Q:DCREAS'> 0 I DCREAS '=$O(^ORD( 100.03,"B" ,"Entered in error", "")) Q S O RLST=ORLST +1,^TMP("O RGOTIT",$J ,IFN,+$G(A CTOR))="" I '$G(DETA IL) S ^TMP ("ORR",$J, NEWD,ORLST )=IFN_$S($ G(ACTOR):" ;"_ACTOR,1 :"") Q S ^ TMP("ORR", $J,NEWD,OR LST)=IFN_$ S($G(ACTOR ):";"_ACTO R,1:"")_U_ DG_U_ENTER D_U_START_ U_STOP_U_S TAT D TEXT (.TXT,IFN) M ^TMP("O RR",$J,NEW D,ORLST,"T X")=TXT Q | |
| 283 | After: | |
| 284 | ORQ12 ; sl c/dcm - Ge t patient orders in context ;0 8/05/15 11 :03 ;;3.0; ORDER ENTR Y/RESULTS REPORTING; **12,27,78 ,92,116,19 0,220,215, 243,356,37 7**;Dec 17 , 1997;Bui ld 299GET( IFN,NEWD,D ETAIL,ACTO R) ; -- Se tup TMP ar ray ; IFN= ifn of ord er ; NEWD= 3rd subscr ipt in ^TM P("ORR",$J , node (OR LIST) ; DE TAIL=see d escription in ^ORQ1 ; N X0,X3, X4,X6,TXT, STAT,START ,DG,STOP,E NTERD S OR LST=ORLST+ 1,^TMP("OR GOTIT",$J, IFN,+$G(AC TOR))="" I '$G(DETAI L) S ^TMP( "ORR",$J,N EWD,ORLST) =IFN_$S($G (ACTOR):"; "_ACTOR,1: "") Q S X0 =^OR(100,I FN,0),X3=$ G(^(3)),X4 =$G(^(4)), X6=$G(^(6) ) S DG=$P( X0,U,11),D G=$P($G(^O RD(100.98, +DG,0)),U, 3) S STAT= $S($P(X3,U ,3):$P(^OR D(100.01,$ P(X3,U,3), 0),U,1,2), 1:"") ;.01 ^abbr S EN TERD=$P(X0 ,U,7),STAR T=$P(X0,U, 8),STOP=$P (X0,U,9) ; S FLAGREA =$P(X6,U,7 ) S ^TMP(" ORR",$J,NE WD,ORLST)= IFN_$S($G( ACTOR):";" _ACTOR,1:" ")_U_DG_U_ ENTERD_U_S TART_U_STO P_U_STAT D TEXT(.TXT ,IFN_";"_$ G(ACTOR)) M ^TMP("OR R",$J,NEWD ,ORLST,"TX ")=TXT Q ; TEXT(ORTX, ORIFN,WIDT H) ; -- Re turns text of order ORIFN in O RTX(#) N O R0,OR3,OR6 ,X,Y,FIRST ,ORI,ORJ,D LG,ORX,ORA CT,ORTA K ORTX S:'$G (WIDTH) WI DTH=244 S ORACT=+$P( ORIFN,";", 2),ORIFN=+ ORIFN I OR ACT<1 S OR ACT=+$P($G (^OR(100,O RIFN,3)),U ,7) S:'ORA CT ORACT=1 ;D:$O(^OR (100,ORIFN ,1,0)) CNV ^ORY92(ORI FN) ;conve rt text ot f S OR0=$G (^OR(100,O RIFN,0)),O R3=$G(^(3) ),OR6=$G(^ (6)),ORX=$ G(^(8,ORAC T,0)) S OR TX=1,ORTX( 1)="" I $P ($G(OR0),U ,11)'="",( $P(^ORD(10 0.98,$P(OR 0,U,11),0) ,U)="NON-V A MEDICATI ONS") S X= "Non-VA" D ADD G:$G( ORIGVIEW)> 1 T1 S:$P( OR0,U,14)= $O(^DIC(9. 4,"C","OR" ,0)) ORTX( 1)=">>" ;g eneric S X =$$ACTION( $P(ORX,U,2 )) D:$L(X) ADD I $P( ORX,U,2)=" NW",$P(OR3 ,U,11),'$G (ORIGVIEW) D ; Chan ged or Ren ewed . I $ P(OR3,U,11 )=2 S X="R enew" D AD D Q . N OR IG,ORIGTA S ORIG=+$P (OR3,U,5) Q:'ORIG Q :$P(OR3,U, 11)'=1 . S X="Change " D ADD S ORI=0 . I $G(IOST)'= "P-OTHER" D . .S ORI GTA=$$LAST XT(ORIG) ; D:$O(^OR(1 00,ORIG,1, 0)) CNV^OR Y92(ORIG) . .F S OR I=$O(^OR(1 00,ORIG,8, ORIGTA,.1, ORI)) Q:OR I'>0 S X=$ G(^(ORI,0) ) S:$E(X,1 ,3)=">> " X=$E(X,4,9 99) D ADD . .S X=" t o" D ADDT1 S ORTA=+$ P(ORX,U,14 ),FIRST=+$ O(^OR(100, ORIFN,8,OR TA,.1,0)) S ORI=0 F S ORI=$O( ^OR(100,OR IFN,8,ORTA ,.1,ORI)) Q:ORI'>0 S X=$G(^(OR I,0)) S:(F IRST=ORI)& ($E(X,1,3) =">> ") X= $E(X,4,999 ) D:$L(X) ADD Q:$G(O RIGVIEW)>1 ;contents of global only S DL G=$P(OR0,U ,5) K Y I DLG,$P(DLG ,";",2)["1 01.41",$D( ^ORD(101.4 1,+DLG,9)) X ^(9) I $L($G(Y)) S X=Y D AD D ; additi onal text ; I $P(OR3 ,U,11)=2 S X="(Renew al)" D ADD I $P(ORX, U,4)=2 S X ="*UNSIGNE D*" D ADD S ORXZ=$D( ^OR(100,OR IFN,8,ORAC T,5,0)) I ORXZ S X=$ G(^OR(100, ORIFN,8,OR ACT,5,1,0) ) D:$L(X) ADD K ORXZ ;adds War d Comments I $P(ORX, U,2)="DC"! ("^1^13^"[ (U_$P(OR3, U,3)_U)),$ L(OR6) S X =" <"_$S($ L($P(OR6,U ,5)):$P(OR 6,U,5),$P( OR6,U,4):$ P($G(^ORD( 100.03,+$P (OR6,U,4), 0)),U),1:" ")_">" D:$ L(X)>3 ADD ; DC Reas on I +$G(^ OR(100,ORI FN,8,ORACT ,3)),$L($P (^OR(100,O RIFN,8,ORA CT,3),U,5) ) S X="*Fl agged - "_ $P(^OR(100 ,ORIFN,8,O RACT,3),U, 5)_" - " D ADD I $D (XQAID),$G (ORFLG)=12 S ORX=$G( ^OR(100,OR IFN,8,ORAC T,3)) I $P (ORX,U) S X=" Flagge d "_$$DATE TIME($P(OR X,U,3))_$S ($P(ORX,U, 4):" by "_ $$NAME($P( ORX,U,4)), 1:"")_": " _$P(ORX,U, 5) D ADD ; Flagged - show in F UP Q ;LAST XT(IFN) ; -- Returns action wi th latest text for o rder IFN N I,Y S Y=1 S I=0 F S I=$O(^OR (100,IFN,8 ,I)) Q:I'> 0 S:$O(^(I ,.1,0)) Y= I Q Y ;LAS T(CODE) ; -- Return DA of last occurence of CODE a ction N DA I '$L($G( CODE)) S D A=$O(^OR(1 00,ORIFN,8 ,"A"),-1) ; last ent ry E S DA =$O(^OR(10 0,ORIFN,8, "C",CODE," ?"),-1) ; last CODE entry Q DA ;ACTION(X ) ; -- Ret urns text of action X N Y S Y= $S(X="DC": "Discontin ue",X="HD" :"Hold",X= "RL"&'$G(O RIGVIEW):" Release Ho ld of",X=" FL":"Flag" ,X="UF":"U nflag",X=" RN"&'$G(OR IGVIEW):"R enew",1:"" ) Q Y ;DAT ETIME(X) ; -- Return s date/tim e in forma t 00/00/00 @00:00am N Y,D,T,T1, Z S D=$P(X ,"."),T=$E ($P(X,".", 2)_"0000", 1,4),T1=$E (T,1,2),Z= "AM" S:T1> 12 T1=T1-1 2,Z="PM" S Y=$E(D,4, 5)_"/"_$E( D,6,7)_"/" _(1700+$E( D,1,3))_"@ "_T1_":"_$ E(T,3,4)_Z Q Y ;NAME (X) ; -- R eturns nam e as Lname ,F N Y,Z S Z=$P($G(^ VA(200,+X, 0)),U) Q:Z ="" "" S Y =$P(Z,",") _"," F I=$ F(Z,","):1 :$L(Z) I $ E(Z,I)'=" " S Y=Y_$E (Z,I) Q S Y=$$LOWER^ VALM1(Y) ; mixed cas e Q Y ;ADD ; -- Add text X to ORTX() N I ,Y S Y=$L( ORTX(ORTX) ) S:Y Y=Y+ 1 ;allow f or space I $E(X)=" " ,Y S ORTX= ORTX+1,ORT X(ORTX)="" ,Y=0,X=$E( X,2,999) ; new line I Y+$L(X)'> WIDTH S OR TX(ORTX)=O RTX(ORTX)_ $S(Y:" ",1 :"")_X Q F I=1:1:$L( X," ") S Z =$P(X," ", I) D:(Y+$L (Z))>WIDTH S ORTX(O RTX)=$G(OR TX(ORTX))_ $S(Y:" ",1 :"")_Z,Y=$ L(ORTX(ORT X)) S:Y Y= Y+1 . I $L (Z)>WIDTH F S ORTX( ORTX)=$G(O RTX(ORTX)) _$S(Y:" ", 1:"")_$E(Z ,1,WIDTH-Y ),Z=$E(Z,W IDTH-Y+1,9 99) Q:$L(Z )'>WIDTH S ORTX=ORT X+1,Y=0 . S ORTX=ORT X+1,Y=0 Q ;EXPD ; -- loop thro ugh ^XTMP( "ORAE" to get expire d orders K ^TMP("ORG OTIT",$J), ^TMP("ORSO RT",$J) N TM,TO,IFN, X0,X3,X7,X 8,USTS,NOW ,ACTOR,X,O RREP S NOW =+$E($$NOW ^XLFDT,1,1 2),TO=0,SD ATE=999999 9-SDATE,ED ATE=999999 9-EDATE F S TO=$O(^ XTMP("ORAE ",PAT,TO)) Q:'TO I $D(ORGRP(T O)) S TM=E DATE F S TM=$O(^XTM P("ORAE",P AT,TO,TM)) Q:'TM!(TM >SDATE)!(+ TM<EDATE) D . S IFN= 0 F S IFN =$O(^XTMP( "ORAE",PAT ,TO,TM,IFN )) Q:'IFN I ('$D(^T MP("ORGOTI T",$J,IFN) )!MULT) D .. ;*356 P rotect if x-ref dang les. .. I '$D(^OR(10 0,IFN)) K ^XTMP("ORA E",PAT,TO, TM,IFN) Q .. S USTS= $P(^OR(100 ,IFN,3),U, 3) .. Q:+$ G(USTS)'=7 ;quit if order no l onger expi red .. S O RREP=$P(^O R(100,IFN, 3),U,6) .. Q:+$G(ORR EP)>0 ;qui t if order has been replaced . . S ^TMP(" ORSORT",$J ,9999999-T M,TO,IFN)= "" S TM=0 F S TM=$O (^TMP("ORS ORT",$J,TM )) Q:'TM S TO=0 F S TO=$O(^T MP("ORSORT ",$J,TM,TO )) Q:'TO D .S IFN=0 F S IFN= $O(^TMP("O RSORT",$J, TM,TO,IFN) ) Q:'IFN I $D(^OR(1 00,IFN,0)) ,$D(^(3)) S X0=^(0), X3=^(3) D ..S ACTOR= +$P(X3,U,7 ) D LP1^OR Q11 ..;S A CTOR=0 F S ACTOR=$O( ^OR(100,"A CT",PAT,99 99999-$P(X 0,U,7),TO, IFN,ACTOR) ) Q:ACTOR< 1 I '$D(^T MP("ORGOTI T",$J,IFN, ACTOR)),$D (^OR(100,I FN,8,ACTOR ,0)),$P(^( 0),U,15)'= 13 S X8=^( 0),X7=$G(^ (7)) D LP1 ^ORQ11 S ^ TMP("ORR", $J,ORLIST, "TOT")=$G( ORLST) K ^ TMP("ORSOR T",$J),^TM P("ORGOTIT ",$J) QGET EIE(IFN,NE WD,DETAIL, ACTOR) ; - - Setup TM P array ; IFN=ifn of order ; N EWD=3rd su bscript in ^TMP("ORR ",$J, node (ORLIST) ; DETAIL=s ee descrip tion in ^O RQ1 ; N X0 ,X3,X4,X6, TXT,STAT,S TART,DG,ST OP,ENTERD, DCREAS S X 0=^OR(100, IFN,0),X3= $G(^(3)),X 4=$G(^(4)) ,X6=$G(^(6 )) S DG=$P (X0,U,11), DG=$P($G(^ ORD(100.98 ,+DG,0)),U ,3) S STAT =$S($P(X3, U,3):$P(^O RD(100.01, $P(X3,U,3) ,0),U,1,2) ,1:"") S E NTERD=$P(X 0,U,7),STA RT=$P(X0,U ,8),STOP=$ P(X0,U,9) S DCREAS=$ P($G(X6),U ,4) Q:DCRE AS'>0 I DC REAS'=$O(^ ORD(100.03 ,"B","Ente red in err or","")) Q S ORLST=O RLST+1,^TM P("ORGOTIT ",$J,IFN,+ $G(ACTOR)) ="" I '$G( DETAIL) S ^TMP("ORR" ,$J,NEWD,O RLST)=IFN_ $S($G(ACTO R):";"_ACT OR,1:"") Q S ^TMP("O RR",$J,NEW D,ORLST)=I FN_$S($G(A CTOR):";"_ ACTOR,1:"" )_U_DG_U_E NTERD_U_ST ART_U_STOP _U_STAT D TEXT(.TXT, IFN) M ^TM P("ORR",$J ,NEWD,ORLS T,"TX")=TX T Q | |
| 285 | ORWDXM3 | |
| 286 | Before: | |
| 287 | ORWDXM3 ; SLC/KCM/JL I - Quick Orders ;08 /13/15 20: 49 ;;3.0;O RDER ENTRY /RESULTS R EPORTING;* *10,85,131 ,132,141,1 85,187,190 ,195,215,2 43,303,296 ,280,350,3 77**;Dec 1 7, 1997;Bu ild 299 ;V ALCOUNT(NA ME,ORDIALO G) ; N COU NT,IEN,NUM S NUM=0,C OUNT=0 S I EN=$P($G(O RDIALOG("B ",NAME)),U ,2) Q:IEN' >0 F S NU M=$O(ORDIA LOG(IEN,NU M)) Q:+NUM '>0 S COUN T=COUNT+1 Q COUNT ;I SMISSFL(OR DIALOG,IVT YPE) ; N A DDCNT,RESU LT,SOLCNT, STRCNT S R ESULT=0 S ADDCNT=$$V ALCOUNT("A DDITIVE",. ORDIALOG) S STRCNT=$ $VALCOUNT( "STRENGTH" ,.ORDIALOG ) S SOLCNT =$$VALCOUN T("SOLUTIO N",.ORDIAL OG) I IVTY PE'="I",AD DCNT'=STRC NT S RESUL T=1 I IVTY PE="I" D . I ADDCNT=0 ,SOLCNT>0 Q .I ADDCN T=0 S RESU LT=1 Q .I ADDCNT'=ST RCNT S RES ULT=1 Q Q RESULT ;IV ADFCHK(ORD IALOG) ; ; This line tag check s to see i f there ar e the same number of values ;f or ADDITIV E and Addi tive Frequ ency. This also chec ks to see if ;the va lue assign ed to ADDF REQ is one of the th ree possib le values ;All Bags, 1 bag/day , See Comm ents. If S ee Comment s it also checks ;fo r text in the commen t section. N ADDCNT, ADDFCNT,AD DFREQ,COMM ENT,FREQ,I NST,RESULT S ADDCNT= $$VALCOUNT ("ADDITIVE ",.ORDIALO G) S ADDFC NT=$$VALCO UNT("ADDIT IVE FREQUE NCY",.ORDI ALOG) I AD DCNT'=ADDF CNT Q 0 S ADDFREQ=$O (^ORD(101. 41,"AB","O R GTX ADDI TIVE FREQU ENCY","")) S COMMENT =$O(^ORD(1 01.41,"AB" ,"OR GTX W ORD PROCES SING 1","" )) I +$G(A DDFREQ)'>0 Q O S INS T=0,RESULT =1 F S IN ST=$O(ORDI ALOG(ADDFR EQ,INST)) Q:INST'>0! (RESULT=0) D .S FREQ =$$ADDFRQC V^ORMBLDP1 ($G(ORDIAL OG(ADDFREQ ,INST)),"O ") .I FREQ ="A"!(FREQ =1) Q .I F REQ="" S R ESULT=0 Q .I FREQ="S ",'$L($G(O RDIALOG(CO MMENT,1))) S RESULT= 0 Q Q RESU LT ;KEYVAR (DLG) ; Pa rse entry action for key varia bles & ret urn in str ing ; RV=C ollTp^Samp ^Spec^Coll Dt^Urg^Sch ed^NoComm^ NoDiag^NoP rov^NoRsn N XCODE,RV ,POS,Z S X CODE=$G(^O RD(101.41, DLG,3)),RV ="" I '$L( XCODE) Q " " S POS=$F (XCODE,"LR FZX=") I P OS S $P(RV ,U,1)=$$VA LUE(XCODE, POS) S POS =$F(XCODE, "LRFSAMP=" ) I POS S $P(RV,U,2) =$$VALUE(X CODE,POS) S POS=$F(X CODE,"LRFS PEC=") I P OS S $P(RV ,U,3)=$$VA LUE(XCODE, POS) S POS =$F(XCODE, "LRFDATE=" ) I POS S $P(RV,U,4) =$$VALUE(X CODE,POS) S POS=$F(X CODE,"LRFU RG=") I PO S S $P(RV, U,5)=$$VAL UE(XCODE,P OS) S POS= $F(XCODE," LRFSCH=") I POS S $P (RV,U,6)=$ $VALUE(XCO DE,POS) S POS=$F(XCO DE,"PSJNOP C=") I POS S $P(RV,U ,7)=$$VALU E(XCODE,PO S) S POS=$ F(XCODE,"G MRCNOPD=") I POS S $ P(RV,U,8)= $$VALUE(XC ODE,POS) S POS=$F(XC ODE,"GMRCN OAT=") I P OS S $P(RV ,U,9)=$$VA LUE(XCODE, POS) S POS =$F(XCODE, "GMRCREAF= ") I POS S $P(RV,U,1 0)=$$VALUE (XCODE,POS ) S POS=$F (XCODE,"OR FORGET=") I POS D . ; need to change thi s so that it is exec uted in SE TKEYV so . ; that it is execut ed each ti me menu is revisited . N ORFOR GET S ORFO RGET=$$VAL UE(XCODE,P OS) . I OR FORGET K ^ TMP("ORECA LL",$J,+OR FORGET) . E K ^TMP( "ORECALL", $J) Q RVVA LUE(STR,BE G) ; Retur n value of "var=" (c opied from ORCONVRT) N X,Y,I S X=$E(STR, BEG,999),Y ="" S:$E(X )="""" X=$ E(X,2,999) ; strip l eading " F I=1:1:$L( X) S Z=$E( X,I) Q:(Z= ",")!(Z=" ")!(Z="""" ) S Y=Y_Z Q $TR(Y,U, "") ;SETKE YV(X) ; Se t the key variables based on c ontents of X I $L($P (X,U,1)) S LRFZX=$P( X,U,1) I $ L($P(X,U,2 )) S LRFSA MP=$P(X,U, 2) I $L($P (X,U,3)) S LRFSPEC=$ P(X,U,3) I $L($P(X,U ,4)) S LRF DATE=$P(X, U,4) I $L( $P(X,U,5)) S LRFURG= $P(X,U,5) I $L($P(X, U,6)) S LR FSCH=$P(X, U,6) I $L( $P(X,U,7)) S PSJNOPC =$P(X,U,7) I $L($P(X ,U,8)) S G MRCNOPD=$P (X,U,8) I $L($P(X,U, 9)) S GMRC NOAT=$P(X, U,9) I $L( $P(X,U,10) ) S GMRCRE AF=$P(X,U, 10) QDLGIN FO(IEN,MOD E) ; retur n informat ion about a dialog ; IEN=DlgIE N or ORIFN , MODE=0:D lg,1:Copy, 2:Change ; RESULT=Dl gIEN^DlgTy pe^FormID^ DGrp ; If MODE="1;T" ,don't che ck "PS MED S" for tra nsfer orde r ; PSMDGP =1: Unit/D ose Group ; PSMDGP=2 : OutPatie nt Group N X0,DLGIEN ,TYP,FID,D GRP,PSMDGP ,ISXF S PS MDGP=0,ISX F="" S ISX F=$P(MODE, ";",2) S M ODE=+MODE S DLGIEN=I EN I MODE, (ISXF'="T" ) D . S DL GIEN=+$P($ G(^OR(100, +IEN,0)),U ,5) . I $P (^ORD(101. 41,DLGIEN, 0),U)="PS MEDS" D . . N PTCAT S PTCAT=$P ($G(^OR(10 0,+IEN,0)) ,U,12) . . I PTCAT=" I" S DLGIE N=$O(^ORD( 101.41,"B" ,"PSJ OR P AT OE",0)) ,PSMDGP=1 . . I PTCA T="O" S DL GIEN=$O(^O RD(101.41, "B","PSO O ERR",0)),P SMDGP=2 I MODE,(ISXF ="T") S DL GIEN=+$P($ G(^OR(100, +IEN,0)),U ,5) S X0=$ G(^ORD(101 .41,DLGIEN ,0)),TYP=$ P(X0,U,4), DGRP=$P(X0 ,U,5) I MO DE S DGRP= +$P($G(^OR (100,+IEN, 0)),U,11) ;JD NEW ST ART 11/13/ 02 I DLGIE N=$O(^ORD( 101.41,"B" ,"PSJ OR P AT OE",0)) S PSMDGP= 1 I DLGIEN =$O(^ORD(1 01.41,"B", "PSO OERR" ,0)) S PSM DGP=2 ;JD NEW END 11 /13/02 ; f or copy or change, i f the base dialog ha s changed, use it's info I MOD E,$G(ORDIA LOG),(+DLG IEN'=+ORDI ALOG),(PSM DGP=0) D . S DLGIEN= +ORDIALOG, DGRP=$P(^O RD(101.41, +ORDIALOG, 0),U,5) D FORMID^ORW DXM(.FID,D LGIEN) Q D LGIEN_U_TY P_U_FID_U_ DGRP ;CHKD SBL(LST,ID ,MODE) ; r eturn mess age if dia log disabl ed ; ID=Dl gIEN or OR IFN, MODE= 0:Dialog,1 :Copy,2:Ch ange ; LST =QL_REJECT + disable d message or unchang ed S DLGIE N=+ID I MO DE S DLGIE N=+$P($G(^ OR(100,+ID ,0)),U,5) S X0=$G(^O RD(101.41, DLGIEN,0)) ,X=$P(X0,U ,3) I '$L( X),($P(X0, U,4)="Q") D ; check default d ialog . S DLGIEN=+$$ DEFDLG^ORW DXQ($P(X0, U,5)) . S X=$P($G(^O RD(101.41, DLGIEN,0)) ,U,3) I $L (X) D . I MODE D GET TXT^ORWORR (.LST,ID) S LST(.6)= "",LST(.7) ="Cannot " _$S(MODE=1 :"Copy",1: "Change")_ " -" . S L ST(0)="8^0 ",LST(.5)= "Dialog Di sabled: "_ X QCHKVACT (LST,ID,MO DE,ORNP) ; return me ssage if a ction not valid ; ID =DlgIEN or ORIFN, MO DE=0:Dialo g,1:Copy,2 :Change ; LST=QL_REJ ECT + inva lid action message o r unchange d Q:'MODE ; not an action on an order N X,ACT S A CT=$S(MODE =1:"RW",MO DE=2:"XX", 1:"") D VA LID^ORWDXA (.X,ID,ACT ,ORNP) I $ L(X) D GET TXT^ORWORR (.LST,ID) D . S LST( 0)="8^0",L ST(.5)=X,L ST(.6)="", LST(.7)="C annot "_$S (MODE=1:"C opy",1:"Ch ange")_" - " QCHKCOPY (LST,ID,FL DS) ; retu rn message if can't copy this order ; ID =ORIFN;ACT FLDS=Even tType in 7 th piece ; LST=QL_RE JECT + can not copy m essage or unchanged I "^A^D^T^ "'[(U_$E($ P(FLDS,U,7 ))_U) Q ; not even t delayed N PKG S PK G=$P($G(^O R(100,+ID, 0)),U,14) S PKG=$$NM SP^ORCD(PK G) I PKG=" OR"!(PKG=" PS") Q ; xfer med s, generic s N ORWCAT S ORWCAT= $P($G(^OR( 100,+ID,0) ),U,12) I ORWCAT="I" ,("^A^T^"[ (U_$E($P(F LDS,U,7))_ U)) Q ; admit, xfe r inpt I O RWCAT="O", $E($P(FLDS ,U,7))="D" Q ; d ischarge o utpt D GET TXT^ORWORR (.LST,ID) I ORWCAT=" I" S LST(. 5)="inpati ent order to outpati ent -" I O RWCAT="O" S LST(.5)= "outpatien t order to inpatient -" S:$D(L ST(.5)) LS T(.5)="Can not copy t he followi ng "_LST(. 5) S LST(0 )="8^0",LS T(.7)="" Q BLD4CHG(LS T,ID,FLDS) ; build r esponses f or an edit ; ID=ORIF N;ACT FLDS =unused ri ght now ; LST(0)=Qlv l^RespID(X OrderID)^D lgIEN^DlgT ype^FormID ^DGrp N OI DX,OI,CNT S (OI,OIDX ,CNT)=0 S: $D(^OR(100 ,+ID,4.5," ID","ORDER ABLE")) OI DX=$O(^OR( 100,+ID,4. 5,"ID","OR DERABLE",0 )) I $D(^O R(100,+ID, 4.5,OIDX)) D . F S CNT=$O(^OR (100,+ID,4 .5,OIDX,CN T)) Q:'CNT D . . S OI=^(CNT) D VALDOI I +LST(0)=8 S LST(.5) ="You can not change this orde r." Q S LS T(0)="0^X" _ID_U_$$DL GINFO(+ID, 2) S $P(LS T(0),U,4)= "X" QGETIV TYP() ; N RESULT,TYP EIEN S RES ULT="" S T YPEIEN=$O( ^ORD(101.4 1,"B","OR GTX IV TYP E","")) I TYPEIEN'>0 Q RESULT S RESULT=$ G(ORDIALOG (TYPEIEN,1 )) Q RESUL T ;ISTUBEQ O(IFN) ; N DG,DIAL S DG=+$P($G (^ORD(101. 41,IFN,0)) ,U,5) S DI AL=$P($G(^ ORD(100.98 ,DG,0)),U, 4) I +$G(D IAL)=0 Q 0 I $P($G(^ ORD(101.41 ,DIAL,0)), U)="FHW8" Q 1 Q 0 ;V ALDOI ; Va lidate the Orderable Items N O RQUIT,ORPS I $G(^ORD (101.43,OI ,.1)),^(.1 )'>$$NOW^X LFDT D . S ORQUIT=1 . S LST(0) ="8^0" I $ D(ORQUIT) Q:ORQUIT S ORPS=$G(^ ORD(101.43 ,+OI,"PS") ) I $P(ORP S,U,1,4)=" 0^0^0^0",( $P(ORPS,U, 7)=0) S LS T(0)="8^0" QVERDUR(O RDIALOG) ; ;check fo r duration value if a THEN con junation i s used N C ONJ,CONVAL UE,DUR,I,S UCC S SUCC =1 S CONJ= $$PTR^ORCD PS1("AND/T HEN") S DU R=$$PTR^OR CDPS1("DUR ATION") S I=0 F S I =$O(ORDIAL OG(CONJ,I) ) Q:I'>0!( SUCC=0) D . I $$UP^X LFSTR($E($ G(ORDIALOG (CONJ,I)), 1))="T" D . . I '$L( $G(ORDIALO G(DUR,I))) S SUCC=0 Q SUCC ;VE RORD(OIEN) ; N IFN,I NFUSE,INFU ID,ODG,ODP ,ASSIV,SUC C,TYPE S S UCC=0,IFN= ORDIALOG S ODP=+$P($ G(^ORD(101 .41,+IFN,0 )),U,7),OD G=+$P($G(^ (0)),U,5) S ODP=$$GE T1^DIQ(9.4 ,+ODP_",", 1),ODG=$P( $G(^ORD(10 0.98,ODG,0 )),U,3) I ODP'["PS" Q 1 I ODP= "PSH" Q 1 ;check inf usion rate for IV QO I ODG="IV RX"!(ODG= "TPN") D Q SUCC .S TYPE=$$GET IVTYP .I T YPE="" Q . S PASSIV=$ $IVRTECHK .I PASSIV= 0 Q .S INF UID=$O(^OR D(101.41," B","OR GTX INFUSION RATE",0)) .S INFUSE= $G(ORDIALO G(INFUID,1 )) .S SUCC =$$VALINF( TYPE,INFUS E) .I SUCC =0 Q .I TY PE="C" S S UCC=$$IVAD FCHK(.ORDI ALOG) I (O DP="PSJ")! (ODP="PSO" ),ODG'="IV RX",ODG'= "TPN" S SU CC=$$VERDU R(.ORDIALO G) Q SUCC ;VALINF(TY PE,INFUSE) ; N SUCC S SUCC=0 I TYPE="I" D Q SUCC .I INFUSE= "" S SUCC= 1 Q .I $TR (INFUSE,"a bcdefghijk lmnopqrstu vwxyz","AB CDEFGHIJKL MNOPQRSTUV WXYZ")["IN FUSE OVER" S SUCC=1 Q .I $L(IN FUSE)>4 Q Q 1 ;VALQO (IFN) ;Che ck to see if it's a good QO me d ;If it's an IV QO: check if infusion r ate entere d ;If it's an UD QO: check if dosage ent ered ;regu lar order treated as good QO ; I IFN[";" ,($$UPCTCH K^ORWDXA(+ IFN)) Q 0 I $P($G(^O RD(101.41, IFN,0)),U, 4)'="Q" Q 1 N ODP,OD G,INFUID,I NFUSE,DSAG EID,SUCC,P ASSIV,TYPE S SUCC=0 S ODP=+$P( $G(^ORD(10 1.41,IFN,0 )),U,7),OD G=+$P($G(^ (0)),U,5) S ODP=$$GE T1^DIQ(9.4 ,+ODP_",", 1),ODG=$P( $G(^ORD(10 0.98,ODG,0 )),U,3) I ODP'["PS" Q 1 I ODP= "PSH" Q 1 ;check inf usion rate for IV QO I ODG="IV RX"!(ODG= "TPN") D . S INFUID= $O(^ORD(10 1.41,"B"," OR GTX INF USION RATE ",0)) . S TYPE=$$GET IVTYP . I TYPE="" Q . I $D(ORD IALOG(INFU ID,1)) D . . I TYPE= "I" D Q . . . S INF USE=$G(ORD IALOG(INFU ID,1)) . . . I INFUS E="" Q . . . I INFUS E["INFUSE OVER" S SU CC=1 Q . . . I $L(IN FUSE)>4 Q . . . I +I NFUSE>0 S INFUSE="IN FUSE OVER "_INFUSE_" Minutes" . . . S OR DIALOG(INF UID,1)=INF USE,SUCC=1 . . S SUC C=1 . ; ad ditive fre quency che ck/infusio n rate che cks for co ntinuous o rders . I TYPE="C" D I SUCC=0 Q . . I $ D(ORDIALOG (INFUID,1) ) S SUCC=1 I SUCC=0 Q . . S SU CC=$$IVADF CHK(.ORDIA LOG) . I S UCC=0 Q . I '$D(ORDI ALOG(INFUI D,1)),TYPE ="I" S SUC C=1 . S PA SSIV=$$IVR TECHK . I SUCC=0 Q . I PASSIV= 0 S SUCC=0 . I SUCC= 1,$$ISMISS FL(.ORDIAL OG,TYPE)=1 S SUCC=0 ;check dos age for UD QO I (ODP ="PSJ")!(O DP="PSO"), ODG'="IV R X",ODG'="T PN" D . S DSAGEID=$O (^ORD(101. 41,"B","OR GTX INSTR UCTIONS",0 )) . I $D( ORDIALOG(D SAGEID,1)) S SUCC=1 . I SUCC=0 Q . ; . S SUCC=$$VE RDUR(.ORDI ALOG) ; I SUCC=1,$P( $G(^ORD(10 1.41,IFN,5 )),U,8) D .N COMMID, WPCNT .S C OMMID=$O(^ ORD(101.41 ,"B","OR G TX WORD PR OCESSING 1 ",0)) .S C OMMID=$O(^ ORD(101.41 ,IFN,6,"D" ,COMMID,0) ) .I COMMI D S WPCNT= 0 F S WPC NT=$O(^ORD (101.41,IF N,6,COMMID ,2,WPCNT)) Q:'WPCNT! ('SUCC) D ..I ^ORD(1 01.41,IFN, 6,COMMID,2 ,WPCNT,0)[ "^" S SUCC =0 Q SUCC ;IVRTECHK( ) ; N RTIE N,RTVALUE, RESULT N C NT,NUM,ORD ERIDS,OIIE N,OTYPE,RO UTE S CNT= 0,RESULT=0 S RTIEN=+ $P($G(ORDI ALOG("B"," ROUTE")),U ,2) I RTIE N'>0 Q RES ULT S RTVA LUE=+$G(OR DIALOG(RTI EN,1)) I R TVALUE'>0 Q RESULT F OTYPE="SO LUTION","A DDITIVE" D .S OIIEN= +$P($G(ORD IALOG("B", OTYPE)),U, 2) I OIIEN >0 D ..S N UM=0 F S NUM=$O(ORD IALOG(OIIE N,NUM)) Q: NUM'>0 I + $G(ORDIALO G(OIIEN,NU M))>0 D .. .S CNT=CNT +1,ORDERID S(CNT)=ORD IALOG(OIIE N,NUM) I $ D(ORDERIDS )=0 Q S RO UTE=$$IVQO VAL^ORWDPS 33(.ORDERI DS,RTVALUE ) I ROUTE= "" S ORDIA LOG(RTIEN, 1)=ROUTE I ROUTE'="" S RESULT= 1 ;K ^TMP( $J,"ORWDXM 3 IVRTECHK ") ;D ALL^ PSS51P2(RT VALUE,,,," ORWDXM3 IV RTECHK") ; I +^TMP($J ,"ORWDXM3 IVRTECHK", RTVALUE,6) '=1 S ORDI ALOG(RTIEN ,1)="",RES ULT=0 ;K ^ TMP($J,"OR WDXM3 IVRT ECHK") Q R ESULT ;ISU DQO(ORY,DL GID) ;True : is unit dose quick order S O RY=0 Q:'$D (^ORD(101. 41,DLGID,0 )) N CLODG RP,CLIVDGR P,UDGRP1,U DGRP2,DLGT YP,DLGGRP S UDGRP1=$ O(^ORD(100 .98,"B","U D RX",0)) S UDGRP2=$ O(^ORD(100 .98,"B","I RX",0)) S CLODGRP=$ O(^ORD(100 .98,"B","C LINIC MEDI CATIONS"," ")) S CLIV DGRP=$O(^O RD(100.98, "B","CLINI C INFUSION S","")) S DLGTYP=$P( $G(^ORD(10 1.41,DLGID ,0)),U,4) | |
| 288 | S DLGGRP= $P($G(^ORD (101.41,DL GID,0)),U, 5) I (DLGT YP="Q"),(( DLGGRP=UDG RP1)!(DLGG RP=UDGRP2) !(DLGGRP=C LODGRP)!(D LGGRP=CLIV DGRP)) S O RY=1 Q | |
| 289 | After: | |
| 290 | ORWDXM3 ; SLC/KCM/JL I - Quick Orders ;08 /13/15 20: 49 ;;3.0;O RDER ENTRY /RESULTS R EPORTING;* *10,85,131 ,132,141,1 85,187,190 ,195,215,2 43,303,296 ,280,350,3 77**;Dec 1 7, 1997;Bu ild 299 ;V ALCOUNT(NA ME,ORDIALO G) ; N COU NT,IEN,NUM S NUM=0,C OUNT=0 S I EN=$P($G(O RDIALOG("B ",NAME)),U ,2) Q:IEN' >0 F S NU M=$O(ORDIA LOG(IEN,NU M)) Q:+NUM '>0 S COUN T=COUNT+1 Q COUNT ;I SMISSFL(OR DIALOG,IVT YPE) ; N A DDCNT,RESU LT,SOLCNT, STRCNT S R ESULT=0 S ADDCNT=$$V ALCOUNT("A DDITIVE",. ORDIALOG) S STRCNT=$ $VALCOUNT( "STRENGTH" ,.ORDIALOG ) S SOLCNT =$$VALCOUN T("SOLUTIO N",.ORDIAL OG) I IVTY PE'="I",AD DCNT'=STRC NT S RESUL T=1 I IVTY PE="I" D . I ADDCNT=0 ,SOLCNT>0 Q .I ADDCN T=0 S RESU LT=1 Q .I ADDCNT'=ST RCNT S RES ULT=1 Q Q RESULT ;IV ADFCHK(ORD IALOG) ; ; This line tag check s to see i f there ar e the same number of values ;f or ADDITIV E and Addi tive Frequ ency. This also chec ks to see if ;the va lue assign ed to ADDF REQ is one of the th ree possib le values ;All Bags, 1 bag/day , See Comm ents. If S ee Comment s it also checks ;fo r text in the commen t section. N ADDCNT, ADDFCNT,AD DFREQ,COMM ENT,FREQ,I NST,RESULT S ADDCNT= $$VALCOUNT ("ADDITIVE ",.ORDIALO G) S ADDFC NT=$$VALCO UNT("ADDIT IVE FREQUE NCY",.ORDI ALOG) I AD DCNT'=ADDF CNT Q 0 S ADDFREQ=$O (^ORD(101. 41,"AB","O R GTX ADDI TIVE FREQU ENCY","")) S COMMENT =$O(^ORD(1 01.41,"AB" ,"OR GTX W ORD PROCES SING 1","" )) I +$G(A DDFREQ)'>0 Q O S INS T=0,RESULT =1 F S IN ST=$O(ORDI ALOG(ADDFR EQ,INST)) Q:INST'>0! (RESULT=0) D .S FREQ =$$ADDFRQC V^ORMBLDP1 ($G(ORDIAL OG(ADDFREQ ,INST)),"O ") .I FREQ ="A"!(FREQ =1) Q .I F REQ="" S R ESULT=0 Q .I FREQ="S ",'$L($G(O RDIALOG(CO MMENT,1))) S RESULT= 0 Q Q RESU LT ;KEYVAR (DLG) ; Pa rse entry action for key varia bles & ret urn in str ing ; RV=C ollTp^Samp ^Spec^Coll Dt^Urg^Sch ed^NoComm^ NoDiag^NoP rov^NoRsn N XCODE,RV ,POS,Z S X CODE=$G(^O RD(101.41, DLG,3)),RV ="" I '$L( XCODE) Q " " S POS=$F (XCODE,"LR FZX=") I P OS S $P(RV ,U,1)=$$VA LUE(XCODE, POS) S POS =$F(XCODE, "LRFSAMP=" ) I POS S $P(RV,U,2) =$$VALUE(X CODE,POS) S POS=$F(X CODE,"LRFS PEC=") I P OS S $P(RV ,U,3)=$$VA LUE(XCODE, POS) S POS =$F(XCODE, "LRFDATE=" ) I POS S $P(RV,U,4) =$$VALUE(X CODE,POS) S POS=$F(X CODE,"LRFU RG=") I PO S S $P(RV, U,5)=$$VAL UE(XCODE,P OS) S POS= $F(XCODE," LRFSCH=") I POS S $P (RV,U,6)=$ $VALUE(XCO DE,POS) S POS=$F(XCO DE,"PSJNOP C=") I POS S $P(RV,U ,7)=$$VALU E(XCODE,PO S) S POS=$ F(XCODE,"G MRCNOPD=") I POS S $ P(RV,U,8)= $$VALUE(XC ODE,POS) S POS=$F(XC ODE,"GMRCN OAT=") I P OS S $P(RV ,U,9)=$$VA LUE(XCODE, POS) S POS =$F(XCODE, "GMRCREAF= ") I POS S $P(RV,U,1 0)=$$VALUE (XCODE,POS ) S POS=$F (XCODE,"OR FORGET=") I POS D . ; need to change thi s so that it is exec uted in SE TKEYV so . ; that it is execut ed each ti me menu is revisited . N ORFOR GET S ORFO RGET=$$VAL UE(XCODE,P OS) . I OR FORGET K ^ TMP("ORECA LL",$J,+OR FORGET) . E K ^TMP( "ORECALL", $J) Q RVVA LUE(STR,BE G) ; Retur n value of "var=" (c opied from ORCONVRT) N X,Y,I S X=$E(STR, BEG,999),Y ="" S:$E(X )="""" X=$ E(X,2,999) ; strip l eading " F I=1:1:$L( X) S Z=$E( X,I) Q:(Z= ",")!(Z=" ")!(Z="""" ) S Y=Y_Z Q $TR(Y,U, "") ;SETKE YV(X) ; Se t the key variables based on c ontents of X I $L($P (X,U,1)) S LRFZX=$P( X,U,1) I $ L($P(X,U,2 )) S LRFSA MP=$P(X,U, 2) I $L($P (X,U,3)) S LRFSPEC=$ P(X,U,3) I $L($P(X,U ,4)) S LRF DATE=$P(X, U,4) I $L( $P(X,U,5)) S LRFURG= $P(X,U,5) I $L($P(X, U,6)) S LR FSCH=$P(X, U,6) I $L( $P(X,U,7)) S PSJNOPC =$P(X,U,7) I $L($P(X ,U,8)) S G MRCNOPD=$P (X,U,8) I $L($P(X,U, 9)) S GMRC NOAT=$P(X, U,9) I $L( $P(X,U,10) ) S GMRCRE AF=$P(X,U, 10) QDLGIN FO(IEN,MOD E) ; retur n informat ion about a dialog ; IEN=DlgIE N or ORIFN , MODE=0:D lg,1:Copy, 2:Change ; RESULT=Dl gIEN^DlgTy pe^FormID^ DGrp ; If MODE="1;T" ,don't che ck "PS MED S" for tra nsfer orde r ; PSMDGP =1: Unit/D ose Group ; PSMDGP=2 : OutPatie nt Group N X0,DLGIEN ,TYP,FID,D GRP,PSMDGP ,ISXF S PS MDGP=0,ISX F="" S ISX F=$P(MODE, ";",2) S M ODE=+MODE S DLGIEN=I EN I MODE, (ISXF'="T" ) D . S DL GIEN=+$P($ G(^OR(100, +IEN,0)),U ,5) . I $P (^ORD(101. 41,DLGIEN, 0),U)="PS MEDS" D . . N PTCAT S PTCAT=$P ($G(^OR(10 0,+IEN,0)) ,U,12) . . I PTCAT=" I" S DLGIE N=$O(^ORD( 101.41,"B" ,"PSJ OR P AT OE",0)) ,PSMDGP=1 . . I PTCA T="O" S DL GIEN=$O(^O RD(101.41, "B","PSO O ERR",0)),P SMDGP=2 I MODE,(ISXF ="T") S DL GIEN=+$P($ G(^OR(100, +IEN,0)),U ,5) S X0=$ G(^ORD(101 .41,DLGIEN ,0)),TYP=$ P(X0,U,4), DGRP=$P(X0 ,U,5) I MO DE S DGRP= +$P($G(^OR (100,+IEN, 0)),U,11) ;JD NEW ST ART 11/13/ 02 I DLGIE N=$O(^ORD( 101.41,"B" ,"PSJ OR P AT OE",0)) S PSMDGP= 1 I DLGIEN =$O(^ORD(1 01.41,"B", "PSO OERR" ,0)) S PSM DGP=2 ;JD NEW END 11 /13/02 ; f or copy or change, i f the base dialog ha s changed, use it's info I MOD E,$G(ORDIA LOG),(+DLG IEN'=+ORDI ALOG),(PSM DGP=0) D . S DLGIEN= +ORDIALOG, DGRP=$P(^O RD(101.41, +ORDIALOG, 0),U,5) D FORMID^ORW DXM(.FID,D LGIEN) Q D LGIEN_U_TY P_U_FID_U_ DGRP ;CHKD SBL(LST,ID ,MODE) ; r eturn mess age if dia log disabl ed ; ID=Dl gIEN or OR IFN, MODE= 0:Dialog,1 :Copy,2:Ch ange ; LST =QL_REJECT + disable d message or unchang ed S DLGIE N=+ID I MO DE S DLGIE N=+$P($G(^ OR(100,+ID ,0)),U,5) S X0=$G(^O RD(101.41, DLGIEN,0)) ,X=$P(X0,U ,3) I '$L( X),($P(X0, U,4)="Q") D ; check default d ialog . S DLGIEN=+$$ DEFDLG^ORW DXQ($P(X0, U,5)) . S X=$P($G(^O RD(101.41, DLGIEN,0)) ,U,3) I $L (X) D . I MODE D GET TXT^ORWORR (.LST,ID) S LST(.6)= "",LST(.7) ="Cannot " _$S(MODE=1 :"Copy",1: "Change")_ " -" . S L ST(0)="8^0 ",LST(.5)= "Dialog Di sabled: "_ X QCHKVACT (LST,ID,MO DE,ORNP) ; return me ssage if a ction not valid ; ID =DlgIEN or ORIFN, MO DE=0:Dialo g,1:Copy,2 :Change ; LST=QL_REJ ECT + inva lid action message o r unchange d Q:'MODE ; not an action on an order N X,ACT S A CT=$S(MODE =1:"RW",MO DE=2:"XX", 1:"") D VA LID^ORWDXA (.X,ID,ACT ,ORNP) I $ L(X) D GET TXT^ORWORR (.LST,ID) D . S LST( 0)="8^0",L ST(.5)=X,L ST(.6)="", LST(.7)="C annot "_$S (MODE=1:"C opy",1:"Ch ange")_" - " QCHKCOPY (LST,ID,FL DS) ; retu rn message if can't copy this order ; ID =ORIFN;ACT FLDS=Even tType in 7 th piece ; LST=QL_RE JECT + can not copy m essage or unchanged I "^A^D^T^ "'[(U_$E($ P(FLDS,U,7 ))_U) Q ; not even t delayed N PKG S PK G=$P($G(^O R(100,+ID, 0)),U,14) S PKG=$$NM SP^ORCD(PK G) I PKG=" OR"!(PKG=" PS") Q ; xfer med s, generic s N ORWCAT S ORWCAT= $P($G(^OR( 100,+ID,0) ),U,12) I ORWCAT="I" ,("^A^T^"[ (U_$E($P(F LDS,U,7))_ U)) Q ; admit, xfe r inpt I O RWCAT="O", $E($P(FLDS ,U,7))="D" Q ; d ischarge o utpt D GET TXT^ORWORR (.LST,ID) I ORWCAT=" I" S LST(. 5)="inpati ent order to outpati ent -" I O RWCAT="O" S LST(.5)= "outpatien t order to inpatient -" S:$D(L ST(.5)) LS T(.5)="Can not copy t he followi ng "_LST(. 5) S LST(0 )="8^0",LS T(.7)="" Q BLD4CHG(LS T,ID,FLDS) ; build r esponses f or an edit ; ID=ORIF N;ACT FLDS =unused ri ght now ; LST(0)=Qlv l^RespID(X OrderID)^D lgIEN^DlgT ype^FormID ^DGrp N OI DX,OI,CNT S (OI,OIDX ,CNT)=0 S: $D(^OR(100 ,+ID,4.5," ID","ORDER ABLE")) OI DX=$O(^OR( 100,+ID,4. 5,"ID","OR DERABLE",0 )) I $D(^O R(100,+ID, 4.5,OIDX)) D . F S CNT=$O(^OR (100,+ID,4 .5,OIDX,CN T)) Q:'CNT D . . S OI=^(CNT) D VALDOI I +LST(0)=8 S LST(.5) ="You can not change this orde r." Q S LS T(0)="0^X" _ID_U_$$DL GINFO(+ID, 2) S $P(LS T(0),U,4)= "X" QGETIV TYP() ; N RESULT,TYP EIEN S RES ULT="" S T YPEIEN=$O( ^ORD(101.4 1,"B","OR GTX IV TYP E","")) I TYPEIEN'>0 Q RESULT S RESULT=$ G(ORDIALOG (TYPEIEN,1 )) Q RESUL T ;ISTUBEQ O(IFN) ; N DG,DIAL S DG=+$P($G (^ORD(101. 41,IFN,0)) ,U,5) S DI AL=$P($G(^ ORD(100.98 ,DG,0)),U, 4) I +$G(D IAL)=0 Q 0 I $P($G(^ ORD(101.41 ,DIAL,0)), U)="FHW8" Q 1 Q 0 ;V ALDOI ; Va lidate the Orderable Items N O RQUIT,ORPS I $G(^ORD (101.43,OI ,.1)),^(.1 )'>$$NOW^X LFDT D . S ORQUIT=1 . S LST(0) ="8^0" I $ D(ORQUIT) Q:ORQUIT S ORPS=$G(^ ORD(101.43 ,+OI,"PS") ) I $P(ORP S,U,1,4)=" 0^0^0^0",( $P(ORPS,U, 7)=0) S LS T(0)="8^0" QVERDUR(O RDIALOG) ; ;check fo r duration value if a THEN con junation i s used N C ONJ,CONVAL UE,DUR,I,S UCC S SUCC =1 S CONJ= $$PTR^ORCD PS1("AND/T HEN") S DU R=$$PTR^OR CDPS1("DUR ATION") S I=0 F S I =$O(ORDIAL OG(CONJ,I) ) Q:I'>0!( SUCC=0) D . I $$UP^X LFSTR($E($ G(ORDIALOG (CONJ,I)), 1))="T" D . . I '$L( $G(ORDIALO G(DUR,I))) S SUCC=0 Q SUCC ;VE RORD(OIEN) ; N IFN,I NFUSE,INFU ID,ODG,ODP ,ASSIV,SUC C,TYPE S S UCC=0,IFN= ORDIALOG S ODP=+$P($ G(^ORD(101 .41,+IFN,0 )),U,7),OD G=+$P($G(^ (0)),U,5) S ODP=$$GE T1^DIQ(9.4 ,+ODP_",", 1),ODG=$P( $G(^ORD(10 0.98,ODG,0 )),U,3) I ODP'["PS" Q 1 I ODP= "PSH" Q 1 ;check inf usion rate for IV QO I ODG="IV RX"!(ODG= "TPN") D Q SUCC .S TYPE=$$GET IVTYP .I T YPE="" Q . S PASSIV=$ $IVRTECHK .I PASSIV= 0 Q .S INF UID=$O(^OR D(101.41," B","OR GTX INFUSION RATE",0)) .S INFUSE= $G(ORDIALO G(INFUID,1 )) .S SUCC =$$VALINF( TYPE,INFUS E) .I SUCC =0 Q .I TY PE="C" S S UCC=$$IVAD FCHK(.ORDI ALOG) I (O DP="PSJ")! (ODP="PSO" ),ODG'="IV RX",ODG'= "TPN" S SU CC=$$VERDU R(.ORDIALO G) Q SUCC ;VALINF(TY PE,INFUSE) ; N SUCC S SUCC=0 I TYPE="I" D Q SUCC .I INFUSE= "" S SUCC= 1 Q .I $TR (INFUSE,"a bcdefghijk lmnopqrstu vwxyz","AB CDEFGHIJKL MNOPQRSTUV WXYZ")["IN FUSE OVER" S SUCC=1 Q .I $L(IN FUSE)>4 Q Q 1 ;VALQO (IFN) ;Che ck to see if it's a good QO me d ;If it's an IV QO: check if infusion r ate entere d ;If it's an UD QO: check if dosage ent ered ;regu lar order treated as good QO ; I IFN[";" ,($$UPCTCH K^ORWDXA(+ IFN)) Q 0 I $P($G(^O RD(101.41, IFN,0)),U, 4)'="Q" Q 1 N ODP,OD G,INFUID,I NFUSE,DSAG EID,SUCC,P ASSIV,TYPE S SUCC=0 S ODP=+$P( $G(^ORD(10 1.41,IFN,0 )),U,7),OD G=+$P($G(^ (0)),U,5) S ODP=$$GE T1^DIQ(9.4 ,+ODP_",", 1),ODG=$P( $G(^ORD(10 0.98,ODG,0 )),U,3) I ODP'["PS" Q 1 I ODP= "PSH" Q 1 ;check inf usion rate for IV QO I ODG="IV RX"!(ODG= "TPN") D . S INFUID= $O(^ORD(10 1.41,"B"," OR GTX INF USION RATE ",0)) . S TYPE=$$GET IVTYP . I TYPE="" Q . I $D(ORD IALOG(INFU ID,1)) D . . I TYPE= "I" D Q . . . S INF USE=$G(ORD IALOG(INFU ID,1)) . . . I INFUS E="" Q . . . I INFUS E["INFUSE OVER" S SU CC=1 Q . . . I $L(IN FUSE)>4 Q . . . I +I NFUSE>0 S INFUSE="IN FUSE OVER "_INFUSE_" Minutes" . . . S OR DIALOG(INF UID,1)=INF USE,SUCC=1 . . S SUC C=1 . ; ad ditive fre quency che ck/infusio n rate che cks for co ntinuous o rders . I TYPE="C" D I SUCC=0 Q . . I $ D(ORDIALOG (INFUID,1) ) S SUCC=1 I SUCC=0 Q . . S SU CC=$$IVADF CHK(.ORDIA LOG) . I S UCC=0 Q . I '$D(ORDI ALOG(INFUI D,1)),TYPE ="I" S SUC C=1 . S PA SSIV=$$IVR TECHK . I SUCC=0 Q . I PASSIV= 0 S SUCC=0 . I SUCC= 1,$$ISMISS FL(.ORDIAL OG,TYPE)=1 S SUCC=0 ;check dos age for UD QO I (ODP ="PSJ")!(O DP="PSO"), ODG'="IV R X",ODG'="T PN" D . S DSAGEID=$O (^ORD(101. 41,"B","OR GTX INSTR UCTIONS",0 )) . I $D( ORDIALOG(D SAGEID,1)) S SUCC=1 . I SUCC=0 Q . ; . S SUCC=$$VE RDUR(.ORDI ALOG) ; I SUCC=1,$P( $G(^ORD(10 1.41,IFN,5 )),U,8) D .N COMMID, WPCNT .S C OMMID=$O(^ ORD(101.41 ,"B","OR G TX WORD PR OCESSING 1 ",0)) .S C OMMID=$O(^ ORD(101.41 ,IFN,6,"D" ,COMMID,0) ) .I COMMI D S WPCNT= 0 F S WPC NT=$O(^ORD (101.41,IF N,6,COMMID ,2,WPCNT)) Q:'WPCNT! ('SUCC) D ..I ^ORD(1 01.41,IFN, 6,COMMID,2 ,WPCNT,0)[ "^" S SUCC =0 Q SUCC ;IVRTECHK( ) ; N RTIE N,RTVALUE, RESULT N C NT,NUM,ORD ERIDS,OIIE N,OTYPE,RO UTE S CNT= 0,RESULT=0 S RTIEN=+ $P($G(ORDI ALOG("B"," ROUTE")),U ,2) I RTIE N'>0 Q RES ULT S RTVA LUE=+$G(OR DIALOG(RTI EN,1)) I R TVALUE'>0 Q RESULT F OTYPE="SO LUTION","A DDITIVE" D .S OIIEN= +$P($G(ORD IALOG("B", OTYPE)),U, 2) I OIIEN >0 D ..S N UM=0 F S NUM=$O(ORD IALOG(OIIE N,NUM)) Q: NUM'>0 I + $G(ORDIALO G(OIIEN,NU M))>0 D .. .S CNT=CNT +1,ORDERID S(CNT)=ORD IALOG(OIIE N,NUM) I $ D(ORDERIDS )=0 Q S RO UTE=$$IVQO VAL^ORWDPS 33(.ORDERI DS,RTVALUE ) I ROUTE= "" S ORDIA LOG(RTIEN, 1)=ROUTE I ROUTE'="" S RESULT= 1 ;K ^TMP( $J,"ORWDXM 3 IVRTECHK ") ;D ALL^ PSS51P2(RT VALUE,,,," ORWDXM3 IV RTECHK") ; I +^TMP($J ,"ORWDXM3 IVRTECHK", RTVALUE,6) '=1 S ORDI ALOG(RTIEN ,1)="",RES ULT=0 ;K ^ TMP($J,"OR WDXM3 IVRT ECHK") Q R ESULT ;ISU DQO(ORY,DL GID) ;True : is unit dose quick order S O RY=0 Q:'$D (^ORD(101. 41,DLGID,0 )) N CLODG RP,CLIVDGR P,UDGRP1,U DGRP2,DLGT YP,DLGGRP S UDGRP1=$ O(^ORD(100 .98,"B","U D RX",0)) S UDGRP2=$ O(^ORD(100 .98,"B","I RX",0)) S CLODGRP=$ O(^ORD(100 .98,"B","C LINIC MEDI CATIONS"," ")) S CLIV DGRP=$O(^O RD(100.98, "B","CLINI C INFUSION S","")) S DLGTYP=$P( $G(^ORD(10 1.41,DLGID ,0)),U,4) I DLGTYP=" Q" S ^TMP( "ZZ QUICK ORDER AUDI T",$J,"DLG ID")=DLGID S DLGGRP= $P($G(^ORD (101.41,DL GID,0)),U, 5) I (DLGT YP="Q"),(( DLGGRP=UDG RP1)!(DLGG RP=UDGRP2) !(DLGGRP=C LODGRP)!(D LGGRP=CLIV DGRP)) S O RY=1 Q | |
| 291 | ORWPT | |
| 292 | Before: | |
| 293 | ORWPT ; SL C/KCM/REV - Patient Lookup Fun ctions ; 6 /2/14 2:16 pm ;;3.0;O RDER ENTRY /RESULTS R EPORTING;* *10,85,132 ,149,206,1 87,190,215 ,243,280,3 06,311,431 ,441**;Dec 17, 1997; Build 30 ; ; Ref. to ^UTILITY via IA 100 61 ;IDINFO (REC,DFN) ; Return i dentifying informati on for a p atient ; P ID^DOB^SEX ^VET^SC%^W ARD^RM-BED ^NAME N X0 ,X1,X101,X 3,XV ; nam e/dob/sex/ ssn, ward, room-bed, sc%, vet S X0=$G(^D PT(DFN,0)) ,X1=$G(^(. 1)),X101=$ G(^(.101)) ,X3=$G(^(. 3)),XV=$G( ^("VET")) S REC=$$SS N^DPTLK1(D FN)_U_$$DO B^DPTLK1(D FN,2)_U_$P (X0,U,2)_U _$P(XV,U)_ U_$P(X3,U, 2)_U_$P(X1 ,U)_U_$P(X 101,U)_U_$ P(X0,U) ;D G249 QPTIN Q(REF,DFN) ; Return formatted pt inquiry report K ^TMP("ORDA TA",$J,1) D DGINQ^OR CXPND1(DFN ) S REF=$N A(^TMP("OR DATA",$J,1 )) QSCDIS( LST,DFN) ; Return se rvice conn ected % an d rated di sabilities N VAEL,VA ERR,I,ILST ,DIS,SC,X D ELIG^VAD PT S LST(1 )="Service Connected : "_$S(+VA EL(3):$P(V AEL(3),U,2 )_"%",1:"N O") I 'VAE L(4),'$P($ G(^DG(391, +VAEL(6),0 )),U,2) S LST(2)="NO T A VETERA N." Q S I= 0,ILST=1 F S I=$O(^ DPT(DFN,.3 72,I)) Q:' I S X=^(I ,0) D . S DIS=$P($G( ^DIC(31,+X ,0)),U) Q: DIS="" . S SC=$S($P( X,U,3):"SC ",$P(X,U,3 )']"":"not specified ",1:"NSC") . S ILST= ILST+1,LST (ILST)=DIS _" ("_$P(X ,U,2)_"% " _SC_")" I ILST=1 S L ST(2)="Rat ed Disabil ities: NON E STATED" QSHOW ; te mporary - show patie nt inquiry screen N I,Y,DIC S DIC=2,DIC( 0)="AEMQ" D ^DIC Q:' Y K ^TMP(" ORDATA",$J ,1) D DGIN Q^ORCXPND1 (+Y) S I=0 F S I=$O (^TMP("ORD ATA",$J,1, I)) Q:'I W !,^(I) K ^TMP("ORD ATA",$J,1) QSELCHK(R EC,DFN) ; Check for sensitive pt ; SENSI TIVE S REC =$$EN1^ORQ PT2(DFN) Q DIEDON(VAL ,DFN) ; Ch eck for a date of de ath S VAL= +$G(^DPT(D FN,.35)) Q SELECT(REC ,DFN) ; Se lects pati ent & retu rns key in formation ; 1 2 3 4 5 6 7 8 9 10 11 12 ; NAME^SEX^ DOB^SSN^LO CIEN^LOCNM ^RMBD^CWAD ^SENSITIVE ^ADMITTED^ CONV^SC^ ; 13 14 15 16 17 ; SC %^ICN^AGE^ TS^TSSVC ; ; for CCO W (RV - 2/ 27/03) nam e="-1", lo cation=err or message I '$D(^DP T(+DFN,0)) S REC="-1 ^^^^^Patie nt is unkn own to CPR S." Q ; N X I $G(XWB ("2","RPC" ))="ORWPT SELECT" K ^TMP($J,"O C-OPOS") ; delete on ce per ord er session order che cks K ^TMP ("ORWPCE", $J) ; dele te PCE 'ca che' when switching patients S X=^DPT(DF N,0),REC=$ P(X,U,1,3) _U_$P(X,U, 9)_U_U_$G( ^(.1))_U_$ G(^(.101)) S X=$P(RE C,U,6) I $ L(X) S $P( REC,U,5)=+ $G(^DIC(42 ,+$O(^DIC( 42,"B",X,0 )),44)) S $P(REC,U,8 )=$$CWAD^O RQPT2(DFN) _U_$$EN1^O RQPT2(DFN) ; I $P(RE C,U,9) D E N2^ORQPT2( DFN) ;upda te DG secu rity log ; DG249 S X =$G(^DPT(D FN,.105)) I X S $P(R EC,U,10)=$ P($G(^DGPM (X,0)),U) S:'$D(IOST ) IOST="P- OTHER" S $ P(REC,U,11 )=0 D ELIG ^VADPT S $ P(REC,U,12 )=$G(VAEL( 3)) ;two p ieces: SC^ SC% I $L($ T(GETICN^M PIF001)) S X=+$$GETI CN^MPIF001 (DFN) S:X> 0 $P(REC,U ,14)=X S $ P(REC,U,15 )=$$AGE(DF N,$P(REC,U ,3)) S $P( REC,U,16)= +$G(^DPT(D FN,.103)) ; treating specialty I +$P(REC ,U,16)>0 D . N X,Y,Z . S (X,Y) ="" . S X= $$TSDATA^D GACT(45.7, +$P(REC,U, 16),.Y,"") . I +X,+$ P($G(Y(2)) ,U,1)>0 S (X,Z)="" S X=$$TSDAT A^DGACT(42 .4,+$P($G( Y(2)),U,1) ,.Z,"") . I +X S $P( REC,U,17)= $P($G(Z(3) ),U,1) ; t reating sp ecialty se rvice K VA EL,VAERR ; VADPT call to kill? S ^DISV(DU Z,"^DPT(") =DFN QSHAR E(VAL,IP,H WND,DFN) ; Set globa l to share DFN with other appl ications K ^TMP("ORW CHART",$J) ,^TMP("ORE CALL",$J), ^TMP("ORWO RD",$J) K ^TMP("ORWD XMQ",$J) S ^TMP("ORW CHART",$J, IP,HWND)=D FN QBYWARD (LST,WARD) ; Return a list of patients i n a ward N ILST,DFN I +$G(WARD )<1 S LST( 1)="^No wa rd identif ied" Q S ( ILST,DFN)= 0 S WARD=$ P(^DIC(42, WARD,0),"^ ") ;DBIA # 36 F S DF N=$O(^DPT( "CN",WARD, DFN)) Q:DF N'>0 D . S ILST=ILST +1,LST(ILS T)=+DFN_U_ $P(^DPT(+D FN,0),U)_U _$G(^DPT(+ DFN,.101)) I ILST<1 S LST(1)=" ^No patien ts found." QLAST5(LS T,ID) ; Re turn a lis t of patie nts matchi ng A9999 i dentifiers N I,IEN,X REF S (I,I EN)=0,XREF =$S($L(ID) =5:"BS5",1 :"BS") F S IEN=$O(^ DPT(XREF,I D,IEN)) Q: 'IEN D . S I=I+1,LS T(I)=IEN_U _$P(^DPT(I EN,0),U)_U _$$DOB^DPT LK1(IEN,2) _U_$$SSN^D PTLK1(IEN) ; DG249 Q ;LAST5RPL (LST,ID) ; ; Return list match ing A9999 id's, but from RPL o nly. N ORR PL,ORCNT,O RPT,ORPIEN ; IA ____ allows re ad access to NEW PER SON file n ode 101: S ORRPL=$G( ^VA(200,DU Z,101)) S ORRPL=$P(O RRPL,U,2) I (('ORRPL )!(ORRPL=" ")) S LST( 0)="" Q ; S (ORCNT,O RPT)=0 F S ORPT=$O( ^OR(100.21 ,ORRPL,10, ORPT)) Q:' ORPT D .S ORPIEN=+$ G(^OR(100. 21,ORRPL,1 0,ORPT,0)) .I ((ORPI EN<0)!(ORP IEN="")) Q .S ORCNT= ORCNT+1 .S LST(ORCNT )=ORPIEN_U _$P(^DPT(O RPIEN,0),U )_U_$$DOB^ DPTLK1(ORP IEN,2)_U_$ $SSN^DPTLK 1(ORPIEN) ; DG249. ; Q ;FULLSS N(LST,ID) ; Return a list of p atients ma tching ful l SSN ente red N I,IE N S (I,IEN )=0 F S I EN=$O(^DPT ("SSN",ID, IEN)) Q:'I EN D . S I=I+1,LST( I)=IEN_U_$ P(^DPT(IEN ,0),U)_U_$ $DOB^DPTLK 1(IEN,2)_U _$$SSN^DPT LK1(IEN) ; DG249 Q ; FSSNRPL(LS T,ID) ; Re turn list matching F ull SSN, b ut from RP L only. N ORRPL,ORCN T,ORPT,ORL PT,ORPIEN ; IA ____ allows rea d access t o NEW PERS ON file no de 101: S ORRPL=$G(^ VA(200,DUZ ,101)) S O RRPL=$P(OR RPL,U,2) I (('ORRPL) !(ORRPL="" )) S LST(0 )="" Q ; S (ORCNT,OR PT)=0 F S ORPT=$O(^ DPT("SSN", ID,ORPT)) Q:'ORPT D .S ORLPT= 0 .F S OR LPT=$O(^OR (100.21,OR RPL,10,ORL PT)) Q:'OR LPT D ..S ORPIEN=+$ G(^OR(100. 21,ORRPL,1 0,ORLPT,0) ) ..I ((OR PIEN<0)!(O RPIEN="")) Q ..I (OR PIEN'=ORPT ) Q ..S OR CNT=ORCNT+ 1 ..S LST( ORCNT)=ORP IEN_U_$P(^ DPT(ORPIEN ,0),U)_U_$ $DOB^DPTLK 1(ORPIEN,2 )_U_$$SSN^ DPTLK1(ORP IEN) ; DG2 49. ; Q ;T OP(LST) ; Return top for all p atients li st (last s elected fo r now) N I EN S IEN=$ G(^DISV(DU Z,"^DPT(") ) I IEN S LST(1)=IEN _U_$P($G(^ DPT(IEN,0) ),U) QENCT ITL(REC,DF N,LOC,PROV ) ; Return external values for encounter ; LOCNAME ^LOCABBR^R OOMBED^PRO VNAME S $P (REC,U,1)= $P($G(^SC( +LOC,0)),U ,1,2) S $P (REC,U,3)= $P($G(^DPT (DFN,.101) ),U) S $P( REC,U,4)=$ P($G(^VA(2 00,+PROV,0 )),U) S ^T MP("ZZ QUI CK ORDER A UDIT",$J," REC")=REC ; MPLS OR* L102 8/1/0 6 QLISTALL (Y,FROM,DI R) ; Retur n a bolus of patient names. Fr om is eith er Name or IEN^Name. N I,IEN,C NT,FROMIEN ,ORIDNAME S CNT=44,I =0,FROMIEN =0 I $P(FR OM,U,2)'=" " S FROMIE N=$P(FROM, U,1),FROM= $O(^DPT("B ",$P(FROM, U,2)),-DIR ) F S FRO M=$O(^DPT( "B",FROM), DIR) Q:FRO M="" D Q :I=CNT . S IEN=FROMI EN,FROMIEN =0 F S IE N=$O(^DPT( "B",FROM,I EN)) Q:'IE N D Q:I= CNT . . S ORIDNAME=" " . . S OR IDNAME=$G( ^DPT(IEN,0 )) ; Get z ero node n ame. . . ; S X1=$G(^ DPT(IEN,.1 ))_" "_$G( ^DPT(IEN,. 101)) . . S I=I+1 S Y(I)=IEN_U _FROM_U_U_ U_U_$P(ORI DNAME,U) ; _"^"_X ; _ "^"_X1 ;" ("_X_")" Q APPTLST(LS T,DFN) ; r eturn a li st of appo intments ; APPTTIME^ LOCIEN^LOC NAME^EXTST ATUS N ERR ,ERRMSG,VA SD,VAERR K ^UTILITY( "VASD",$J) ;IA 10061 S VASD("F ")=$$HTFM^ XLFDT($H-3 0,1) S VAS D("T")=$$H TFM^XLFDT( $H+1,1)_". 2359" S VA SD("W")="1 23456789" D SDA^ORQR Y01(.ERR,. ERRMSG) I ERR K ^UTI LITY("VASD ",$J) K LS T S LST(1) =ERRMSG Q S I=0 F S I=$O(^UTI LITY("VASD ",$J,I)) Q :'I D . S LST(I)=$P (^UTILITY( "VASD",$J, I,"I"),U,1 ,2)_U_$P(^ ("E"),U,2, 3) K ^UTIL ITY("VASD" ,$J) QADMI TLST(LST,D FN) ; retu rn a list of admissi ons ; MOVE TIME^LOCIE N^LOCNAME^ TYPE N TIM ,MOV,X0,Y, MTIM,XTYP, XLOC,HLOC, ILST S ILS T=0 S TIM= "" F S TI M=$O(^DGPM ("ATID1",D FN,TIM)) Q :TIM'>0 D . S MOV=0 F S MOV=$ O(^DGPM("A TID1",DFN, TIM,MOV)) Q:MOV'>0 D . . N VST R,TIUDA . . S X0=$G( ^DGPM(MOV, 0)) I X0'] "" Q . . S MTIM=$P(X 0,U) . . S XTYP=$P($ G(^DG(405. 1,+$P(X0,U ,4),0)),U, 1) . . S X LOC=$P($G( ^DIC(42,+$ P(X0,U,6), 0)),U,1),H LOC=+$G(^( 44)) . . S VSTR=HLOC _";"_MTIM_ ";H",TIUDA =$$HASDS^T IULX(DFN,V STR) . . S ILST=ILST +1,LST(ILS T)=MTIM_U_ HLOC_U_XLO C_U_XTYP_U _MOV_U_TIU DA QCLINRN G(LST) ; r eturn date ranges fo r clinic a ppointment s S LST(1) ="T;T^Toda y" S LST(2 )="T+1;T+1 ^Tomorrow" S LST(3)= "T-1;T-1^Y esterday" S LST(4)=" T-7;T^Past Week" S L ST(5)="T-3 1;T^Past M onth" S LS T(6)="S^Sp ecify Date Range..." Q ; N %,% H,X,SUNDAY ,START S L ST(1)=DT_" ;"_DT_"^To day",X=$$H TFM^XLFDT( $H+1,1) S LST(2)=X_" ;"_X_"^Tom orrow" S X =+$H F Q: X#7=3 S X= X-1 ; $H#7 =3 is Sund ay S LST(3 )=$$HTFM^X LFDT(X)_"; "_$$HTFM^X LFDT(X+6)_ "^This Wee k" S LST(4 )=$$HTFM^X LFDT(X+7)_ ";"_$$HTFM ^XLFDT(X+1 3)_"^Next Week" S LS T(5)=$E(DT ,1,5)_"01; "_$E(DT,1, 5)_"31^Thi s Month" S X=$E(DT,4 ,5)+1 S:X= 13 X=1 S X =$E(DT,1,3 )_$TR($J(X ,2)," ",0) S LST(6)= X_"01;"_X_ "31^Next M onth" S LS T(7)="^Spe cify Dates " QDFLTSRC (VAL) ; re turn defau lt patient list sour ce (T, W, C, P, S) N SRV S SRV =+$G(^VA(2 00,DUZ,5)) S VAL=$$G ET^XPAR("A LL^SRV.`"_ SRV,"ORLP DEFAULT LI ST SOURCE" ) QSAVDFLT (OK,X) ; s ave new de fault pati ent list s ettings (X =type^ien^ sdt;edt) G SAVDFLT^O RWPT1 ;DIS CHRG(Y,DFN ,ADMITDT) ; Get disc harge move ment infor mation N V AIP I +$G( ADMITDT)=0 S Y=DT Q S VAIP("D" )=ADMITDT D 52^VADPT I +VAIP(1 7)=0 S Y=D T Q S Y=+V AIP(17,1) QCWAD(Y,DF N) ; retur ns CWAD fl ags for a patient S Y=$$CWAD^O RQPT2(DFN) QLEGACY(O RLST,DFN) ; return m essage if data on th e legacy s ystem ; OR LST(0)=1 i f data, OR LST(n)=dis play messa ge if data S ORLST(0 )=0 I $L($ T(HXDATA^A 7RDPAGU)) D | |
| 294 | . D HXDAT A^A7RDPAGU (.ORLST,DF N) | |
| 295 | . I $O(OR LST(0)) S ORLST(0)=1 QINPLOC(R EC,DFN) ; Return a p atient's c urrent loc ation N X S X=$G(^DP T(DFN,.102 )),REC=0 I X S X=$P( $G(^DGPM(X ,0)),U,6) I X S REC= +$G(^DIC(4 2,X,44)) I X S $P(RE C,U,2)=$P( $G(^DIC(42 ,X,0)),U,1 ) I X S X= $P($G(^DIC (42,X,0)), U,3) S $P( REC,U,3)=X QAGE(DFN, BEG) ; ret urns age b ased on da te of birt h and date of death (or DT) N END,X S EN D=+$G(^DPT (DFN,.35)) ,END=$S(EN D:END,1:DT ) S X=$E(E ND,1,3)-$E (BEG,1,3)- ($E(END,4, 7)<$E(BEG, 4,7)) Q XR OK(X) ; Ro utine OK ( in UCI) (N DBI) S X=$ G(X) Q:'$L (X) 0 Q:$L (X)>8 0 X ^%ZOSF("TE ST") Q:$T 1 Q 0 ;- ; NDBI(X) ; National D atabase In tegration site 1 = y es 0 = no ; N R,G S X="A7RDUP" X ^%ZOSF( "TEST") S R=$T,G=$S( $D(^A7RCP) :1,1:0),X= R+G,X=$S(X =2:1,1:0) Q X | |
| 296 | After: | |
| 297 | ORWPT ; SL C/KCM/REV - Patient Lookup Fun ctions ; 6 /2/14 2:16 pm ;;3.0;O RDER ENTRY /RESULTS R EPORTING;* *10,85,132 ,149,206,1 87,190,215 ,243,280,3 06,311,L10 2**;Dec 17 , 1997;Bui ld 30 ; ; Ref. to ^U TILITY via IA 10061 ;IDINFO(RE C,DFN) ; R eturn iden tifying in formation for a pati ent ; PID^ DOB^SEX^VE T^SC%^WARD ^RM-BED^NA ME N X0,X1 ,X101,X3,X V ; name/d ob/sex/ssn , ward, ro om-bed, sc %, vet S X 0=$G(^DPT( DFN,0)),X1 =$G(^(.1)) ,X101=$G(^ (.101)),X3 =$G(^(.3)) ,XV=$G(^(" VET")) S R EC=$$SSN^D PTLK1(DFN) _U_$$DOB^D PTLK1(DFN, 2)_U_$P(X0 ,U,2)_U_$P (XV,U)_U_$ P(X3,U,2)_ U_$P(X1,U) _U_$P(X101 ,U)_U_$P(X 0,U) ;DG24 9 QPTINQ(R EF,DFN) ; Return for matted pt inquiry re port K ^TM P("ORDATA" ,$J,1) D D GINQ^ORCXP ND1(DFN) S REF=$NA(^ TMP("ORDAT A",$J,1)) QSCDIS(LST ,DFN) ; Re turn servi ce connect ed % and r ated disab ilities N VAEL,VAERR ,I,ILST,DI S,SC,X D E LIG^VADPT S LST(1)=" Service Co nnected: " _$S(+VAEL( 3):$P(VAEL (3),U,2)_" %",1:"NO") I 'VAEL(4 ),'$P($G(^ DG(391,+VA EL(6),0)), U,2) S LST (2)="NOT A VETERAN." Q S I=0,I LST=1 F S I=$O(^DPT (DFN,.372, I)) Q:'I S X=^(I,0) D . S DIS =$P($G(^DI C(31,+X,0) ),U) Q:DIS ="" . S SC =$S($P(X,U ,3):"SC",$ P(X,U,3)'] "":"not sp ecified",1 :"NSC") . S ILST=ILS T+1,LST(IL ST)=DIS_" ("_$P(X,U, 2)_"% "_SC _")" I ILS T=1 S LST( 2)="Rated Disabiliti es: NONE S TATED" QSH OW ; tempo rary - sho w patient inquiry sc reen N I,Y ,DIC S DIC =2,DIC(0)= "AEMQ" D ^ DIC Q:'Y K ^TMP("ORD ATA",$J,1) D DGINQ^O RCXPND1(+Y ) S I=0 F S I=$O(^T MP("ORDATA ",$J,1,I)) Q:'I W ! ,^(I) K ^T MP("ORDATA ",$J,1) QS ELCHK(REC, DFN) ; Che ck for sen sitive pt ; SENSITIV E S REC=$$ EN1^ORQPT2 (DFN) QDIE DON(VAL,DF N) ; Check for a dat e of death S VAL=+$G (^DPT(DFN, .35)) QSEL ECT(REC,DF N) ; Selec ts patient & returns key infor mation ; 1 2 3 4 5 6 7 8 9 10 11 12 ; NA ME^SEX^DOB ^SSN^LOCIE N^LOCNM^RM BD^CWAD^SE NSITIVE^AD MITTED^CON V^SC^ ; 13 14 15 16 17 ; SC%^I CN^AGE^TS^ TSSVC ; ; for CCOW ( RV - 2/27/ 03) name=" -1", locat ion=error message I '$D(^DPT(+ DFN,0)) S REC="-1^^^ ^^Patient is unknown to CPRS." Q ; N X I $G(XWB("2 ","RPC"))= "ORWPT SEL ECT" K ^TM P($J,"OC-O POS") ; de lete once per order session or der checks K ^TMP("O RWPCE",$J) ; delete PCE 'cache ' when swi tching pat ients S X= ^DPT(DFN,0 ),REC=$P(X ,U,1,3)_U_ $P(X,U,9)_ U_U_$G(^(. 1))_U_$G(^ (.101)) S X=$P(REC,U ,6) I $L(X ) S $P(REC ,U,5)=+$G( ^DIC(42,+$ O(^DIC(42, "B",X,0)), 44)) S $P( REC,U,8)=$ $CWAD^ORQP T2(DFN)_U_ $$EN1^ORQP T2(DFN) ; I $P(REC,U ,9) D EN2^ ORQPT2(DFN ) ;update DG securit y log ; DG 249 S X=$G (^DPT(DFN, .105)) I X S $P(REC, U,10)=$P($ G(^DGPM(X, 0)),U) S:' $D(IOST) I OST="P-OTH ER" S $P(R EC,U,11)=0 D ELIG^VA DPT S $P(R EC,U,12)=$ G(VAEL(3)) ;two piec es: SC^SC% I $L($T(G ETICN^MPIF 001)) S X= +$$GETICN^ MPIF001(DF N) S:X>0 $ P(REC,U,14 )=X S $P(R EC,U,15)=$ $AGE(DFN,$ P(REC,U,3) ) S $P(REC ,U,16)=+$G (^DPT(DFN, .103)) ; t reating sp ecialty I +$P(REC,U, 16)>0 D . N X,Y,Z . S (X,Y)="" . S X=$$T SDATA^DGAC T(45.7,+$P (REC,U,16) ,.Y,"") . I +X,+$P($ G(Y(2)),U, 1)>0 S (X, Z)="" S X= $$TSDATA^D GACT(42.4, +$P($G(Y(2 )),U,1),.Z ,"") . I + X S $P(REC ,U,17)=$P( $G(Z(3)),U ,1) ; trea ting speci alty servi ce K VAEL, VAERR ;VAD PT call to kill? S ^ DISV(DUZ," ^DPT(")=DF N QSHARE(V AL,IP,HWND ,DFN) ; Se t global t o share DF N with oth er applica tions K ^T MP("ORWCHA RT",$J),^T MP("ORECAL L",$J),^TM P("ORWORD" ,$J) K ^TM P("ORWDXMQ ",$J) S ^T MP("ORWCHA RT",$J,IP, HWND)=DFN QBYWARD(LS T,WARD) ; Return a l ist of pat ients in a ward N IL ST,DFN I + $G(WARD)<1 S LST(1)= "^No ward identified " Q S (ILS T,DFN)=0 S WARD=$P(^ DIC(42,WAR D,0),"^") ;DBIA #36 F S DFN=$ O(^DPT("CN ",WARD,DFN )) Q:DFN'> 0 D . S IL ST=ILST+1, LST(ILST)= +DFN_U_$P( ^DPT(+DFN, 0),U)_U_$G (^DPT(+DFN ,.101)) I ILST<1 S L ST(1)="^No patients found." QL AST5(LST,I D) ; Retur n a list o f patients matching A9999 iden tifiers N I,IEN,XREF S (I,IEN) =0,XREF=$S ($L(ID)=5: "BS5",1:"B S") F S I EN=$O(^DPT (XREF,ID,I EN)) Q:'IE N D . S I =I+1,LST(I )=IEN_U_$P (^DPT(IEN, 0),U)_U_$$ DOB^DPTLK1 (IEN,2)_U_ $$SSN^DPTL K1(IEN) ; DG249 Q ;L AST5RPL(LS T,ID) ; ; Return lis t matching A9999 id' s, but fro m RPL only . N ORRPL, ORCNT,ORPT ,ORPIEN ; IA ____ al lows read access to NEW PERSON file node 101: S OR RPL=$G(^VA (200,DUZ,1 01)) S ORR PL=$P(ORRP L,U,2) I ( ('ORRPL)!( ORRPL="")) S LST(0)= "" Q ; S ( ORCNT,ORPT )=0 F S O RPT=$O(^OR (100.21,OR RPL,10,ORP T)) Q:'ORP T D .S OR PIEN=+$G(^ OR(100.21, ORRPL,10,O RPT,0)) .I ((ORPIEN< 0)!(ORPIEN ="")) Q .S ORCNT=ORC NT+1 .S LS T(ORCNT)=O RPIEN_U_$P (^DPT(ORPI EN,0),U)_U _$$DOB^DPT LK1(ORPIEN ,2)_U_$$SS N^DPTLK1(O RPIEN) ; D G249. ; Q ;FULLSSN(L ST,ID) ; R eturn a li st of pati ents match ing full S SN entered N I,IEN S (I,IEN)=0 F S IEN= $O(^DPT("S SN",ID,IEN )) Q:'IEN D . S I=I +1,LST(I)= IEN_U_$P(^ DPT(IEN,0) ,U)_U_$$DO B^DPTLK1(I EN,2)_U_$$ SSN^DPTLK1 (IEN) ; DG 249 Q ;FSS NRPL(LST,I D) ; Retur n list mat ching Full SSN, but from RPL o nly. N ORR PL,ORCNT,O RPT,ORLPT, ORPIEN ; I A ____ all ows read a ccess to N EW PERSON file node 101: S ORR PL=$G(^VA( 200,DUZ,10 1)) S ORRP L=$P(ORRPL ,U,2) I (( 'ORRPL)!(O RRPL="")) S LST(0)=" " Q ; S (O RCNT,ORPT) =0 F S OR PT=$O(^DPT ("SSN",ID, ORPT)) Q:' ORPT D .S ORLPT=0 . F S ORLPT =$O(^OR(10 0.21,ORRPL ,10,ORLPT) ) Q:'ORLPT D ..S OR PIEN=+$G(^ OR(100.21, ORRPL,10,O RLPT,0)) . .I ((ORPIE N<0)!(ORPI EN="")) Q ..I (ORPIE N'=ORPT) Q ..S ORCNT =ORCNT+1 . .S LST(ORC NT)=ORPIEN _U_$P(^DPT (ORPIEN,0) ,U)_U_$$DO B^DPTLK1(O RPIEN,2)_U _$$SSN^DPT LK1(ORPIEN ) ; DG249. ; Q ;TOP( LST) ; Ret urn top fo r all pati ents list (last sele cted for n ow) N IEN S IEN=$G(^ DISV(DUZ," ^DPT(")) I IEN S LST (1)=IEN_U_ $P($G(^DPT (IEN,0)),U ) QENCTITL (REC,DFN,L OC,PROV) ; Return ex ternal val ues for en counter ; LOCNAME^LO CABBR^ROOM BED^PROVNA ME S $P(RE C,U,1)=$P( $G(^SC(+LO C,0)),U,1, 2) S $P(RE C,U,3)=$P( $G(^DPT(DF N,.101)),U ) S $P(REC ,U,4)=$P($ G(^VA(200, +PROV,0)), U) S ^TMP( "ZZ QUICK ORDER AUDI T",$J,"REC ")=REC ; M PLS OR*L10 2 8/1/06 Q LISTALL(Y, FROM,DIR) ; Return a bolus of patient na mes. From is either Name or IE N^Name. N I,IEN,CNT, FROMIEN,OR IDNAME S C NT=44,I=0, FROMIEN=0 I $P(FROM, U,2)'="" S FROMIEN=$ P(FROM,U,1 ),FROM=$O( ^DPT("B",$ P(FROM,U,2 )),-DIR) F S FROM=$ O(^DPT("B" ,FROM),DIR ) Q:FROM=" " D Q:I= CNT . S IE N=FROMIEN, FROMIEN=0 F S IEN=$ O(^DPT("B" ,FROM,IEN) ) Q:'IEN D Q:I=CNT . . S ORI DNAME="" . . S ORIDN AME=$G(^DP T(IEN,0)) ; Get zero node name . . . ; S X1=$G(^DPT (IEN,.1))_ " "_$G(^DP T(IEN,.101 )) . . S I =I+1 S Y(I )=IEN_U_FR OM_U_U_U_U _$P(ORIDNA ME,U) ;_"^ "_X ; _"^" _X1 ;" ("_ X_")" QAPP TLST(LST,D FN) ; retu rn a list of appoint ments ; AP PTTIME^LOC IEN^LOCNAM E^EXTSTATU S N ERR,ER RMSG,VASD, VAERR K ^U TILITY("VA SD",$J) ;I A 10061 S VASD("F")= $$HTFM^XLF DT($H-30,1 ) S VASD(" T")=$$HTFM ^XLFDT($H+ 1,1)_".235 9" S VASD( "W")="1234 56789" D S DA^ORQRY01 (.ERR,.ERR MSG) I ERR K ^UTILIT Y("VASD",$ J) K LST S LST(1)=ER RMSG Q S I =0 F S I= $O(^UTILIT Y("VASD",$ J,I)) Q:'I D . S LS T(I)=$P(^U TILITY("VA SD",$J,I," I"),U,1,2) _U_$P(^("E "),U,2,3) K ^UTILITY ("VASD",$J ) QADMITLS T(LST,DFN) ; return a list of admissions ; MOVETIM E^LOCIEN^L OCNAME^TYP E N TIM,MO V,X0,Y,MTI M,XTYP,XLO C,HLOC,ILS T S ILST=0 S TIM="" F S TIM=$ O(^DGPM("A TID1",DFN, TIM)) Q:TI M'>0 D . S MOV=0 F S MOV=$O(^ DGPM("ATID 1",DFN,TIM ,MOV)) Q:M OV'>0 D . . N VSTR,T IUDA . . S X0=$G(^DG PM(MOV,0)) I X0']"" Q . . S MT IM=$P(X0,U ) . . S XT YP=$P($G(^ DG(405.1,+ $P(X0,U,4) ,0)),U,1) . . S XLOC =$P($G(^DI C(42,+$P(X 0,U,6),0)) ,U,1),HLOC =+$G(^(44) ) . . S VS TR=HLOC_"; "_MTIM_";H ",TIUDA=$$ HASDS^TIUL X(DFN,VSTR ) . . S IL ST=ILST+1, LST(ILST)= MTIM_U_HLO C_U_XLOC_U _XTYP_U_MO V_U_TIUDA QCLINRNG(L ST) ; retu rn date ra nges for c linic appo intments S LST(1)="T ;T^Today" S LST(2)=" T+1;T+1^To morrow" S LST(3)="T- 1;T-1^Yest erday" S L ST(4)="T-7 ;T^Past We ek" S LST( 5)="T-31;T ^Past Mont h" S LST(6 )="S^Speci fy Date Ra nge..." Q ; N %,%H,X ,SUNDAY,ST ART S LST( 1)=DT_";"_ DT_"^Today ",X=$$HTFM ^XLFDT($H+ 1,1) S LST (2)=X_";"_ X_"^Tomorr ow" S X=+$ H F Q:X#7 =3 S X=X-1 ; $H#7=3 is Sunday S LST(3)=$ $HTFM^XLFD T(X)_";"_$ $HTFM^XLFD T(X+6)_"^T his Week" S LST(4)=$ $HTFM^XLFD T(X+7)_";" _$$HTFM^XL FDT(X+13)_ "^Next Wee k" S LST(5 )=$E(DT,1, 5)_"01;"_$ E(DT,1,5)_ "31^This M onth" S X= $E(DT,4,5) +1 S:X=13 X=1 S X=$E (DT,1,3)_$ TR($J(X,2) ," ",0) S LST(6)=X_" 01;"_X_"31 ^Next Mont h" S LST(7 )="^Specif y Dates" Q DFLTSRC(VA L) ; retur n default patient li st source (T, W, C, P, S) N SR V S SRV=+$ G(^VA(200, DUZ,5)) S VAL=$$GET^ XPAR("ALL^ SRV.`"_SRV ,"ORLP DEF AULT LIST SOURCE") Q SAVDFLT(OK ,X) ; save new defau lt patient list sett ings (X=ty pe^ien^sdt ;edt) G SA VDFLT^ORWP T1 ;DISCHR G(Y,DFN,AD MITDT) ; G et dischar ge movemen t informat ion N VAIP I +$G(ADM ITDT)=0 S Y=DT Q S V AIP("D")=A DMITDT D 5 2^VADPT I +VAIP(17)= 0 S Y=DT Q S Y=+VAIP (17,1) QCW AD(Y,DFN) ; returns CWAD flags for a pat ient S Y=$ $CWAD^ORQP T2(DFN) QL EGACY(ORLS T,DFN) ; r eturn mess age if dat a on the l egacy syst em ; ORLST (0)=1 if d ata, ORLST (n)=displa y message if data S ORLST(0)=0 I $L($T(H XDATA^ORPO 7GUI)) D . D HXDATA^ ORPO7GUI(. ORLST,DFN) . I $O(OR LST(0)) S ORLST(0)=1 QINPLOC(R EC,DFN) ; Return a p atient's c urrent loc ation N X S X=$G(^DP T(DFN,.102 )),REC=0 I X S X=$P( $G(^DGPM(X ,0)),U,6) I X S REC= +$G(^DIC(4 2,X,44)) I X S $P(RE C,U,2)=$P( $G(^DIC(42 ,X,0)),U,1 ) I X S X= $P($G(^DIC (42,X,0)), U,3) S $P( REC,U,3)=X QAGE(DFN, BEG) ; ret urns age b ased on da te of birt h and date of death (or DT) N END,X S EN D=+$G(^DPT (DFN,.35)) ,END=$S(EN D:END,1:DT ) S X=$E(E ND,1,3)-$E (BEG,1,3)- ($E(END,4, 7)<$E(BEG, 4,7)) Q XR OK(X) ; Ro utine OK ( in UCI) (N DBI) S X=$ G(X) Q:'$L (X) 0 Q:$L (X)>8 0 X ^%ZOSF("TE ST") Q:$T 1 Q 0 ;- ; NDBI(X) ; National D atabase In tegration site 1 = y es 0 = no ; N R,G S X="A7RDUP" X ^%ZOSF( "TEST") S R=$T,G=$S( $D(^A7RCP) :1,1:0),X= R+G,X=$S(X =2:1,1:0) Q X | |
| 298 | ORQOAUIA ( New) | |
| 299 | ORQOAUIA ; ALB/RTW - DAILY TASK RETRIEVE ASSOCIATED ORDER FOR A QUICK O RDER ; 11/ 20/16 8:31 pm ;;1.1;O RQOA QUICK ORDER AUD IT V;**405 **;Jun 08, 2015 QSTA RT ; ENTRY POINT S O RDAT=$$NOW ^XLFDT\1 ; PROCESS RE CORDS UP T O 7 DAYS O LD F S OR DAT=$O(^AN AZ(6189050 ,"B",ORDAT )) Q:+ORDA T'>0 S ORI =0 F S OR I=$O(^ANAZ (6189050," B",ORDAT,O RI)) Q:+OR I'>0 D . S ORX0=^ANA Z(6189050, ORI,0),ORQ OIFN=$P(OR X0,U,4) . S ORD1=$O( ^ORD(101.4 1,ORQOIFN, 6,"D",4,0) ) . Q:ORD1 ="" ;QUIT IF NO ORD ERABLE ITE M SPECIFIE D ; NEW LI NE 2/7/11 . S ORDITE M=+^ORD(10 1.41,ORQOI FN,6,ORD1, 1) ; IFN O F ORDERABL E ITEM . S ORDFN=$P( ORX0,"^",3 ),ORDFNPLS =ORDFN_";D PT(" . S ( ORDAT2,ORS TOP)=0 F S ORDAT2=$ O(^OR(100, "ACT",ORDF NPLS,ORDAT 2)) Q:+ORD AT2'>0!(OR STOP) S OR J=0 F S O RJ=$O(^OR( 100,"AC",O RDFNPLS,OR DAT2,ORJ)) Q:+ORJ'>0 D .. S OR DATORD=$P( ^OR(100,OR J,0),"^",7 )+.000099 ;DATE/TIME ORDER ENT ERED .. S ORDTQUIC=$ P(^ANAZ(61 89050,ORI, 0),"^",1) ;DATE/TIME OF AUDIT RECORD .. I ORDATORD <ORDTQUIC S ORSTOP=1 ;CHECKING OLDER ORD ERS, ORSTO P CHECKING .. I ORDA TORD>ORDTQ UIC,(ORDAT ORD\1)=(OR DTQUIC\1) D ;SAME D ATE & GREA TER TIME . .. ; MATCH ORFND, ST ORE IFN OF ORDER IN AUDIT FILE ... I $D( ^OR(100,OR J,.1,"B",O RDITEM)) S $P(^ANAZ( 6189050,OR I,0),"^",8 )=ORJ,ORST OP=1 QSTAR T3 ; ENTRY POINT 2 N ORDAT,ORD AT2,ORDATO RD,ORDTQUI C,ORDFN,OR DFNPLS,ORF ND,ORI,ORJ ,ORJJ,ORJO ,ORK,ORKK, ORKK0,ORDI TEM,ORQOIF N,ORREPLCD ,ORSTOP,OR X,ORX0,ORD 1 S ORDAT= $$FMADD^XL FDT(DT,-30 ) ; PROCES S RECORDS UP TO 30 D AYS OLD I '$D(ZTQUEU ED) W !,"A udit#",?10 ,"Order",? 20,"Commen t" F S OR DAT=$O(^AN AZ(6189050 ,"B",ORDAT )) Q:+ORDA T'>0 S ORI =0 F S OR I=$O(^ANAZ (6189050," B",ORDAT,O RI)) Q:+OR I'>0 D . S ORX0=^ANA Z(6189050, ORI,0),ORQ OIFN=$P(OR X0,U,4) . Q:$P(ORX0, U,8)>0 ;Qu it if entr y already has a ORDE R NUMBER. . Q:ORQOIF N="" ;NO QUICK ORDE R RECORDED . S ORD1= $O(^ORD(10 1.41,ORQOI FN,6,"D",4 ,0)) . S O RDFN=$P(OR X0,U,3),OR DFNPLS=ORD FN_";DPT(" . S (ORDA T2,ORSTOP) =0 F S OR DAT2=$O(^O R(100,"ACT ",ORDFNPLS ,ORDAT2)) Q:+ORDAT2' >0!(ORSTOP ) S ORJJ=0 F S ORJJ =$O(^OR(10 0,"ACT",OR DFNPLS,ORD AT2,ORJJ)) Q:+ORJJ'> 0 D .. S O RJ=0 F S ORJ=$O(^OR (100,"ACT" ,ORDFNPLS, ORDAT2,ORJ J,ORJ)) Q: +ORJ'>0!(O RSTOP) D . .. S ORDAT ORD=$P(^OR (100,ORJ,0 ),"^",7)+. 000099 ;DA TE/TIME OR DER ENTERE D ... S OR DTQUIC=$P( ^ANAZ(6189 050,ORI,0) ,"^",1) ;D ATE/TIM OF AUDIT RECO RD ... S O RREPLCD=$P ($G(^OR(10 0,ORJ,3)), U,5) ;REPL ACED ORDER number if any. ... S ORJO=ORJ D SCAN I 'ORFND,ORR EPLCD>0 S ORJO=ORREP LCD D SCAN QSCAN ; ; LOOK FOR A UDIT IFN I N COMMENTS , STORE IF N OF ORDER IN AUDIT FILE S ORF ND=0 ; I O RKK0]"",OR KK0[("** P harmacy Co nfirmation #: "_ORI) S $P(^ANA Z(6189050, ORI,0),"^" ,8)=ORJ,OR STOP=1 I ' $D(ZTQUEUE D) W !,ORI ,?10,ORJ,? 20,ORKK0 I $D(^OR(10 0,ORJO,8,0 )) S ORK=0 F S ORK= $O(^OR(100 ,ORJO,8,OR K)) Q:+ORK '>0 I $D(^ OR(100,ORJ O,8,ORK,.1 ,0)) S ORK K=0 F S O RKK=$O(^OR (100,ORJO, 8,ORK,.1,O RKK)) Q:OR KK'>0 D . S ORKK0=^O R(100,ORJO ,8,ORK,.1, ORKK,0) I ORKK0["** Pharmacy C onfirmatio n",ORKK0[O RI S $P(^A NAZ(618905 0,ORI,0),U ,8)=ORJO,O RSTOP=1,OR FND=1 I '$ D(ZTQUEUED ) W !,ORI_ U_ORDAT,!, ?10,ORJ,?2 0,ORKK0 Q ; | |
| 300 | ORQOAUIB ( New) | |
| 301 | ORQOAUIB ; ALB/RTW - LIST ANTI- MICROBIAL ORDER, ORC DSS & NON- ORCDSS ; 1 1/23/16 7: 45pm ;;1.1 ;ORQOA QUI CK ORDER A UDIT V;;Ju n 08, 2015 N ORSDATE ,OREDATE,O RI,ORJ,ORC DSS,ORDIV, ORI1,OR2,Y ,X2,ORWHO, %DT,%IS,DI C,ZTIO,ZTR TN,ZTSAVE, ZTSK K ^TM P($J)START S %DT="AE ",%DT("A") ="Enter St arting Dat e: " D ^%D T Q:+Y'>0 S ORSDATE= +Y S %DT=" AE",%DT("A ")="Enter Ending Dat e: " D ^%D T Q:+Y'>0 S OREDATE= +Y I OREDA TE<ORSDATE W !,"** E RROR ** - Ending Dat e needs to follow St arting Dat e",! G STA RT S ORDIV ="" I $O(^ OR(100.953 ,0))>0 S D IC(0)="AEQ M",DIC="^O R(100.953, ",DIC("A") ="Select D IVISION GR OUP: " D ^ DIC Q:+Y'> 0 S ORDI V=+Y I $$F MDIFF^XLFD T(OREDATE, ORSDATE,1) >30 W !,"* * ERROR ** - Only 30 days at a time is p ermitted", ! G START S %IS="MQ" D ^%ZIS I $D(IO("Q" )) S ZTRTN ="DQ^R2QOA UI5",ZTSAV E("ORSDATE ")="",ZTSA VE("OREDAT E")="",ZTI O=ION,ZTSA VE("IO*")= "",ZTSAVE( "ORDIV")=" " D ^%ZTLO AD W !,"Ta sk Queued: ",ZTSK Q U IODQ ; Q UEUED ENTR Y POINT S I=ORSDATE F S ORI=$ O(^OR(100, "AF",ORI)) Q:+ORI'>0 !(+ORI>ORE DATE) S OR J=0 F S O RJ=$O(^OR( 100,"AF",O RI,ORJ)) Q :+ORJ'>0 D . Q:'$$DI VMATCH(ORJ ) ; QUIT I F NOT FOR ONE OF REQ UESTED DIV ISIONS . Q :'$$ANTIMI C(ORJ) ; Q UIT IF NOT ANTI-MICR OBIAL ORDE R . S ORCD SS=$$ORCDS S(ORJ) ; D ETERMINE W HETHER ORC DSS OR NON -ORCDSS OR DER . I OR CDSS S ^TM P($J,"ORCD SS",ORJ)=O RCDSS . E S ^TMP($J ,"NON-ORCD SS",ORJ)=" " D PRINT( "ORCDSS") ; PRINT OR CDSS ORDER S D PRINT( "NON-ORCDS S") ; PRIN T NON-ORCD SS ORDERS K ^TMP($J) D ^%ZISC ; CLOSE OU TPUT DEVIC E QDIVMATC H(Z) ; DET ERMINE IF ORDER IS F OR REQUEST ED DIVISIO N N ORLLOC ,ORRQDIV I ORDIV="" Q 1 ; NO D IVISIONS R EQUESTED S ORLLOC=$P (^OR(100,O RRD,0),U,1 0) I +ORLL OC>0,ORLLO C["SC" S O RRQDIV=$P( ^SC(+ORLLO C,0),U,15) I $G(ORRQ DIV)>0,$D( ^OR(100.95 3,ORDIV,1, "B",ORRQDI V)) Q 1 E Q 0ANTIMI C(Z) ; DET ERMINE IF ORDER HAS ANY ANTIMI CROBIAL IT EMS N ORI, ORJ,ORAM S ORAM=0 ; INITIALIZE TO NON AN TI-MICROBI AL ORDER S ORI=0 F S ORI=$O(^ OR(100,ORR D,.1,"B",O RI)) Q:+OR I'>0 I +$G (^ORD(101. 43,ORI,618 001))=1 S ORAM=1 ; O RDERABLE I TEM MARKED AS ANTI-M ICROBIAL Q ORAMORCDS S(Z) ; DET ERMINE IF ORDER IS O RCDSS OR N OT ;LOOK F OR AUDIT I FN IN COMM ENTS, STOR E IFN OF O RDER IN AU DIT FILE N ORK,ORKK, ORKK0,ORCD SSORDER S ORCDSSORDE R=0 ; INIT IALIZE TO NON-ORCDSS ORDER I O RKK0]"",OR KK0["** Ph armacy Con firmation #: " S ORC DSSORDER=1 _"^"_ORKK0 ;IDENTIFI ED AS ORCD SS ORDER I $D(^OR(10 0,ORJ,8,0) ) S ORK=0 F S ORK=$ O(^OR(100, ORJ,8,ORK) ) Q:+ORK'> 0 I $D(^OR (100,ORJ,8 ,ORK,.1,0) ) S ORKK=0 F S ORKK =$O(^OR(10 0,ORJ,8,OR K,.1,ORKK) ) Q:ORKK'> 0 D .S ORK K0=^OR(100 ,ORJ,8,ORK ,.1,ORKK,0 ) I ORKK0[ "** Pharma cy Confirm ation" S O RCDSSORDER =1_"^"_ORK K0 ; IDENT IFIED AS O RCDSS ORDE R Q ORCDSS ORDERPRINT (Z) ; PRIN T RESULTS ; ORWHO = 'WHO ENTER ED' field ; ORCNUM = Pharmacy Confirmati on No (Rec ord # in f ile 618905 0) ; OR2ED AT = 'WHEN ENTERED' field ; OR 2PAT = Pat ient Name and last 4 of SSN ; OR2PRB = ' CURRENT AG ENT/PROVID ER' field ; OR2LOC = 'PATIENT LOCATION' field N OR X0,X8,ORI, ORK,OR2DOT S,OR2PROV, ORCNUM,OR2 EDAT,OR2HF S,OR2PAT,D FN,OR2SSN, OR2LOC,OR2 OITEM S OR 2HFS=$$HFS () ; DETER MINE WHETH ER PRINTER OR HFS DE VICE I OR2 HFS,Z="ORC DSS" W "Ty pe"_U_"Ord er #"_U_"P atient"_U_ "Who Enter ed"_U_"Con firm #"_U_ "When Ente red"_U_"Pr ovider"_U_ "Location" _U_"Ordera ble Item" I 'OR2HFS W !!,"Anti -Microbial Orders",? 65 D ^%D W :ORDIV]"" !,"Divisio n Group: " ,$P(^OR(10 0.953,ORDI V,0),"^",1 ) W !," ", ORRD," Ord ers" S $P( OR2DOTS,"- ",81)="" D .W !!,"Or der #",?12 ,"Patient" W:ORZ="OR CDSS" ?30, "Confirm # " W ?42,"W ho Entered ",?68,"Whe n Entered" ,!?12,"Loc ation",?42 ,"Provider ",!?42,"Or derable It em",!,OR2D OTS S ORI= 0 F S ORI =$O(^TMP($ J,ORRD,ORI )) Q:+ORI' >0 D .S OR X0=^OR(100 ,ORI,0) .S ORWHO=$P( ORX0,"^",6 ),ORWHO=$E ($P(^VA(20 0,ORWHO,0) ,U,1),1,20 ) .S ORCNU M=^TMP($J, ORRD,ORI) I ORCNUM]" " S ORCNUM =$P($P(ORC NUM,"Confi rmation #: ",2)," ", 1) .;S ORC NUM=^TMP($ J,ORRD,ORI ) I ORCNUM ]"" S ORCN UM=$P($P(O RCNUM,"Con firmation" ,2)," ",1) .S OR2EDA T=$P(ORX0, U,7) I OR2 EDAT<ORSDA TE!(OR2EDA T>OREDATE) Q ; ORDE R NOT ENTE RED WITHIN DATE RANG E .S OR2PA T=$P(ORX0, U,2),DFN=+ OR2PAT .I +DFN>0 S O R2PAT=$P(^ DPT(DFN,0) ,U,1),OR2S SN=$E($P(^ (0),U,9),6 ,9),OR2PAT =$P(OR2PAT ,",",1),OR 2PAT=OR2PA T_" ("_OR2 SSN_")" .E S OR2PAT ="No Patie nt" .S OR2 EDAT=$$FMT E^XLFDT(OR 2EDAT,"2D" ) .S OR2PR OV=$P(ORX0 ,U,4) S:+O R2PROV>0 O R2PROV=$P( ^VA(200,OR 2PROV,0),U ,1) .S OR2 LOC=$P(ORX 0,U,10) I +OR2LOC>0 S X2=$P(OR 2LOC,";",2 ) S OR2LOC =$P(@("^"_ X2_+OR2LOC _",0)"),U, 1) .D ITEM .I OR2HFS W !,ORZ_U _ORI_U_OR2 PAT_U_ORWH O_U_ORCNUM _U_OR2EDAT _U_OR2PROV _U_OR2LOC_ U_OR2OITEM .E W !,O RI,?12,OR2 PAT,?32,OR CNUM,?42,O RWHO,?71,O R2EDAT,!?1 2,OR2LOC,? 42,OR2PROV ,!?42,OR2O ITEM QHFS( ) ; RETURN '1' IF OU TPUTTING T O A FILE, '0' FOR DE VICE I $P( ^%ZIS(1,IO S,"TYPE"), U,1)="HFS" Q 1 Q 0IT EM ;Defi ne orderab le item. S OR2OITEM= "",ORQQ=0 I $D(^OR(1 00,ORI,.1) ) S ORI1=0 F S ORI1 =$O(^OR(10 0,ORI,.1,O RI1)) Q:OR I1'>0 Q:OR QQ S OR2= ^OR(100,OR I,.1,ORI1, 0) D .I $G (^ORD(101. 43,OR2,618 001))=1 S OR2OITEM=$ P(^ORD(101 .43,OR2,0) ,U,1),ORQQ =1 K ORQQ Q | |
| 302 | ORQOAUIC (New) | |
| 303 | ORQOAUIC ; ALB/RTW - QUICK ORDE R DATA RET RIEVAL ; 1 1/24/16 1: 54pm ;;1.1 ;ORQOA QUI CK ORDER A UDIT V;;Ju n 08, 2015 QAUD(ORDF N,TYPE) ; ENTRY POIN T N ORORN, ORPROV,ORL OC,ORDICDR ,ORPROVDUZ ,ORX,Y,ORD 0,ORD1,ORD 2,%,DIC,OR X0 Q:+ORDF N'>0 "" ; Quit if n o patient is specifi ed per tic ket CR6433 30 S ORORN =$G(^TMP(" ZZ QUICK O RDER AUDIT ",$J,"DLGI D")) ; DEF INE QUICK ORDER IEN S ORPROV=$ G(^TMP("ZZ QUICK ORD ER AUDIT", $J,"REC")) S ORLOC=$ P(ORPROV,U ,1),ORPROV =$P(ORPROV ,U,4) ; DE FINE LOCAT ION AND PR OVIDER S O RPROVDUZ=$ $PROVDUZ(O RPROV) ; G ET PROVIDE R'S DUZ S ORX=$$NOW^ XLFDT S DI C("DR")="1 ////"_DUZ_ ";2////"_O RDFN_";3// //"_ORORN_ ";4////"_O RPROVDUZ_" ;5////"_TY PE_";6///" _$G(ORLOC) S ORDICDR =DIC("DR") ; WLS/MPL S NEW LINE 10/3/07 S DIC="^OR( 100.95,",D IC(0)="L" D FILE^DIC N I +Y=-1 S ^WLS("AN AZQUIC",$H )=$G(ORDIC DR) ; WLS/ MPLS NEW L INE 10/3/0 7 Q "** Ph armacy Con firmation #: "_+Y_" **" ; QUIC K ORDER NU MBER N ORQ OORNAME,OR I,ORIFN S ORIFN="<NO NE>",ORQOO RNAME=$P($ G(ORX0),"^ ",1),ORQOO RNAME=$E(O RQOORNAME, 1,30) S OR I=0 F S O RI=$O(^ORD (101.41,"B ",ORQOORNA ME,ORI)) Q :+ORI'>0 I ^ORD(101. 41,ORI,0)= ORX0 S ORI FN=I Q ORI FNDRUG(ORD 0) ; FOR ' DRUG' COMP UTED FIELD IN THE QU ICK ORDER AUDIT FILE N ORD1,OR D2 S ORD1= $O(^ORD(10 1.41,ORD0, 6,"D",4,0) ) I ORD1'> 0 Q "<NONE >" S ORD2= +^ORD(101. 41,ORD0,6, ORD1,1) Q $$OUTPUT^O RQOAUIC(OR D2)OUTPUT( ORY) ; -- Output Xfo rm for Val ue field o f Response multiple of Order D ialog file , 101.41 N ORDIALOG, ORP,ORZ S ORZ=ORY S ORP=$P($G( ^ORD(101.4 1,ORD0,6,O RD1,0)),U, 2) I ORP S ORDIALOG( ORP,0)=$P( $G(^ORD(10 1.41,ORP,1 )),U,1,2), ORDIALOG(O RP,1)=ORY, ORZ=$$EXT^ ORCD(ORP,1 ) Q ORZPRO VDUZ(ORUN) ; RETURN DUZ FOR US ER ORUN WH ERE ORUN I S USER'S O RNAME ; If more than one user with this ORNAMe, pi ck one wit h access c ode ; If m ore than o ne with ac cess code, just pick first one ; ORCNT = # of user s with thi s ORNAMe ; ORORACCNT = # of us er with th is ORNAMe that have an access code N ORN AME,ORCNT, ORI,USER,O RACCNT S O RNAME=$E(O RUN,1,35), (ORCNT,ORI ,ORACCNT)= 0 F S ORI =$O(^VA(20 0,"B",ORNA ME,ORI)) Q :+ORI'>0 S ORCNT=ORC NT+1 I $P( $G(^VA(200 ,ORI,0)),U ,3) S ORAC CNT=ORACCN T+1 S ORAC CNT(ORI)=" " ; COUNT USERS WITH THIS ORNA ME I ORACC NT>0 Q $O( ORACCNT(0) ) ; At lea st one wit h access c ode, retur n first on e with DUZ Q $O(^VA( 200,"B",OR NAME,0)) ; No one wi th access code. Just return fi rst user w ith this O RNAMe. |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.