Produced by Araxis Merge on 12/9/2016 1:22:48 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:\Users\vhaisbforrez\AraxisComp\PUB_UN\EPIP_Test_Cases_Functional Testing_(OR_3.0_431)_201611.zip | EPIP_Remediation_Plan_(OR_3.0_431)_201611.docx | Wed Dec 7 19:58:00 2016 UTC |
| 2 | C:\Users\vhaisbforrez\AraxisComp\PUB_RE\EPIP_Test_Cases_Functional Testing_(OR_3.0_431)_201611.zip | EPIP_Remediation_Plan_(OR_3.0_431)_201611.docx | Thu Dec 8 21:40:01 2016 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 7 | 2050 |
| Changed | 6 | 14 |
| 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*431 | |
| 3 | Remediatio n Plan | |
| 4 | ||
| 5 | Department of Vetera ns Affairs | |
| 6 | November 2 016 | |
| 7 | Version 2. 0 | |
| 8 | ||
| 9 | ||
| 10 | ||
| 11 | Revision H istory | |
| 12 | Date | |
| 13 | Version | |
| 14 | Descriptio n | |
| 15 | Author | |
| 16 | 11/15/2016 | |
| 17 | 2.0 | |
| 18 | Updated en tire docum ent | |
| 19 | EPIP Proje ct Team | |
| 20 | 08/19/2016 | |
| 21 | 1.0 | |
| 22 | Initial (d raft) vers ion | |
| 23 | EPIP Proje ct Team | |
| 24 | ||
| 25 | ||
| 26 | ||
| 27 | ||
| 28 | Table of C ontents | |
| 29 | 1.Introduc tion1 | |
| 30 | 2.Purpose1 | |
| 31 | 3.Patch De scription1 | |
| 32 | 3.1.Needs and Requir ements3 | |
| 33 | 4.Points o f Contact3 | |
| 34 | 5.Code Rem ediation3 | |
| 35 | 5.1.Standa rds and Co nventions3 | |
| 36 | 5.2.Review and Analy sis4 | |
| 37 | 5.3.Coding Changes4 | |
| 38 | 6.Testing4 | |
| 39 | 6.1.Test P lan4 | |
| 40 | 6.2.Test E nvironment 5 | |
| 41 | 6.3.Test R eadiness R eview5 | |
| 42 | 6.4.Testin g Phases5 | |
| 43 | 6.4.1.Unit Testing5 | |
| 44 | 6.4.2.Comp onent Inte gration an d Systems Testing (C I/ST)5 | |
| 45 | 6.4.3.Func tional Tes ting5 | |
| 46 | 6.4.4.Regr ession Tes ting5 | |
| 47 | 6.4.5.VA S ection 508 Complianc e Testing6 | |
| 48 | 7.Document ation Reme diation6 | |
| 49 | 7.1.User G uides6 | |
| 50 | 7.2.Instal lation Gui des6 | |
| 51 | 7.3.Techni cal Manual s6 | |
| 52 | 7.4.Operat ions Manua ls6 | |
| 53 | 8.Project Reporting6 | |
| 54 | 9.Project Schedule7 | |
| 55 | 10.Deploym ent7 | |
| 56 | 11.Sustain ment Requi rements7 | |
| 57 | 12.Mainten ance and K nowledge T ransfer7 | |
| 58 | Appendix A :XINDEX Li sting for MUMPS Code Changes8 | |
| 59 | Appendix B :Source Co de Changes 10 | |
| 60 | ||
| 61 | ||
| 62 | ||
| 63 | Introducti on | |
| 64 | 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. | |
| 65 | Purpose | |
| 66 | The purpos e of this document i s to fully describe the remedi ation plan to be use d for the successful remediati on and tes ting of th e intake p roduct cod e to be de ployed as patch OR*3 .0*431. Th is patch a ddresses t he followi ng NSRs: | |
| 67 | NSR2008031 7 Default Encounter Location | |
| 68 | This NSR h as been im plemented locally at the VA Me dical Cent ers in Boi se VA, Hin es IL, Ric hmond VA., and Seatt le WA. | |
| 69 | NSR2015060 8 Accessio n of Site- Supported Lab Test | |
| 70 | This NSR h as been im plemented locally at the follo wing VA Me dical Cent ers: VA He artland - West (Kans as City, C olumbia, T opeka, Lea venworth, Wichita); VA Heartla nd - East (St. Louis , Poplar B luff, Mari on); VA No rthern Ind iana Healt h Care Sys tem (Mario n, Fort Wa yne). | |
| 71 | NSR2014121 0 CPRS Pop -Up Box | |
| 72 | This NSR h as been im plemented locally at the VA Me dical Cent er in Balt imore MD. | |
| 73 | This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation, and delive ry of this remediati on effort. | |
| 74 | Patch Desc ription | |
| 75 | OR*3.0*431 provides the follow ing enhanc ements to VistA: | |
| 76 | Enables he althcare p roviders t o designat e one or m ore defaul t encounte r location s to be di splayed at the top o f the prov ider’s Enc ounter Loc ation sele ction list in the Co mputerized Patient R ecord Syst em (CPRS) Provider & Location for Curren t Activiti es dialog box. Curre ntly, an a lphabetica l list of all locati ons availa ble in the HOSPITAL LOCATION f ile is dis played. Th is modific ation redu ces the ti me necessa ry to sele ct frequen tly used e ncounter l ocations a nd reduces the poten tial for e rroneous s election o f a locati on from a long list. | |
| 77 | The modifi cation als o enables Clinical A pplication Coordinat ors (CACs) to select and manag e default encounter locations on behalf of provide rs. | |
| 78 | ||
| 79 | Default En counter Lo cations Di splayed Fi rst | |
| 80 | Restricts the displa y of avail able lab t ests in CP RS to only those for which the ordering provider’s location matches th e accessio n location for the t est. Curre ntly, all lab tests are allowe d to be or derable it ems, even if the pro vider’s lo cation doe s not matc h the acce ssion loca tion. If t he provide r inadvert ently orde rs lab tes ts that ca nnot be pe rformed at the local facility, then the tests are not access ioned, lab els are no t printed, and labs are not co llected. T here is no notificat ion to the provider that an er ror has oc curred. | |
| 81 | This modif ication en sures that laborator y tests or dered at m ulti-divis ional faci lities can in fact b e complete d at the o rdering pr ovider’s l ocal facil ity. | |
| 82 | Automatica lly displa ys a messa ge box whe n a health care provi der opens a patient chart in C PRS. This is a mecha nism for c ommunicati ng informa tion that is not par t of the p atient’s o fficial me dical reco rd. Messag es can be global (th e same mes sage appea ring for a ll patient s), or spe cific to o ne or a se lect group of patien ts. | |
| 83 | The messag es are mai ntained th rough a se ries of fi le mainten ance optio ns, using the follow ing system flags: FL AG 1/FLAG 2 (standar d message to be sent to a sele ct group o f patients ), STATE V ETERANS HO ME (indica tes SVH re sidence fo r a patien t), LOCAL NOTICE (sp ecific mes sage for a specific patient), COMBAT (in dicates Op eration En during Fre edom (OEF) /Operation Iraqi Fre edom (OIF) status), INELIGIBLE (indicate s that the patient i s ineligib le for tre atment at a VA facil ity), OBSE RVATION (i ndicates t hat the pa tient is a dmitted an d is in ob servation status), a nd NON-VES TED (indic ates that the patien t is eligi ble for a vesting vi sit). | |
| 84 | ||
| 85 | Needs and Requiremen ts | |
| 86 | The Needs and Requir ements for the NSRs addressed in this re mediation are: | |
| 87 | NSR2008031 7 Default Encounter Location: | |
| 88 | NEED 38597 7: Encount ers Locati on List Re duce typin g and scro lling to s elect | |
| 89 | REQUIREMEN T 392969: CPRS Locat ion List D isplay pre ferred loc ations | |
| 90 | NEED 38597 9: Encount ers Locati on List Re duce poten tial for s election e rror | |
| 91 | REQUIREMEN T 392967: CPRS Locat ion List A void error s in selec ting from long lists | |
| 92 | NEED 72551 0: Designa te Default Hospital Location | |
| 93 | NSR2015060 8 Accessio n of Site Supported Lab Test: | |
| 94 | NEED 59035 1: Prevent Incorrect Ordering of Lab Tes ts | |
| 95 | NEED 57675 5: Facilit y Specific Lab Test | |
| 96 | NEED 59035 3: Prevent Physician Ordering Labs Incor rectly | |
| 97 | NSR2014121 0 CPRS Pop -Up Box: | |
| 98 | NEED 50843 0: For aut horized us ers of VA’ s electron ic health record who need to v iew patien t-related informatio n that is not readil y availabl e by simpl y viewing the patien t chart. T he ability to displa y a pop-up note upon selection of a pati ent that c ontains in formation. | |
| 99 | Points of Contact | |
| 100 | The VA Poi nt of Cont act (POC) for NSR200 80317 Defa ult Encoun ter Locati on and NSR 20141210 C PRS Pop-Up Box is Ro bert Silve rman ( PII ), 708-202 -5040. | |
| 101 | The D A N P S C f r NSR20150 608 Access ion of Sit e Supporte d Lab Test is Liesl T Wilson, ( PII ), 816-861 -4700. | |
| 102 | Code Remed iation | |
| 103 | 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. | |
| 104 | Standards and Conven tions | |
| 105 | Leidos wil l referenc e the http :// URL website fo r applicab le documen ts and wil l adhere t o VA stand ards to co mplete the analysis of this in take produ ct. The ou tput of th e VA XINDE X utility will be us ed to anal yze the MU MPS source code and document t he affecte d routines (see Appe ndix A). | |
| 106 | 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. | |
| 107 | Review and Analysis | |
| 108 | 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 within C PRS, and 2 ) verifica tion that the source code chan ges do not adversely affect an y other Vi stA functi onality. | |
| 109 | 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. | |
| 110 | Coding Cha nges | |
| 111 | The coding changes r equired fo r NSR20080 317 Defaul t Encounte r Location are in th e followin g MUMPS ro utines: | |
| 112 | Modified r outines: O RWU, ORWU1 | |
| 113 | New routin es: ORCLOC , ORCP031 | |
| 114 | The coding changes r equired fo r NSR20150 608 Access ion of Sit e Supporte d Lab Test are in th e followin g MUMPS ro utines: | |
| 115 | Modified r outines: O RWDX | |
| 116 | New routin es: None | |
| 117 | The coding changes r equired fo r NSR20141 210 CPRS P op-Up Box are in the following MUMPS rou tines: | |
| 118 | Modified r outines: O RWPT | |
| 119 | New routin es: ORPO7G UI, ORPOCH F, ORPOMDR O, ORPOOBS , ORPOTIO, ORPOVST | |
| 120 | A detailed analysis of the cod ing change s is provi ded in App endix B. | |
| 121 | Testing | |
| 122 | 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. | |
| 123 | Test Plan | |
| 124 | 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 VIP guide lines. | |
| 125 | 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. | |
| 126 | Test Envir onment | |
| 127 | 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. | |
| 128 | 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 mo dification , the foll owing tool s will be leveraged: RQM, Refl ections em ulator, CP RS GUI v30 b (1.0.30. 72), and S nagIt. | |
| 129 | Test Readi ness Revie w | |
| 130 | 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 ). | |
| 131 | Testing Ph ases | |
| 132 | Leidos wil l perform developmen t and SQA testing ac tivities i n phases, and will p rovide all required testing do cumentatio n. | |
| 133 | Unit Testi ng | |
| 134 | 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. | |
| 135 | Component Integratio n and Syst ems Testin g (CI/ST) | |
| 136 | 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. | |
| 137 | Functional Testing | |
| 138 | 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. | |
| 139 | Regression Testing | |
| 140 | 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. | |
| 141 | VA Section 508 Compl iance Test ing | |
| 142 | 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. | |
| 143 | Documentat ion Remedi ation | |
| 144 | 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. | |
| 145 | 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 http://ww w. DNS . Keyword searches u sing terms relevant to this re mediation effort wil l be used to identif y document s that mig ht be impa cted; thos e document s were wil l then be reviewed i n their en tirety for any neede d revision s. | |
| 146 | The follow ing sectio ns outline the VDL d ocuments t o be revis ed for thi s remediat ion. | |
| 147 | User Guide s | |
| 148 | The follow ing User G uide will be updated in the VD L: | |
| 149 | Computeriz ed Patient Record Sy stem (CPRS ) User Gui de: GUI Ve rsion | |
| 150 | Installati on Guides | |
| 151 | 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. | |
| 152 | Technical Manuals | |
| 153 | The follow ing Techni cal Manual will be u pdated in the VDL: | |
| 154 | Computeriz ed Patient Record Sy stem (CPRS ) Technica l Manual | |
| 155 | Operations Manuals | |
| 156 | No Operati ons Manual s require revision a s a result of this m odificatio n. | |
| 157 | Project Re porting | |
| 158 | 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. | |
| 159 | Project Sc hedule | |
| 160 | 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 four 2-wee k sprints. | |
| 161 | Deployment | |
| 162 | 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. | |
| 163 | Sustainmen t Requirem ents | |
| 164 | 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 . | |
| 165 | Maintenanc e and Know ledge Tran sfer | |
| 166 | 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. | |
| 167 | XINDEX Lis ting for M UMPS Code Changes | |
| 168 | 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. | |
| 169 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 170 | [2008 V A Standard s & Conven tions] | |
| 171 | UC I: VISTA C PU: ROU Oct 18, 2 016@08:04: 01 | |
| 172 | ||
| 173 | All Routin es? No => No | |
| 174 | ||
| 175 | Routine: | |
| 176 | 0 routines | |
| 177 | ||
| 178 | Select BUI LD NAME: O R*3.0*431 ORDE R ENTRY/RE SULTS REPO RTING | |
| 179 | ||
| 180 | Include th e compiled template routines: N// | |
| 181 | ||
| 182 | Print more than comp iled error s and warn ings? YES/ /N | |
| 183 | ||
| 184 | Save param eters in R OUTINE fil e? NO// | |
| 185 | ||
| 186 | Index all called rou tines? NO/ / | |
| 187 | DEVICE: ;; 999 HOME (CRT) Right Marg in: 80// | |
| 188 | ||
| 189 | ||
| 190 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 191 | [2008 V A Standard s & Conven tions] | |
| 192 | UC I: VISTA C PU: ROU Oct 18, 2 016@08:04: 01 | |
| 193 | ||
| 194 | The BUILD file Data Dictionari es are bei ng process ed. | |
| 195 | ||
| 196 | 100.007 OR PU POPUP X ECUTEABLE CODE.. | |
| 197 | 100.00701 DESCRIPTIO N.. | |
| 198 | 100.00702 XECUTABLE CODE.. | |
| 199 | 100.00703 TEXT.. | |
| 200 | 100.0071 O RPU POPUP PATIENT FL AG. | |
| 201 | 100.00711 FLAG. | |
| 202 | 100.00712 COMMENTS.. . | |
| 203 | 100.0072 O RPU POPUP FLAG.. | |
| 204 | 100.0073 O RPU POPUP LOCAL NOTI CE.. | |
| 205 | 100.0074 O RPU POPUP VESTING. | |
| 206 | 200.08 DEF AULT ENCOU NTER LOCAT ION | |
| 207 | The option and funct ion files are being processed. | |
| 208 | ||
| 209 | ||
| 210 | Routines a re being p rocessed. | |
| 211 | Routines: 12 Faux R outines: 1 2 | |
| 212 | ||
| 213 | ORCLOC ORCP031 ORPO7GUI ORPOCHF ORPOMDRO ORPOOBS ORPOTIO ORPOVST | |
| 214 | ORWDX ORWPT ORWU ORWU1 | |
| 215 | ||
| 216 | Data Dicti onaries | |
| 217 | |dd100.007 |dd10 0.00701 |dd100.007 02 |dd10 0.00703 |dd100.007 1 | |
| 218 | |dd100.007 11 |dd10 0.00712 |dd100.007 2 |dd10 0.0073 |dd100.007 4 | |
| 219 | |dd200.08 |opt | |
| 220 | ||
| 221 | --- CROSS REFERENCIN G --- | |
| 222 | ||
| 223 | ||
| 224 | Compiled l ist of Err ors and Wa rnings Oct 18, 20 16@08:04:0 1 page 1 | |
| 225 | No errors or warning s to repor t | |
| 226 | ||
| 227 | ||
| 228 | --- END -- - | |
| 229 | Source Cod e Changes | |
| 230 | 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: | |
| 231 | Modified r outines: O RWU, ORWU1 , ORWDX, O RWPT | |
| 232 | New routin es: ORCLOC , ORCP031, ORPO7GUI, ORPOCHF, ORPOMDRO, ORPOOBS, O RPOTIO, OR POVST | |
| 233 | ORWU | |
| 234 | Before: | |
| 235 | HOSPLOC(Y ,FROM,DIR) ; Return a set of l ocations f rom HOSPIT AL LOCATIO N | |
| 236 | ; .Y=return ed list, F ROM=text t o $O from, DIR=$O di rection, | |
| 237 | N I,IEN,CNT S I=0,CNT =44 | |
| 238 | F Q:I'<CNT S FROM=$ O(^SC("B", FROM),DIR) Q:FROM="" D ; IA# 10040. | |
| 239 | . S IEN="" F S IEN=$ O(^SC("B", FROM,IEN), DIR) Q:'IE N D | |
| 240 | . . Q:("CW" '[$P($G(^S C(IEN,0)), U,3)!('$$A CTLOC(IEN) )) | |
| 241 | . . S I=I+1 ,Y(I)=IEN_ "^"_FROM | |
| 242 | Q | |
| 243 | After: | |
| 244 | HOSPLOC(Y, FROM,DIR) ; Return a set of lo cations fr om HOSPITA L LOCATION | |
| 245 | ; .Y=return ed list, F ROM=text t o $O from, DIR=$O di rection, | |
| 246 | N I,IEN,CNT S I=0,CNT =44 | |
| 247 | I $D(^VA(20 0,DUZ,"DEL OC")) D NE WLOC^ORCLO C(.Y,ORFRO M,DIR) Q | |
| 248 | F Q:I'<CNT S FROM=$ O(^SC("B", FROM),DIR) Q:FROM="" D ; IA# 10040. | |
| 249 | . S IEN="" F S IEN=$ O(^SC("B", FROM,IEN), DIR) Q:'IE N D | |
| 250 | . . Q:("CW" '[$P($G(^S C(IEN,0)), U,3)!('$$A CTLOC(IEN) )) | |
| 251 | . . S I=I+1 ,Y(I)=IEN_ "^"_FROM | |
| 252 | Q | |
| 253 | ||
| 254 | ORWU1 | |
| 255 | Before: | |
| 256 | NEWLOC(Y, ORFROM,DIR ) ; Return "CZ" loca tions from HOSPITAL LOCATION f ile. | |
| 257 | ; C=Clinics , Z=Other, screened by $$ACTLO C^ORWU. | |
| 258 | ; .Y=return ed list, O RFROM=text to $O fro m, DIR=$O direction. | |
| 259 | N I,IEN,CNT S I=0,CNT =44 | |
| 260 | F Q:I'<CNT S ORFROM =$O(^SC("B ",ORFROM), DIR) Q:ORF ROM="" D ; IA# 100 | |
| 261 | 40. | |
| 262 | . S IEN="" F S IEN=$ O(^SC("B", ORFROM,IEN ),DIR) Q:' IEN D | |
| 263 | . . Q:("C"' [$P($G(^SC (IEN,0)),U ,3)!('$$AC TLOC^ORWU( IEN))) | |
| 264 | . . S I=I+1 ,Y(I)=IEN_ "^"_ORFROM | |
| 265 | Q | |
| 266 | After: | |
| 267 | NEWLOC(Y,O RFROM,DIR) ; Return "CZ" locat ions from HOSPITAL L OCATION fi le. | |
| 268 | ; C=Clinics , Z=Other, screened by $$ACTLO C^ORWU. | |
| 269 | ; .Y=return ed list, O RFROM=text to $O fro m, DIR=$O direction. | |
| 270 | ; ;--------- ---------- ---------- ---------- ---------- ---------- ---- | |
| 271 | I $D(^VA(20 0,DUZ,"DEL OC")) D NE WLOC^ORCLO C(.Y,ORFRO M,DIR) Q | |
| 272 | N I,IEN,CNT S I=0,CNT =44 | |
| 273 | F Q:I'<CNT S ORFROM =$O(^SC("B ",ORFROM), DIR) Q:ORF ROM="" D ; IA# 100 | |
| 274 | 40. | |
| 275 | . S IEN="" F S IEN=$ O(^SC("B", ORFROM,IEN ),DIR) Q:' IEN D | |
| 276 | . . Q:("C"' [$P($G(^SC (IEN,0)),U ,3)!('$$AC TLOC^ORWU( IEN))) | |
| 277 | . . S I=I+1 ,Y(I)=IEN_ "^"_ORFROM | |
| 278 | Q | |
| 279 | ; | |
| 280 | ORWDX | |
| 281 | Before: | |
| 282 | ORDITM(Y,F ROM,DIR,XR EF,QOCALL) ; Subset of orderab le items | |
| 283 | ; Y(n)=IEN^ .01 Name^. 01 Name - or- IEN^S ynonym <.0 1 Name>^.0 1 Name | |
| 284 | N I,IEN,CNT ,X,DTXT,CU RTM,DEFROU TE | |
| 285 | S DEFROUTE= "" | |
| 286 | S QOCALL=+$ G(QOCALL) | |
| 287 | S I=0,CNT=4 4,CURTM=$$ NOW^XLFDT | |
| 288 | F Q:I'<CNT S FROM=$ O(^ORD(101 .43,XREF,F ROM),DIR) Q:FROM="" D | |
| 289 | . S IEN="" F S IEN=$ O(^ORD(101 .43,XREF,F ROM,IEN),D IR) Q:'IEN D | |
| 290 | . . S X=^OR D(101.43,X REF,FROM,I EN) | |
| 291 | . . I +$P(X ,U,3),$P(X ,U,3)<CURT M Q | |
| 292 | . . I 'QOCA LL,$P(X,U, 5) Q | |
| 293 | . . S I=I+1 | |
| 294 | . . I 'X S Y(I)=IEN_U _$P(X,U,2) _U_$P(X,U, 2) | |
| 295 | . . E S Y( I)=IEN_U_$ P(X,U,2)_$ C(9)_"<"_$ P(X,U,4)_" >"_U_$P(X, U,4) | |
| 296 | Q | |
| 297 | ODITMBC(Y, XREF,ODLST ) ; | |
| 298 | After: | |
| 299 | ORDITM(Y,F ROM,DIR,XR EF,QOCALL) ; Subset of orderab le items | |
| 300 | ; Y(n)=IEN^ .01 Name^. 01 Name - or- IEN^S ynonym <.0 1 Name>^.0 1 Name | |
| 301 | N I,IEN,CNT ,X,DTXT,CU RTM,DEFROU TE | |
| 302 | S DEFROUTE= "" | |
| 303 | S QOCALL=+$ G(QOCALL) | |
| 304 | S I=0,CNT=44 ,CURTM=$$N OW^XLFDT | |
| 305 | F Q:I'<CNT S FROM=$ O(^ORD(101 .43,XREF,F ROM),DIR) Q:FROM="" D | |
| 306 | . S IEN="" F S IEN=$ O(^ORD(101 .43,XREF,F ROM,IEN),D IR) Q:'IEN D | |
| 307 | . . S X=^OR D(101.43,X REF,FROM,I EN) | |
| 308 | . . I +$P(X ,U,3),$P(X ,U,3)<CURT M Q | |
| 309 | . . I '$$ST ART(XREF,I EN) Q | |
| 310 | . . I 'QOCA LL,$P(X,U, 5) Q | |
| 311 | . . S I=I+1 | |
| 312 | . . I 'X S Y(I)=IEN_U _$P(X,U,2) _U_$P(X,U, 2) | |
| 313 | . . E S Y( I)=IEN_U_$ P(X,U,2)_$ C(9)_"<"_$ P(X,U,4)_" >"_U_$P(X, U,4) | |
| 314 | Q | |
| 315 | ; | |
| 316 | START(INDE X,ET) ; Ch eck to see if test i s part of users DUZ( 2) | |
| 317 | ; | |
| 318 | S OUT=1 | |
| 319 | I INDEX="S. LAB" D | |
| 320 | . N NOD,P | |
| 321 | . S NOD=^OR D(101.43,E T,0),P=$P( $P(NOD,U,2 ),";") | |
| 322 | . I '$D(^LA B(60,P)) Q | |
| 323 | . I '$D(^LA B(60,P,8)) Q | |
| 324 | . I '$D(^LA B(60,P,8,D UZ(2))) S OUT=0 | |
| 325 | Q OUT | |
| 326 | ; | |
| 327 | ODITMBC(Y, XREF,ODLST ) ; | |
| 328 | ORWPT | |
| 329 | Before: | |
| 330 | LEGACY(ORL ST,DFN) ; return mes sage if da ta on the legacy sys tem | |
| 331 | ; ORLST(0)= 1 if data, ORLST(n) =display m essage if data | |
| 332 | S ORLST(0)= 0 | |
| 333 | I $L($T(HXD ATA^A7RDPA GU)) D | |
| 334 | . D HXDATA^ A7RDPAGU(. ORLST,DFN) | |
| 335 | . I $O(ORLS T(0)) S OR LST(0)=1 | |
| 336 | Q | |
| 337 | After: | |
| 338 | LEGACY(ORL ST,DFN) ; return mes sage if da ta on the legacy sys tem | |
| 339 | ; ORLST(0)= 1 if data, ORLST(n) =display m essage if data | |
| 340 | S ORLST(0)= 0 | |
| 341 | D HXDATA^OR PO7GUI(.OR LST,DFN) | |
| 342 | I $O(ORLST( 0)) S ORLS T(0)=1 | |
| 343 | Q | |
| 344 | ||
| 345 | ORCLOC (Ne w) | |
| 346 | ORCLOC ;SLC/GRE - General U tilities f or Windows Calls ; 2 2 Sep 2016 1:22 PM | |
| 347 | ; ;3.0;ORDER ENTRY/RES ULTS REPOR TING;**431 **;Aug 7, 2002;Build 5 | |
| 348 | Q | |
| 349 | ; | |
| 350 | NEWLOC(Y,O RFROM,DIR, ORCTYP) ; Return "CZ " location s from HOS PITAL LOCA TION file. | |
| 351 | ; C=Clinics , W=Wards, Z=Other, screened b y $$ACTLOC ^ORWU. | |
| 352 | ; .Y=return ed list, O RFROM=text to $O fro m, DIR=$O direction. | |
| 353 | N %Y,ORC,OR CI,ORCIEN, ORCDUP S O RCI=0 | |
| 354 | D ; ONCE F OR PERSONA L LIST | |
| 355 | . Q:ORFROM'= "" | |
| 356 | . N ORCIEN,O RCCNT S OR CCNT=44 | |
| 357 | . S ORC=0 F S ORC=$O (^VA(200,D UZ,"DELOC" ,ORC)) Q:' +ORC!(ORC' <ORCCNT) | |
| 358 | D | |
| 359 | . . S ORCIE N=$P($G(^V A(200,DUZ, "DELOC",OR C,0)),"^", 1) Q:'ORCI EN | |
| 360 | . . Q:("CWZ "'[$$GET1^ DIQ(44,ORC IEN,2,"I") !('$$ACTLO C^ORWU(ORC IEN))) | |
| 361 | . . S ORCI= ORCI+1,Y(O RCI)=ORCIE N_"^ "_$$G ET1^DIQ(44 ,ORCIEN,.0 1) | |
| 362 | . . S ORCDU P(ORCIEN)= "" | |
| 363 | D ; DAY-OF -WEEK CLIN IC | |
| 364 | . Q:ORFROM'= "" | |
| 365 | . N ORCENT, ORCPAR,X,O RCDOW,ORCD OWC | |
| 366 | . S ORCENT= "USR.`"_DU Z | |
| 367 | . S X=DT D DW^%DTC S ORCDOW=X | |
| 368 | . S ORCPAR= "ORLP DEFA ULT CLINIC "_ORCDOW | |
| 369 | . S ORCDOWC =$$GET^XPA R(ORCENT,O RCPAR) | |
| 370 | . I +ORCDOW C D ; | |
| 371 | . . Q:("CWZ" '[$$GET1^D IQ(44,ORCD OWC,2,"I") !('$$ACTLO C^ORWU(ORC DOWC))) | |
| 372 | . . Q:$D(ORC DUP(ORCDOW C)) | |
| 373 | . . S ORCDUP (ORCDOWC)= "" | |
| 374 | . . S ORCI=O RCI+1,Y(OR CI)=ORCDOW C_"^ "_$$G ET1^DIQ(44 ,ORCDOWC,. 01) | |
| 375 | D ;TIU PRE FERENCES D EFAULT LOC ATION | |
| 376 | . Q:ORFROM' ="" | |
| 377 | . N ORCTIU1 ,ORCTIU2 | |
| 378 | . Q:'$D(^TI U(8926,"B" ,DUZ)) | |
| 379 | . S ORCTIU1 =$O(^TIU(8 926,"B",DU Z,0)) Q:'+ ORCTIU1 | |
| 380 | . S ORCTIU2 =$$GET1^DI Q(8926,ORC TIU1,.02," I") Q:'+OR CTIU2 | |
| 381 | . Q:("CWZ"' [$$GET1^DI Q(44,ORCTI U2,2,"I")! ('$$ACTLOC ^ORWU(ORCT IU2))) | |
| 382 | . Q:$D(ORCD UP(ORCTIU2 )) | |
| 383 | . S ORCDUP( ORCTIU2)=" " | |
| 384 | . S ORCI=OR CI+1,Y(ORC I)=ORCTIU2 _"^ "_$$GE T1^DIQ(44, ORCTIU2,.0 1) | |
| 385 | D ;TIU DAY OF WEEK L OCATION | |
| 386 | . Q:ORFROM' ="" | |
| 387 | . N ORCTIU1 ,ORCTIU2,O RCTIU3,ORC DOW,X | |
| 388 | . S X=DT D H^%DTC S O RCDOW=%Y+1 | |
| 389 | . Q:'$D(^TI U(8926,"B" ,DUZ)) | |
| 390 | . S ORCTIU1 =$O(^TIU(8 926,"B",DU Z,0)) Q:'+ ORCTIU1 | |
| 391 | . Q:'$D(^TI U(8926,ORC TIU1,1,"B" ,ORCDOW)) | |
| 392 | . S ORCTIU2 =$O(^TIU(8 926,ORCTIU 1,1,"B",OR CDOW,0)) Q :'+ORCTIU2 | |
| 393 | . S ORCTIU3 =$P(^TIU(8 926,ORCTIU 1,1,ORCTIU 2,0),"^",2 ) Q:'+ORCT IU3 | |
| 394 | . Q:("CWZ"' [$$GET1^DI Q(44,ORCTI U3,2,"I")! ('$$ACTLOC ^ORWU(ORCT IU3))) | |
| 395 | . Q:$D(ORCD UP(ORCTIU3 )) | |
| 396 | . S ORCDUP( ORCTIU3)=" " | |
| 397 | . S ORCI=OR CI+1,Y(ORC I)=ORCTIU3 _"^ "_$$GE T1^DIQ(44, ORCTIU3,.0 1) | |
| 398 | D ;Re-sort into alph abetical o rder | |
| 399 | . N ORCJ,OR CDFE,ORCHO LD,ORCDFEI EN,ORCDFEN AME,ORCJ2 | |
| 400 | . S ORCJ=0 F S ORCJ= $O(Y(ORCJ) ) Q:'+ORCJ D | |
| 401 | . . S ORCDFE =$G(Y(ORCJ )),ORCDFEI EN=$P(ORCD FE,U),ORCD FENAME=$P( ORCDFE,U,2 | |
| 402 | ) | |
| 403 | . . S ORCHOL D(ORCDFENA ME,ORCJ,OR CDFEIEN)=" " | |
| 404 | . S ORCJ2=0 | |
| 405 | . S ORCDFEN AME="" F S ORCDFENA ME=$O(ORCH OLD(ORCDFE NAME)) Q:O RCDFENAME' | |
| 406 | ]"" D | |
| 407 | . . S ORCJ=0 F S ORCJ =$O(ORCHOL D(ORCDFENA ME,ORCJ)) Q:'+ORCJ D | |
| 408 | . .. S ORCDF EIEN=0 F S ORCDFEIE N=$O(ORCHO LD(ORCDFEN AME,ORCJ,O RCDFEIEN)) | |
| 409 | Q:'+ORCDF EIEN D | |
| 410 | . ... S ORCJ 2=ORCJ2+1 S Y(ORCJ2) =ORCDFEIEN _U_ORCDFEN AME | |
| 411 | D ; SECOND TIME FOR REGULAR LI ST | |
| 412 | . I $G(ORCTY P)']"" S O RCTYP="C" | |
| 413 | . N ORCIEN,O RCCNT S OR CCNT=44 | |
| 414 | . F Q:ORCI' <ORCCNT S ORFROM=$O (^SC("B",O RFROM),DIR ) Q:ORFROM ="" D | |
| 415 | . . S ORCIEN ="" F S O RCIEN=$O(^ SC("B",ORF ROM,ORCIEN ),DIR) Q:' ORCIEN D | |
| 416 | . .. Q:(ORCT YP'[$$GET1 ^DIQ(44,OR CIEN,2,"I" )!('$$ACTL OC^ORWU(OR CIEN))) | |
| 417 | . .. S ORCI= ORCI+1,Y(O RCI)=ORCIE N_"^"_ORFR OM | |
| 418 | Q | |
| 419 | ; | |
| 420 | FILEDIC(OR CDIC,ORCDI C0,ORCDICA ,ORCDICB) ; Basic s hell for D IC lookups | |
| 421 | N X,Y,DTOUT ,DUOUT,DIC | |
| 422 | S DIC=ORCDI C,DIC(0)=O RCDIC0 S:$ G(ORCDICA) ]"" DIC("A ")=ORCDICA S:$G(ORCD | |
| 423 | ICB)]"" DI C("B")=ORC DICB | |
| 424 | D ^DIC K DI C | |
| 425 | S :Y>0 ORCFI LES=+Y | |
| 426 | Q | |
| 427 | ; | |
| 428 | PARAM N ORCDUZ S ORCDUZ=DUZ | |
| 429 | P2 N DIC,DIE,D R,DA,ILOC, ORC,ORCNON E | |
| 430 | W @IOF | |
| 431 | W !,"Now se tting pref erences fo r default HOSPITAL L OCATIONS f or:" | |
| 432 | W !?5,"--> ",$$GET1^ DIQ(200,OR CDUZ,.01) | |
| 433 | W !,"Curren tly select ed locatio ns are:" | |
| 434 | S ILOC=0 F S ILOC=$O (^VA(200,O RCDUZ,"DEL OC",ILOC)) Q:'+ILOC D | |
| 435 | . S ORCLOC= $P(^VA(200 ,ORCDUZ,"D ELOC",ILOC ,0),"^") | |
| 436 | . W !?5,$$G ET1^DIQ(44 ,ORCLOC,.0 1) | |
| 437 | . S ORCNONE =1 | |
| 438 | I '$G(ORCNO NE) W !?5, "None sele cted..." | |
| 439 | W ! | |
| 440 | P3 W ! | |
| 441 | S DIC="^VA( 200,ORCDUZ ,""DELOC"" ," | |
| 442 | S DIC(0)="A EMQL" | |
| 443 | S (DIC(1),D A(1))=ORCD UZ | |
| 444 | D ^DIC | |
| 445 | Q :Y=-1 | |
| 446 | S DIE=DIC K DIC | |
| 447 | S DA(1)=ORC DUZ | |
| 448 | S DA=+Y | |
| 449 | S DR=.01 | |
| 450 | D ^DIE | |
| 451 | K DIE,DR,DA ,Y | |
| 452 | G P3 | |
| 453 | ; | |
| 454 | OTHER N ORCDUZ | |
| 455 | N DIC S DIC =200,DIC(0 )="AEMQ" D ^DIC K DI C Q:+Y<1 S ORCDUZ=+ Y | |
| 456 | D P2 | |
| 457 | W !! G OTHE R | |
| 458 | OTHQU Q | |
| 459 | ; | |
| 460 | ORCP031 (N ew) | |
| 461 | ORCP031 ; EPIP/WLC - Patch 31 Post-insta ll; 12 Sep 2016 ; 15 Sep 2016 9:37 AM | |
| 462 | ; ;3.0;ORDER ENTRY/RES ULTS REPOR TING;**431 **;Sep 12, 2016 | |
| 463 | ; | |
| 464 | Q | |
| 465 | ; | |
| 466 | POST ; -- post i nstallatio n for OR*3 .0*431 | |
| 467 | D OPADD | |
| 468 | Q | |
| 469 | ; | |
| 470 | OPADD ; add OR PC E options to Menus i n OPTION f ile #19 | |
| 471 | D BMES^XPDU TL("Adding OR PCE op tions to m enus in OP TION file #19") | |
| 472 | ; | |
| 473 | N ORCOPT,ER R | |
| 474 | S ORCOPT=$$ FIND1^DIC( 19,,"AMX", "OR PCE DE FAULT LOCA TION") | |
| 475 | I ORCOPT D | |
| 476 | . N DA | |
| 477 | . N FDA,IEN S,X,Y | |
| 478 | . S X=$O(^D IC(19,"B", "ORPO MENU ",0)) | |
| 479 | . I $D(^DIC (19,X,10," B",ORCOPT) ) Q | |
| 480 | . S Y="?+1, " | |
| 481 | . S IENS=X_ "," | |
| 482 | . N REC S R EC=$P($G(^ DIC(19,X,1 0,0)),U,3) +1 | |
| 483 | . S FDA(19. 01,"+"_REC _","_X_"," ,.01)=ORCO PT | |
| 484 | . S FDA(19. 01,"+"_REC _","_X_"," ,2)="DL" | |
| 485 | . D UPDATE^ DIE("","FD A",,.ERR) | |
| 486 | . I $D(ERR) D BMES^XP DUTL("Erro r in addin g to ORPO MENU") | |
| 487 | K ORCOPT ; Add entry for Clinic al Coordin ator | |
| 488 | S ORCOPT=$$ FIND1^DIC( 19,,"AMX", "OR PCE DE FAULT LOC ADMIN") | |
| 489 | I ORCOPT D | |
| 490 | . N DA | |
| 491 | . N FDA,IEN S,X,Y | |
| 492 | . S X=$O(^D IC(19,"B", "OR PARAM COORDINATO R MENU",0) ) | |
| 493 | . I $D(^DIC (19,X,10," B",ORCOPT) ) Q | |
| 494 | . S Y="?+1, " | |
| 495 | . S IENS=X_ "," | |
| 496 | . N REC S R EC=$P($G(^ DIC(19,X,1 0,0)),U,3) +1 | |
| 497 | . S FDA(19. 01,"+"_REC _","_X_"," ,.01)=ORCO PT | |
| 498 | . S FDA(19. 01,"+"_REC _","_X_"," ,2)="DL" | |
| 499 | . D UPDATE^ DIE("","FD A",,.ERR) | |
| 500 | . I $D(ERR) D BMES^XP DUTL("Erro r in addin g to OR PA RAM COORDI NATOR MENU ") | |
| 501 | Q | |
| 502 | ; | |
| 503 | ORPO7GUI ( New) | |
| 504 | ORPO7GUI ; HINES/RMS, REGION 1/ KLD/RMM - CPRS CHART FLAGGING FOR GUI ; 6-1-01; 1/ 27/12 3:4 0 PM | |
| 505 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;7/30/ 2012;Build 9 | |
| 506 | ;IA 10076 XUSEC | |
| 507 | ;IA 2324 | |
| 508 | ;CHANGE T HE VALUE F OR THE ORW OR AUTO CL OSE PT MSG (SYSTEM) PARAMETER TO ADJUST THE LENGTH OF TIME T HE WINDOW IS OPEN 0= INDEFINITE | |
| 509 | ;called f rom ORPOPA GU,WHICH I S CALLED F ROM ORWPT | |
| 510 | HXDATA(LST ,DFN) ;ENT RY POINT F ROM ORWPT | |
| 511 | EN ;FORMER ENTRY POI NT FROM A7 RDPAGU | |
| 512 | N ORPOTI, ORPOQUIT,I LST S ILST =0 | |
| 513 | F ORPOTI( "I")=0:0 S ORPOTI("I ")=$O(^OR( 100.007,OR POTI("I")) ) Q:'ORPOT I("I") D | |
| 514 | .Q:$$GET1 ^DIQ(100.0 07,ORPOTI( "I"),1)'=" YES" ;Act ive | |
| 515 | .K ORPOQU IT ;S ILST =0 | |
| 516 | .F ORPOTI ("II")=0:0 S ORPOTI( "II")=$O(^ OR(100.007 ,ORPOTI("I "),2,ORPOT I("II"))) Q:'ORPOTI( "II")!($D( ORPOQUIT)) D | |
| 517 | ..X ^OR(1 00.007,ORP OTI("I"),2 ,ORPOTI("I I"),0) | |
| 518 | Q | |
| 519 | ; | |
| 520 | INC S ILST =$G(ILST)+ 1 | |
| 521 | Q | |
| 522 | ;LST USED BY CPRS G UI SOFTWAR E | |
| 523 | NULL S LST (ILST)=" " | |
| 524 | Q | |
| 525 | FL(ORPODFN ,ORPOFL) ; CHECK IF P ATIENT HAS FLAG | |
| 526 | ;ORPODFN= PATIENT DF N | |
| 527 | ;ORPOFL=F LAG YOU AR E LOOKING FOR | |
| 528 | N ORPOI,O RPOR S ORP OR=0 | |
| 529 | F ORPOI=0 :0 S ORPOI =$O(^OR(10 0.0071,ORP ODFN,1,ORP OI)) Q:'OR POI D | |
| 530 | .S:$$GET1 ^DIQ(100.0 0711,ORPOI _","_ORPOD FN,.01)=OR POFL ORPOR =1 | |
| 531 | Q ORPOR | |
| 532 | ADDT(X1,X2 ) ;ADD/SUB TRACT FROM DATE | |
| 533 | N X D C^% DTC | |
| 534 | Q X | |
| 535 | FDT(Y) ;FO RMAT INTER NAL TO EXT ERNAL DATE | |
| 536 | D DD^%DT | |
| 537 | Q Y | |
| 538 | TXT ; PRIN T TEXT | |
| 539 | N ORPOI D INC,NULL | |
| 540 | F ORPOI=0 :0:3 S ORP OI=$O(^OR( 100.007,OR POTI("I"), 3,ORPOI)) Q:'ORPOI D | |
| 541 | .D INC S LST(ILST)= ^OR(100.00 7,ORPOTI(" I"),3,ORPO I,0) | |
| 542 | .D:LST(IL ST)["|" VA R(LST(ILST )) | |
| 543 | Q | |
| 544 | VAR(ORPO) ;REMOVE ~ PRINT VARI ABLE | |
| 545 | N ORPOI,O RPOT,ORPOV AR | |
| 546 | F ORPOI=0 :0 S ORPOT =$F(ORPO," |") Q:'ORP OT D | |
| 547 | .S ORPOVA R=$P(ORPO, "|",2),ORP O=$P(ORPO, "|")_@ORPO VAR_$P(ORP O,"|",3,20 0) | |
| 548 | S LST(ILS T)=ORPO | |
| 549 | Q | |
| 550 | GFY(ORPODT ) ; GET FI SCAL YEAR | |
| 551 | N ORPOMO, ORPOYR | |
| 552 | S ORPOMO= $E(ORPODT, 4,5),ORPOY R=$E(ORPOD T,1,3) | |
| 553 | S ORPOYR= $S(ORPOMO> 9:ORPOYR+1 ,1:ORPOYR) | |
| 554 | S ORPOYR= $S($E(ORPO YR)=2:19_$ E(ORPOYR,2 ,3),$E(ORP OYR)=3:20_ $E(ORPOYR, 2,3),$E(OR POYR)=4:21 _$E(ORPOYR ,2,3),1:00 00) | |
| 555 | Q ORPOYR | |
| 556 | FLAGOK(TYP E) ;RMS/HI NES 3-3-04 TO CONTRO L NUMBER O F FLAG VIE WS PER DAY | |
| 557 | N ORPOFDA T,X,X1,X2 | |
| 558 | S X1=DT,X 2=+1 D C^% DTC S ORPO FDAT=X | |
| 559 | S ^XTMP(" ORPOFLAG"_ DT,0)=ORPO FDAT_U_DT_ U_"Pop-Up Flag Daily Usage Dat a" | |
| 560 | Q $G(^XTM P("ORPOFLA G"_DT,TYPE ,DUZ,+$G(D FN))) | |
| 561 | USER(ORPOD UZ) Q:$$I SA^USRLM(O RPODUZ,"PH YSICIAN",. ORPOERR) 1 | |
| 562 | Q:$$ISA^U SRLM(ORPOD UZ,"PHYSIC IAN ASSIST ANT",.ORPO ERR) 1 | |
| 563 | Q:$$ISA^U SRLM(ORPOD UZ,"NURSE PRACTITION ER",.ORPOE RR) 1 | |
| 564 | Q:$$ISA^U SRLM(ORPOD UZ,"MEDICA L STUDENT" ,.ORPOERR) 1 | |
| 565 | Q:$D(^XUS EC("ORES", ORPODUZ)) 1 | |
| 566 | Q 0 | |
| 567 | ; | |
| 568 | ORPOCHF (N ew) | |
| 569 | ORPOCHF ;R 01/RMM - P op-Up for Congestive heart fai lure in CP RS ;12/4/2 013 | |
| 570 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 9 | |
| 571 | ;find pat ients disc harged wit hin 30 day s with a p rimary dia gnosis of CHF icd 9 code of 42 8.x | |
| 572 | ;when icd 10 is rel eased this will have to be cha nged | |
| 573 | ;359 NAME : DBIA359 | |
| 574 | Q ;QUIT IF NOT ENT RY POINT | |
| 575 | EN(ORPODFN ) ;ENTRY P OINT, PATI ENT DFN | |
| 576 | N ORPOI,O RPOSDT,ORP ORET S ORP ORET=0 K ^ TMP("DILIS T",$J) | |
| 577 | S ORPOSDT =$$ADDT(DT ,-30) | |
| 578 | D FIND^DI C(45,,"@;. 01I;79;70I ","Q",ORPO DFN,,"B") ;PTF FILE | |
| 579 | F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI)) Q:'ORPOI D | |
| 580 | .Q:^TMP(" DILIST",$J ,"ID",ORPO I,70)']"" | |
| 581 | .Q:^TMP(" DILIST",$J ,"ID",ORPO I,70)<ORPO SDT | |
| 582 | .Q:^TMP(" DILIST",$J ,"ID",ORPO I,79)'["42 8." | |
| 583 | .S ORPORE T=1 | |
| 584 | Q ORPORET | |
| 585 | ADDT(X1,X2 ) ;ADD/SUB TRACT FROM DATE | |
| 586 | N X D C^% DTC | |
| 587 | Q X | |
| 588 | ORPOMDRO ( New) | |
| 589 | ORPOMDRO ; R01/RMM - POP-Up FOR MRSA/MDRO in CPRS ; 4/8/2013 | |
| 590 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 9 | |
| 591 | ;could no t find an ICA for fi le 104.1 | |
| 592 | ; | |
| 593 | EN(DFN) ;E NTRY POINT | |
| 594 | N ORPOI,O RPOII,ORPO TEST,ORPO, ORPOA,ORPO RET,ORPOIN D,ORPORES, ORPOF,ORPO VAL,ORPOII I,ORPOD0 S ORPORET=0 ,ORPOF=0 | |
| 595 | D LIST^DI C(104.1,," @;.01IE"," Q",,,,"B") ;MRSA TOO LS LAB SEA RCH/EXTRAC T FILE | |
| 596 | F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI)) Q:'ORPOI! (ORPORET=1 ) D | |
| 597 | .S ORPOD0 =^TMP("DIL IST",$J,2, ORPOI) | |
| 598 | .D LIST^D IC(104.15, ","_ORPOD0 _",","@;.0 1IE;1;2"," Q",,,,"B", ,,"ORPO") | |
| 599 | .K ORPOA S ORPOF=0 | |
| 600 | .F ORPOII =0:0 S ORP OII=$O(ORP O("DILIST" ,2,ORPOII) ) Q:'ORPOI I!(ORPORET =1) D | |
| 601 | ..S ORPOR ET=$$FTEST (ORPO("DIL IST","ID", ORPOII,.01 ,"I")) | |
| 602 | ..Q:ORPOR ET=1 | |
| 603 | ..S ORPOI ND=ORPO("D ILIST","ID ",ORPOII,1 ) | |
| 604 | ..S:ORPOI ND="Contai ns" ORPOIN D="[",ORPO F=1 S:ORPO IND="Great er Than" O RPOIND=">" ,ORPOF=1 | |
| 605 | ..S:ORPOI ND="Less T han" ORPOI ND="<",ORP OF=1 S:ORP OIND="Equa l To" ORPO IND="=",OR POF=1 | |
| 606 | ..Q:ORPOF =0 | |
| 607 | ..S ORPOD 1=ORPO("DI LIST",2,OR POII),ORPO TEST=ORPO( "DILIST"," ID",ORPOII ,.01,"I") | |
| 608 | ..Q:$$GET 1^DIQ(60,O RPOTEST,40 0)="" | |
| 609 | ..S ORPO= $$ONE^ORPO TIO($$GET1 ^DIQ(60,OR POTEST,400 )_"^100^1Y ") | |
| 610 | ..F ORPOI II=0:0 S O RPOIII=$O( ^TMP("ORPO TIOB2",$J, ORPOIII)) Q:'ORPOIII D | |
| 611 | ...S ORPO RES=""""_$ P(^TMP("OR POTIOB2",$ J,ORPOIII, 0),"@",2)_ """" | |
| 612 | ...S ORPO VAL=""""_O RPO("DILIS T","ID",OR POII,2)_"" "" | |
| 613 | ...Q:ORPO RES="""""" | |
| 614 | ...Q:ORPO VAL="""""" | |
| 615 | ...S ORPO RES=$TR(OR PORES,"abc defghijklm nopqrstuvw xyz","ABCD EFGHIJKLNM OPQRSTUVWX YZ") | |
| 616 | ...S ORPO VAL=$TR(OR POVAL,"abc defghijklm nopqrstuvw xyz","ABCD EFGHIJKLNM OPQRSTUVWX YZ") | |
| 617 | ...I @(OR PORES_ORPO IND_ORPOVA L) S ORPOR ET=1 ;"*** * MDRO PRE CAUTIONS * ***" | |
| 618 | W !,"EN: ",ORPORET | |
| 619 | Q ORPORET | |
| 620 | FTEST(ORPO T) ; FIND MICROBIOLO GY TEST | |
| 621 | N ORPOLRD FN,ORPOI,O RPOII,ORPO ET,R2,R3,O RPOAS,ORPO D1,ORPORET S ORPORET =0 | |
| 622 | D LIST^DI C(104.109, ","_ORPOD0 _",","@;.0 1IE;","Q", ,,,"B",,," R2") ;ETI OLOGY MULT IPLE | |
| 623 | F ORPOI=0 :0 S ORPOI =$O(R2("DI LIST",2,OR POI)) Q:'O RPOI D | |
| 624 | .K ORPOET S ORPOET= R2("DILIST ","ID",ORP OI,.01,"I" ),ORPOD1=R 2("DILIST" ,2,ORPOI) | |
| 625 | .D LIST^D IC(104.191 ,","_ORPOD 1_","_ORPO D0_",","@; .01;1;2"," Q",,,,"B", ,,"R3") ; ANTIMICROB IAL SUSCEP TIBILITY M ULTIPLE | |
| 626 | .F ORPOII =0:0 S ORP OII=$O(R3( "DILIST",2 ,ORPOII)) Q:'ORPOII! (ORPORET=1 ) D | |
| 627 | ..S ORPOE T=R2("DILI ST","ID",O RPOI,.01," I")_U_R3(" DILIST","I D",ORPOII, .01)_U_R3( "DILIST"," ID",ORPOII ,2) | |
| 628 | ..S:R3("D ILIST","ID ",ORPOII,1 )="Contain s" ORPOET= ORPOET_U_" [" | |
| 629 | ..S:R3("D ILIST","ID ",ORPOII,1 )="Greater Than" ORP OET=ORPOET _U_">" | |
| 630 | ..S:R3("D ILIST","ID ",ORPOII,1 )="Less Th an" ORPOET =ORPOET_U_ "<" | |
| 631 | ..S:R3("D ILIST","ID ",ORPOII,1 )="Equal T o" ORPOET= ORPOET_U_" =" | |
| 632 | ..S ORPOR ET=$$GORG( ORPOET) Q: ORPORET=1 | |
| 633 | ..S ORPOR ET=$$GMYC( ORPOET) Q: ORPORET=1 | |
| 634 | W !,"FORG : ",ORPORE T | |
| 635 | Q ORPORET | |
| 636 | GORG(ORPOE ) ;GET ORG ANISM | |
| 637 | N ORPOLRD FN,ORPOBDT ,ORPOEDT,O RPOBRDT,OR POERDT,ORP OI,ORPOD1, ORPOD2,ORP OD,ORPORET | |
| 638 | S ORPOLRD FN=$$LRDFN ^LRPXAPIU( DFN),ORPOR ET=0 | |
| 639 | S ORPOBDT =$$ADDT(DT ,-365),ORP OEDT=DT | |
| 640 | S ORPOBRD T=9999999- ORPOBDT,OR POERDT=999 9999-ORPOE DT | |
| 641 | F ORPOD1= ORPOERDT:0 :(ORPOBRDT _.9999) S ORPOD1=$O( ^LR(ORPOLR DFN,"MI",O RPOD1)) Q: 'ORPOD1 D ;LAB DAT A FILE MIC ROBIOLOGY MULTIPLE | |
| 642 | .F ORPOD2 =0:0 S ORP OD2=$O(^LR (ORPOLRDFN ,"MI",ORPO D1,3,ORPOD 2)) Q:'ORP OD2 D | |
| 643 | ..D:$P(OR POE,U)=$P( ^LR(ORPOLR DFN,"MI",O RPOD1,3,OR POD2,0),U) | |
| 644 | ...S ORPO D=0,ORPOD= $O(^DD(63. 3,"B",$P(O RPOE,U,2), ORPOD)) | |
| 645 | ...I @("" ""_$P(ORPO E,U,3)_""" "_$P(ORPOE ,U,4)_"""" _$$GET1^DI Q(63.3,ORP OD2_","_OR POD1_","_O RPOLRDFN,O RPOD)_"""" ) S ORPORE T=1 | |
| 646 | W !,"GORG : ",ORPORE T | |
| 647 | Q ORPORET | |
| 648 | GMYC(ORPOE ) ;GET MYC OBACTERIUM ;^LR(D0 ,MI,D1,12, D2,0)= (#. 01) MYCOBA CTERIUM [1 P:61.2] ^ (#1) QUANT ITY [2F] ^ | |
| 649 | N ORPOLRD FN,ORPOBDT ,ORPOEDT,O RPOBRDT,OR POERDT,ORP OI,ORPOD1, ORPOD2,ORP OD,ORPORET | |
| 650 | S ORPOLRD FN=$$LRDFN ^LRPXAPIU( DFN),ORPOR ET=0 | |
| 651 | S ORPOBDT =$$ADDT(DT ,-365),ORP OEDT=DT | |
| 652 | S ORPOBRD T=9999999- ORPOBDT,OR POERDT=999 9999-ORPOE DT | |
| 653 | F ORPOD1= ORPOERDT:0 :(ORPOBRDT _.9999) S ORPOD1=$O( ^LR(ORPOLR DFN,"MI",O RPOD1)) Q: 'ORPOD1 D ;LAB DAT A FILE MIC ROBIOLOGY MULTIPLE | |
| 654 | .F ORPOD2 =0:0 S ORP OD2=$O(^LR (ORPOLRDFN ,"MI",ORPO D1,12,ORPO D2)) Q:'OR POD2 D | |
| 655 | ..D:$P(OR POE,U)=$P( ^LR(ORPOLR DFN,"MI",O RPOD1,12,O RPOD2,0),U ) | |
| 656 | ...S ORPO D=0,ORPOD= $O(^DD(63. 39,"B",$P( ORPOE,U,2) ,ORPOD)) | |
| 657 | ...I @("" ""_$P(ORPO E,U,3)_""" "_$P(ORPOE ,U,4)_"""" _$$GET1^DI Q(63.39,OR POD2_","_O RPOD1_","_ ORPOLRDFN, ORPOD)_""" ") S ORPOR ET=1 | |
| 658 | W !,"GMYC : ",ORPORE T | |
| 659 | Q ORPORET | |
| 660 | ADDT(X1,X2 ) ;ADD/SUB TRACT FROM DATE | |
| 661 | N X D C^% DTC | |
| 662 | Q X | |
| 663 | ORPOOBS (N ew) | |
| 664 | ORPOOBS ;R 01/HAM3,RM M - Pop-Up for OBSER VATION in CPRS ;07/3 0/2012 | |
| 665 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;7/30/ 2012;Build 9 | |
| 666 | ; | |
| 667 | GETADMFM(D FN) ; GET THE FILEMA N FORMAT O F THE ADMI SSION DATE | |
| 668 | N VAIN | |
| 669 | D INP^VAD PT | |
| 670 | Q +VAIN(7 ) | |
| 671 | GMT(ORPOMX ) ;GET MAX TIME FROM TEXT FIEL D | |
| 672 | N ORPOI | |
| 673 | F ORPOI=0 :0 S ORPOI =$O(^OR(10 0.007,ORPO TI("I"),3, ORPOI)) Q: 'ORPOI D | |
| 674 | .S:^OR(10 0.007,ORPO TI("I"),3, ORPOI,0)[" MAX TIME" ORPOMX=$P( ^OR(100.00 7,ORPOTI(" I"),3,ORPO I,0),"=",2 ) | |
| 675 | Q | |
| 676 | GETDHSD(OR POFMDT) ; GET THE DE CIMAL TIME SINCE A F ILEMAN DAT E, ROUNDS SECONDS UP 15.331 = 15.34 | |
| 677 | Q $FN($$F MDIFF^XLFD T($$NOW^XL FDT,ORPOFM DT,2)/3600 ,"",2) | |
| 678 | GETTMLFT(O RPODATE,OR POMAXT) ; get the ti me left | |
| 679 | N ORPOTIM E | |
| 680 | S ORPOTIM E=$FN($$FM DIFF^XLFDT ($$NOW^XLF DT,ORPODAT E,2)/3600, "",2) | |
| 681 | Q $$GETTX T3(ORPOTIM E,ORPOMAXT ) | |
| 682 | GETTEXT(LS T,DFN) ; G ENERATE TH E LST ARRA Y TO BE US ED BASED O N THE ADMI T DATE | |
| 683 | N ORPOADT ,ORPOMXT,O RPOOB,ORPO TM S ORPOM XT=0 | |
| 684 | D INC^ORP O7GUI,NULL ^ORPO7GUI | |
| 685 | ; | |
| 686 | ;change f or directi ve 1036 | |
| 687 | ;S ORPOMX T=23+(59/6 0) ; MAX HOURS AND 59 MINUTES ; MAX A LLOWED TIM E | |
| 688 | D GMT(.OR POMXT) ;GE T MAX TIME FROM TEXT FIELD | |
| 689 | S:ORPOMXT =0 ORPOMXT =48 ;IF MA X TIME NOT DEFINED I N TEXT FIE LD SET TO 48 HRS | |
| 690 | S ORPOMXT =(ORPOMXT- 1)+(59/60) ; MAX HO URS AND 59 MINUTES ; MAX ALL OWED TIME | |
| 691 | ; | |
| 692 | S ORPOADT =$$GETADMF M(DFN) ;GE T ADMIT DA TETIME | |
| 693 | D GETTXT2 (.LST,ORPO ADT,ORPOMX T) | |
| 694 | Q | |
| 695 | GETTXT2(LS T,ORPOADT, ORPOMXT) ; | |
| 696 | N ORPOADT X,ORPOOB,O RPOTM | |
| 697 | S ORPOADT X=$$FMTE^X LFDT(ORPOA DT) | |
| 698 | S ORPOOB= $$GETTMLFT (ORPOADT,O RPOMXT) ;G ET TIME LE FT | |
| 699 | S ORPOTM= $$GETDHSD( ORPOADT) ; get decima l time | |
| 700 | I ORPOOB[ "EXCEEDED" D | |
| 701 | .D INC^OR PO7GUI S L ST(ILST)=" DISCHARGE OR CHANGE OBSERVATIO N TO INPT STATUS NOW !" | |
| 702 | .D INC^OR PO7GUI S L ST(ILST)=O RPOOB | |
| 703 | .D INC^OR PO7GUI S L ST(ILST)=" Observatio n admit wa s at: "_OR POADTX | |
| 704 | E D | |
| 705 | .; | |
| 706 | .;change for direct ive 1036 | |
| 707 | .;I ORPOT M>=23 D | |
| 708 | .I ORPOTM >=$P(ORPOM XT,".") D | |
| 709 | ..; | |
| 710 | ..;D INC^ ORPO7GUI S LST(ILST) ="23hr OBS ERVATION P ERIOD IS O VER!!" | |
| 711 | ..D INC^O RPO7GUI S LST(ILST)= $P(ORPOMXT ,".")_"th HOUR OF OB SERVATION IS OVER!" | |
| 712 | ..D INC^O RPO7GUI S LST(ILST)= "DISCHARGE OR CHANGE OBSERVATI ON TO INPT STATUS NO W!" | |
| 713 | ..D INC^O RPO7GUI S LST(ILST)= ORPOOB | |
| 714 | .E D | |
| 715 | ..D INC^O RPO7GUI S LST(ILST)= "OBSERVATI ON ADMIT A T: "_ORPOA DTX | |
| 716 | ..; | |
| 717 | ..;change for direc tive 1036 | |
| 718 | ..;I ORPO TM>=20 D | |
| 719 | ..I ORPOT M>=($P(ORP OMXT,".")- 3) D | |
| 720 | ...; | |
| 721 | ...D INC^ ORPO7GUI S LST(ILST) ="MAKE PLA NS FOR DIS CHARGE OR FULL ADMIT ." | |
| 722 | ...D INC^ ORPO7GUI S LST(ILST) =ORPOOB | |
| 723 | ..E D | |
| 724 | ...I ORPO TM>0 D | |
| 725 | ....D INC ^ORPO7GUI S LST(ILST )=ORPOOB | |
| 726 | Q | |
| 727 | GETTXT3(OR PODECTIME, ORPOMAXTIM E) ; | |
| 728 | N ORPODIF F,ORPOHRS, ORPOMINS,O RPORESULT | |
| 729 | S ORPORES ULT="" | |
| 730 | S ORPODIF F=+$FN(ORP OMAXTIME-O RPODECTIME ,"",2) | |
| 731 | S ORPOHRS =+$P(ORPOD IFF,".",1) | |
| 732 | S ORPOMIN S=$FN((ORP ODIFF-ORPO HRS)*60,"" ,0) | |
| 733 | I ORPODIF F>0 S ORPO RESULT="Di scharge or admit wit hin: "_ORP OHRS_" hou r"_$S(ORPO HRS=1:"",1 :"s")_" an d "_ORPOMI NS_" minut e"_$S(ORPO MI | |
| 734 | NS=1:"",1: "s") | |
| 735 | I ORPODIF F=0 S ORPO RESULT="Di scharge or admit wit hin: "_ORP OHRS_" hou r"_$S(ORPO HRS=1:"",1 :"s")_" an d "_ORPOMI NS_" minut e"_$S(ORPO MI | |
| 736 | NS=1:"",1: "s") | |
| 737 | I ORPODIF F<0 S ORPO RESULT="OB SERVATION EXCEEDED b y: "_-ORPO HRS_" hour "_$S(ORPOH RS=-1:"",1 :"s")_" an d "_-ORPOM INS_" minu te"_$S(ORP OM | |
| 738 | INS=-1:"", 1:"s") | |
| 739 | Q ORPORES ULT | |
| 740 | ; | |
| 741 | ORPOTIO (N ew) | |
| 742 | ORPOTIO ; PHOENIX/KL D - Pop-Up for TIU O BJECTS - L AB TESTS & PANELS (T RENDS) in CPRS ; 5/2 5/12 3:13 PM | |
| 743 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 1 | |
| 744 | ;;IAs use d - 4245, 4246 | |
| 745 | ST Q | |
| 746 | ; | |
| 747 | PANEL(X) ; Panel Lab Test in a time perio d object ( time=nM, n D, or nY) | |
| 748 | ;X should be "Displ ay name^# of occuran ces^time p eriod^prin t a second line? (0 or 1)^Test IENS from file 63.0 4" | |
| 749 | ;Example: X="Chem 7 ^3^2Y^1^2, 3,4:1:8,79 0" | |
| 750 | N ORPOTI S ORPOTI(" C")=0,$P(O RPOTI("SP" )," ",30)= "" | |
| 751 | S ORPOTI( "TN")=$P(X ,U,1,2),OR POTI("T")= $P(X,U,3), ORPOTI("LI NE2")=$P(X ,U,4),ORPO TI("TEST") =$P(X,U,5) | |
| 752 | S ORPOTI( "CHK",1)=$ P(ORPOTI(" TEST"),"," ),ORPOTI(" CHK",2)=$P (ORPOTI("T EST"),",", 2) | |
| 753 | F ORPOTI( "I")=1,2 S :ORPOTI("C HK",ORPOTI ("I"))[":" ORPOTI("C HK",ORPOTI ("I"))=$P( ORPOTI("CH K",ORPOTI( "I")),":") | |
| 754 | S:'ORPOTI ("CHK",2)& (ORPOTI("C HK",1)) OR POTI("CHK" ,2)=ORPOTI ("CHK",1) | |
| 755 | F ORPOTI( "I")=1:1:$ P(ORPOTI(" TN"),U,2) S ORPOTI(" TEST",ORPO TI("I"))=0 D | |
| 756 | .X "F ORP OTI(""II"" )="_ORPOTI ("TEST")_" S ORPOTI( ""TEST"",O RPOTI(""I" "),ORPOTI( ""II""))=" """ S ORPO TI(""VALID TESTS"",$$ TEST^LRPXA PI | |
| 757 | U(ORPOTI(" "II"")))=O RPOTI(""II "")" | |
| 758 | D GET I O RPOTI("TES T",1) D H( 0),DAT(0), SET("") D | |
| 759 | .I ORPOTI ("LINE2") S ORPOTI(" HOLD",1)=O RPOTI("HOL D") D H(OR POTI("HOLD ")),DAT(OR POTI("HOLD ",1)) | |
| 760 | Q "~@^TMP (""ORPOTIO B2"","_$J_ ")" | |
| 761 | ; | |
| 762 | ONE(X) ;Si ngle lab t est in a t ime period object. | |
| 763 | ;X should be "Data name^# of occurances ^time peri od (nM, nD , or nY)" | |
| 764 | ;or X cou ld be "Pri nt string^ # of occur ances^time period (n M, nD, or nY)^Data n ame number ^Print com pleted tim e" | |
| 765 | N ORPOTI S ORPOTI(" TN")=X,ORP OTI("C")=0 ,$P(ORPOTI ("SP")," " ,50)="" | |
| 766 | S ORPOTI( "N")=$P(OR POTI("TN") ,U,2),ORPO TI("T")=$P (ORPOTI("T N"),U,3) | |
| 767 | S:'ORPOTI ("N") ORPO TI("N")=99 S:ORPOTI( "T")="" OR POTI("T")= "99Y" | |
| 768 | S:'$P(ORP OTI("TN"), U,4) ORPOT I("TEST")= $O(^DD(63. 04,"B",$P( ORPOTI("TN "),U),0)) | |
| 769 | S:$P(ORPO TI("TN"),U ,4) ORPOTI ("TEST")=$ P(ORPOTI(" TN"),U,4) | |
| 770 | I 'ORPOTI ("TEST") D Q "~@^TM P(""ORPOTI OB2"","_$J _")" | |
| 771 | .D K S ^T MP("ORPOTI OB2",$J,1, 0)=$P(ORPO TI("TN"),U )_" - INVA LID TEST N AME" | |
| 772 | F ORPOTI( "I")=1:1:O RPOTI("N") S ORPOTI( "TEST",ORP OTI("I"))= 0,ORPOTI(" TEST",ORPO TI("I"),OR POTI("TEST "))="" | |
| 773 | S X=$$TES T^LRPXAPIU (ORPOTI("T EST")),ORP OTI("VALID TESTS",X)= ORPOTI("TE ST"),ORPOT I("VALIDTE STS","B",O RPOTI("TES T"))=X ;IA 4246 | |
| 774 | S (ORPOTI ("CHK",1), ORPOTI("CH K",2))=ORP OTI("TEST" ) D GET | |
| 775 | D:$P(ORPO TI("TN"),U ,5) ;also display V erify Date | |
| 776 | .F ORPOTI ("I")=9E9: 0 S ORPOTI ("I")=$O(^ TMP("ORPOT IOB2",$J,O RPOTI("I") ),-1) Q:'O RPOTI("I") D | |
| 777 | ..S ^TMP( "ORPOTIOB2 ",$J,ORPOT I("I")+2,0 )=^TMP("OR POTIOB2",$ J,ORPOTI(" I"),0) | |
| 778 | .S ^TMP(" ORPOTIOB2" ,$J,1,0)=" TEST COLLE CTION DATE RESULT VERI FY DATE" | |
| 779 | .S ^TMP(" ORPOTIOB2" ,$J,2,0)=" " | |
| 780 | ONEQ Q "~@ ^TMP(""ORP OTIOB2""," _$J_")" | |
| 781 | ; | |
| 782 | GET ;Get d ata from ^ LR(DFN,"CH ") | |
| 783 | N ORPOTIT EST,LRDFN, T,X S T=OR POTI("T") D K,NONE | |
| 784 | S ORPOTI( "N")=1 | |
| 785 | D RESULTS ^LRPXAPI(. ORPOTITEST ,DFN,"C",9 99,"","",D T,ORPOTI(" ED")) ;IA 4245 | |
| 786 | F ORPOTI( "I")=0:0 S ORPOTI("I ")=$O(ORPO TI("VALIDT ESTS",ORPO TI("I"))) Q:'ORPOTI( "I") D | |
| 787 | .S ORPOTI ("VALIDTES TS","B",OR POTI("VALI DTESTS",OR POTI("I")) )=ORPOTI(" I") | |
| 788 | S X="" F S X=$O(OR POTITEST(X )) Q:X="" D | |
| 789 | .Q:'$P(OR POTITEST(X ),U,2) Q: '$D(ORPOTI ("VALIDTES TS",$P(ORP OTITEST(X) ,U,2))) | |
| 790 | .S ^TMP(" ORPOTIOB2" ,$J,"SORT" ,-ORPOTITE ST(X),$P(O RPOTITEST( X),U,2))=$ P(ORPOTITE ST(X),U,4, 5) | |
| 791 | F ORPOTI( "I")=-9E9: 0 S ORPOTI ("I")=$O(^ TMP("ORPOT IOB2",$J," SORT",ORPO TI("I"))) Q:'ORPOTI( "I") D | |
| 792 | .S ORPOTI ("FLAG")=0 | |
| 793 | .F ORPOTI ("II")=0:0 S ORPOTI( "II")=$O(^ TMP("ORPOT IOB2",$J," SORT",ORPO TI("I"),OR POTI("II") )) Q:'ORPO TI("II") D | |
| 794 | ..Q:'$D(^ TMP("ORPOT IOB2",$J," SORT",ORPO TI("I"),OR POTI("VALI DTESTS","B ",ORPOTI(" CHK",1)))) !('$D(^TMP ("ORPOTIOB 2",$J,"SOR T",ORPOTI( "I | |
| 795 | "),ORPOTI( "VALIDTEST S","B",ORP OTI("CHK", 2))))) | |
| 796 | ..S ORPOT I("TEST")= ORPOTI("VA LIDTESTS", ORPOTI("II ")) Q:'$D( ORPOTI("TE ST",ORPOTI ("N"),ORPO TI("TEST") )) | |
| 797 | ..S:'ORPO TI("TEST", ORPOTI("N" ),ORPOTI(" TEST")) OR POTI("TEST ",ORPOTI(" N"),ORPOTI ("TEST"))= ^TMP("ORPO TIOB2",$J, "SORT",ORP OTI("I"),O RP | |
| 798 | OTI("II")) ,ORPOTI("F LAG")=1 | |
| 799 | .S:ORPOTI ("FLAG") O RPOTI("TES T",ORPOTI( "N"))=-ORP OTI("I"),O RPOTI("N") =ORPOTI("N ")+1 | |
| 800 | K ^TMP("O RPOTIOB2", $J,"SORT") Q | |
| 801 | ; | |
| 802 | H(N) ;Head er line | |
| 803 | N X S X=$ E($E($P(OR POTI("TN") ,U),1,11)_ " Coll. da te"_ORPOTI ("SP"),1,2 3) | |
| 804 | F ORPOTI( "I")=N:0 S ORPOTI("I ")=$O(ORPO TI("TEST", 1,ORPOTI(" I"))) Q:'O RPOTI("I") !($L(X)>72 ) D | |
| 805 | .S ORPOTI ("XX")=ORP OTI("SP") | |
| 806 | .S:ORPOTI ("XX")="" ORPOTI("XX ")=$$LRDNM ^LRPXAPIU( ORPOTI("I" )),ORPOTI( "XX")=$E($ S(ORPOTI(" XX")]"":OR POTI("XX") ,1:"Unknow n"),1,8)_O RP | |
| 807 | OTI("SP") ;IA 4246 | |
| 808 | .S X=X_$E (ORPOTI("X X"),1,7)_" " Q:$L(X) >72 | |
| 809 | D SET(X) S ORPOTI(" HOLD")=ORP OTI("I")-. 1 Q | |
| 810 | ; | |
| 811 | DAT(N) ;Da ta line | |
| 812 | N X F ORP OTI("I")=1 :1:$P(ORPO TI("TN"),U ,2) Q:'ORP OTI("TEST" ,ORPOTI("I ")) D D: $L(X)>72 S ET(X) | |
| 813 | .S X=$$CO NV2(ORPOTI ("TEST",OR POTI("I")) )_ORPOTI(" SP"),X=$E( X,1,23) | |
| 814 | .F ORPOTI ("TEST")=N :0 S ORPOT I("TEST")= $O(ORPOTI( "TEST",ORP OTI("I"),O RPOTI("TES T"))) D:'O RPOTI("TES T")&($L(X) <73) SET(X ) Q:'ORPOT I( | |
| 815 | "TEST") D Q:$L(X)> 72 | |
| 816 | ..S ORPOT I("XX")=$P (ORPOTI("T EST",ORPOT I("I"),ORP OTI("TEST" )),U) S:OR POTI("XX") >0&(ORPOTI ("XX")<1)& ($E(ORPOTI ("XX"))=". ") ORPOTI( "X | |
| 817 | X")=0_ORPO TI("XX") | |
| 818 | ..S:$P(OR POTI("TEST ",ORPOTI(" I"),ORPOTI ("TEST")), U,2)]"" OR POTI("XX") =ORPOTI("X X")_" "_$P (ORPOTI("T EST",ORPOT I("I"),ORP OTI("TEST" )) | |
| 819 | ,U,2) | |
| 820 | ..S:$E(OR POTI("XX") ,8)?1A ORP OTI("XX")= $E(ORPOTI( "XX"),1,7) _" " S X=X _$E(ORPOTI ("XX")_ORP OTI("SP"), 1,8) | |
| 821 | Q | |
| 822 | ; | |
| 823 | CONV() Q $ $CONV2($$L RIDT^LRPXA PIU(ORPOTI ("TEST",OR POTI("I")) )) ;IA 42 46 | |
| 824 | CONV2(X) S ORPOTI("X X")=$E($P( X,".",2)_" 0000",1,4) | |
| 825 | S X=X_$E( ORPOTI("XX "),1,2)_": "_$E(ORPOT I("XX"),3, 4) | |
| 826 | S X=$E(X, 4,5)_"/"_$ E(X,6,7)_" /"_$E(X,2, 3)_" @ " | |
| 827 | S X=X_$E( ORPOTI("XX "),1,2)_": "_$E(ORPOT I("XX"),3, 4) Q X | |
| 828 | ; | |
| 829 | SET(X) S O RPOTI("C") =ORPOTI("C ")+1,^TMP( "ORPOTIOB2 ",$J,ORPOT I("C"),0)= X,X="" Q | |
| 830 | ; | |
| 831 | AGO N X1,X 2 S:'$D(OR POTI("T")) ORPOTI("T ")=T | |
| 832 | S X1=DT,X 2=+ORPOTI( "T"),X=$P( ORPOTI("T" ),X2,2),X2 =-X2 | |
| 833 | S X2=X2*$ S(X="M":30 ,X="W":7,X ="D":1,1:3 65) | |
| 834 | D C^%DTC S ORPOTI(" ED")=$$LRI DT^LRPXAPI U(X) Q ;I A 4246 | |
| 835 | ; | |
| 836 | K K ^TMP(" ORPOTIOB2" ,$J) Q | |
| 837 | NONE S ^TM P("ORPOTIO B2",$J,1,0 )=$P(ORPOT I("TN"),U) _" - NONE FOUND" Q | |
| 838 | D(Y) D DD^ %DT Q Y | |
| 839 | ORPOVST (N ew) | |
| 840 | ORPOVST ;R 01/RMM Pop -Up for CH ECK PATIEN T VESTING in CPRS ;3 /23/2012 | |
| 841 | ;;3.0;ORD ER ENTRY/R ESULTS REP ORTING;**4 31**;;Buil d 7 | |
| 842 | ;268 NAME : DBIA268- A | |
| 843 | ;5408 NAM E: CPT/HCP CS Procedu re File 81 | |
| 844 | ;IA 1625 NAME: PERS ON CLASS A PI'S | |
| 845 | ; | |
| 846 | ;a patien t is conci dered vest ed if they have an i npatient a dmission o r observat ion stay o f less tha n 24 hours , | |
| 847 | ;or outpa tient care that in g eneral, eq uates to a primary c are visit by a clini cian autho rized to a dminister a | |
| 848 | ;primary care visit . A primar y care vis it is iden tified by a list of specific C urrent Pro cedural Te rminology | |
| 849 | ;(CPT) co des identi fied in th is manual. These cod es must be administe red by at least one clinical p rovider | |
| 850 | ;authoriz ed to comp lete the e quivalent of a histo ry and phy sical. The precise C PT codes a nd authori zed provid ers | |
| 851 | ;are iden tified in the docume ntation of the Non-V ested pati ent class. A patient is requir ed to meet the Vesti ng | |
| 852 | ;criteria once duri ng the cur rent year or the pri or two fis cal years. Patients that do no t meet the Vesting | |
| 853 | ;requirem ents are p laced in t he Non-Ves ted patien t class. | |
| 854 | EN(ORPODFN ) ;CALCULA TE VESTMEN T | |
| 855 | N ORPORET ,ORPOBD,OR POED,ORPOY ,ORPOM,ORP OI,ORPOII, ORPOA | |
| 856 | S ORPOY=$ E(DT,1,3), ORPOM=$E(D T,4,5),ORP OY=$S(ORPO M>9:ORPOY- 2,1:ORPOY- 3),ORPOBD= ORPOY_1001 ,ORPOED=DT ,ORPORET=" NON-VESTED " | |
| 857 | ; | |
| 858 | ; | |
| 859 | S ORPOI="" F S ORPO I=$O(^OR(1 00.0074,"B ",ORPOI)) Q:ORPOI="" D | |
| 860 | .S:ORPOI[ "ICPT" ORP OA($$GET1^ DIQ(81,$P( ORPOI,";") ,.01))="" | |
| 861 | .S:ORPOI[ "USC" ORPO A($$GET1^D IQ(8932.1, $P(ORPOI," ;"),5))="" | |
| 862 | D CVS(ORP ODFN,.ORPO RET) | |
| 863 | Q ORPORET | |
| 864 | CVS(ORPOPT ,ORPOR) ;C alculates if a patie nt has the required local acti vity to be considere d vested, within the current v esting per iod. | |
| 865 | ;The orde r of the s earch is l ocal ward admission, fee basis inpatient activity, required cpt code i n local ou tpatient a ctivity, | |
| 866 | ;and requ ired PERSO N CLASS in fee basis outpatien t activity . | |
| 867 | ;This fun ction is l ooking for the first occurrenc e within t he vesting period. O nce an occ urrence is found the hunt is o ver. | |
| 868 | ;The cpt codes used in the se arch are f ound in fi le 100.007 4 and prov ider types defined a s acceptab le person classes | |
| 869 | ;are in f ile 100.00 74 | |
| 870 | I $G(ORPO PT)="" S O RPOR="INVA LID DFN" Q | |
| 871 | Q:ORPOR=" INVALID DF N" | |
| 872 | I '$D(^DP T(ORPOPT)) S ORPOR=" INVLAID DF N" Q | |
| 873 | S:$$GET1^ DIQ(2,ORPO PT,.152)]" " ORPOR="N OT ELIGIBL E" ;scree n out pati ents not e ligible | |
| 874 | S:$$GET1^ DIQ(2,ORPO PT,1901,"I ")'="Y" OR POR="NON-V ETERAN" ;s creen out non-vetera ns | |
| 875 | Q:ORPOR'= "NON-VESTE D" | |
| 876 | D ADM(ORP OPT,.ORPOR ) Q:ORPOR= "VESTED" | |
| 877 | D FEE(ORP OPT,.ORPOR ) Q:ORPOR= "VESTED" | |
| 878 | D FND(ORP OPT,.ORPOR ) | |
| 879 | Q | |
| 880 | ;D LIST^D IC(162.02, ","_15682_ ","_38728_ ",","@;.01 I;","Q",,, ,"B") | |
| 881 | ;D LIST^D IC(162.02, ","_15682_ ","_38728_ ",","@;.01 I;","Q",,, ,"B",,,"OR PO") | |
| 882 | ;D LIST^D IC(162.03, ","_2_","_ 15682_","_ 38728_",", "@;.01;"," Q",,,,"B", ,,"ORPO") | |
| 883 | FND(ORPOPT ,ORPOR) ; | |
| 884 | N ORPOI,O RPOEP,ORPO FDT,ORPODT ,ORPORN,OR POPC,ORPOV N,ORPOII,O RPODOC | |
| 885 | ;^AUPNVCP T("AA",68, 82435,7009 871,376934 9)="" | |
| 886 | ; PATIENT, CPT ,REVE RSE DATE | |
| 887 | ;F ORPOI= 0:0 S ORPO I=$O(ORPOA (ORPOI)) Q :ORPOI["V" D:$D(^AU PNVCPT("AA ",ORPOPT,O RPOI)) ;v isit xref in v cpt f ile | |
| 888 | S ORPOI=" " F S ORP OI=$O(ORPO A(ORPOI)) Q:ORPOI["V "!(ORPOI=" ") D:$D(^ AUPNVCPT(" AA",ORPOPT ,ORPOI)) ;visit xre f in v cpt file | |
| 889 | .S ORPODT =9999999-( ORPOED+1) F S ORPOD T=$O(^AUPN VCPT("AA", ORPOPT,ORP OI,ORPODT) ) Q:'ORPOD T!(ORPODT> (9999999-O RPOBD)) D | |
| 890 | ..S ORPOR N=$O(^AUPN VCPT("AA", ORPOPT,ORP OI,ORPODT, 0)),ORPOVN =$$GET1^DI Q(9000010. 18,ORPORN, .03,"I") ; visit ien | |
| 891 | ..S ORPOE P=$$GET1^D IQ(9000010 .18,ORPORN ,1204,"I") S:ORPOEP] "" ORPODOC (ORPOEP)=" " ;v cpt file encou nter provi der | |
| 892 | ..;D:('OR POEP)&(ORP OVN) ;if no provide r, but vis it ien | |
| 893 | ..D:ORPOV N ;if vis it ien | |
| 894 | ...D FIND ^DIC(90000 10.06,,"@; .01I;.04I" ,"Q",ORPOV N,,"AD") ; v provider file | |
| 895 | ...F ORPO II=0:0 S O RPOII=$O(^ TMP("DILIS T",$J,2,OR POII)) Q:' ORPOII D | |
| 896 | ....S ORP OEP=^TMP(" DILIST",$J ,"ID",ORPO II,.01) ;v isit provi der | |
| 897 | ....Q:'OR POEP ;no encounter provider f or the cpt code | |
| 898 | ....S ORP ODOC(ORPOE P)="" ;enc ounter pro vider | |
| 899 | ..F ORPOE P=0:0 S OR POEP=$O(OR PODOC(ORPO EP)) Q:'OR POEP D | |
| 900 | ...S ORPO FDT=999999 9-ORPODT,O RPOPC=$$GE T^XUA4A72( ORPOEP,ORP OFDT) | |
| 901 | ...Q:ORPO PC=-1 ;no t a valid user or pe rson class never ass igned | |
| 902 | ...Q:ORPO PC=-2 ;no active pe rson class on that d ate | |
| 903 | ...Q:$P(O RPOPC,U,7) ="" ;QUIT IF N O D A N C S D | |
| 904 | ...S:$D(O RPOA($P(OR POPC,U,7)) ) ORPOR="V ESTED" | |
| 905 | Q | |
| 906 | ADM(ORPOPT ,ORPOR) ;I F ADMITTED IN LAST T WO YEARS V ESTED | |
| 907 | ;R01/RMM ***MODIFIC ATION*** 8 /14/2015 | |
| 908 | ;MODIFIED TO FIND A LL INPATIE NTS DURNIN G VESTING PERIOD | |
| 909 | ;THE OLD CODE ONLY FOUND PATI ENTS ADDMI TED DURING THE VESTI NG PERIOD | |
| 910 | ;N ORPOAD | |
| 911 | ;S ORPOAD =ORPOBD F S ORPOAD= $O(^DGPM(" APTT1",ORP OPT,ORPOAD )) Q:'ORPO AD!(ORPOAD >(ORPOED+. 9999)) D | |
| 912 | ;.S ORPOR ="VESTED" | |
| 913 | ; | |
| 914 | D FIND^DI C(45,,"@;. 01I;2I;11; 13I","Q",O RPOPT,,"B" ) ;PTF FIL E | |
| 915 | N ORPOI,O RPOF S ORP OF=0 | |
| 916 | F ORPOI=0 :0 S ORPO I=$O(^TMP( "DILIST",$ J,2,ORPOI) ) Q:'ORPOI !(ORPOF=1) D | |
| 917 | .Q:^TMP(" DILIST",$J ,"ID",ORPO I,.01)'=OR POPT | |
| 918 | .S:^TMP(" DILIST",$J ,"ID",ORPO I,2)>ORPOB D ORPOR="V ESTED",ORP OF=1 | |
| 919 | .D:^TMP(" DILIST",$J ,"ID",ORPO I,11)="CEN SUS" | |
| 920 | ..D:^TMP( "DILIST",$ J,"ID",ORP OI,13)]"" | |
| 921 | ...S:$$GE T1^DIQ(45. 86,^TMP("D ILIST",$J, "ID",ORPOI ,13),.01," I")>ORPOBD ORPOR="VE STED",ORPO F=1 | |
| 922 | ;*** END MODIFICATI ON *** | |
| 923 | Q | |
| 924 | ; | |
| 925 | FEE(ORPOPT ,ORPOR) ; FEE BASIS PATIENT | |
| 926 | N ORPOFP, ORPOTD,ORP OI,ORPOII, ORPOIII,OR POC,ORPOLS T,ORPOFDT, ORPOF,ORPO D3,ORPOVEN S ORPOF=0 | |
| 927 | S ORPOFP= 0 F S ORP OFP=$O(^FB AAA("AQLVS ",ORPOPT,O RPOFP)) Q: 'ORPOFP D | |
| 928 | .Q:ORPOFP =2 ;scree n out the outpatient fee basis program | |
| 929 | .S ORPOTD =ORPOBD-1 F S ORPOT D=$O(^FBAA A("AQLVS", ORPOPT,ORP OFP,ORPOTD )) Q:'ORPO TD D | |
| 930 | ..S ORPOR ="VESTED" | |
| 931 | Q:ORPOR=" VESTED" | |
| 932 | D LIST^DI C(162.01," ,"_ORPOPT_ ",","@;.01 I;","Q",,, ,"B") ;FEE BASIS PAY MENT PAYME NT | |
| 933 | F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI)) Q:'ORPOI! (ORPOF=1) D | |
| 934 | .S ORPOVE N=^TMP("DI LIST",$J," ID",ORPOI, .01) | |
| 935 | .D LIST^D IC(162.02, ","_ORPOVE N_","_ORPO PT_",","@; .01I;","Q" ,,,,"B",,, "ORPOLST") | |
| 936 | .F ORPOII =0:0 S ORP OII=$O(ORP OLST("DILI ST",2,ORPO II)) Q:'OR POII!(ORPO F=1) D | |
| 937 | ..S ORPOF DT=ORPOLST ("DILIST", "ID",ORPOI I,.01) | |
| 938 | ..Q:ORPOB D>ORPOFDT ;SCREEN O UT IF BEGI NNING DATE IS AFTER DT | |
| 939 | ..Q:ORPOE D<ORPOFDT ;SCREEN O UT IF END DATE IS BE FORE DT | |
| 940 | ..S ORPOD 3=ORPOLST( "DILIST",2 ,ORPOII) | |
| 941 | ..D LIST^ DIC(162.03 ,","_ORPOD 3_","_ORPO VEN_","_OR POPT_","," @;.01;","Q ",,,,"B",, ,"ORPOC") | |
| 942 | ..F ORPOI II=0:0 S O RPOIII=$O( ORPOC("DIL IST",2,ORP OIII)) Q:' ORPOIII D | |
| 943 | ...S:$D(O RPOA(ORPOC ("DILIST", "ID",ORPOI II,.01))) ORPOR="VES TED",ORPOF =1 | |
| 944 | Q | |
| 945 | ADDT(X1,X2 ) ;ADD/SUB TRACT FROM DATE | |
| 946 | N X D C^% DTC | |
| 947 | Q X | |
| 948 | PRTV ;ENTR Y POINT FO R PRINTING VESTING C ODES | |
| 949 | K ZTSAVE D EN^XUTMD EVQ("START ^ORPOVST", "ORPOOR PR INT VESTIN G CODES") | |
| 950 | Q | |
| 951 | START ;ENT RY POINT | |
| 952 | K ^TMP("D ILIST",$J) ,^TMP("ORP OORUTL",$J ) | |
| 953 | D LIST^DI C(100.0074 ,,"@;.01I" ,"Q",,,,"B ") | |
| 954 | D GPTP,GC PT | |
| 955 | K ^TMP("D ILIST",$J) ,^TMP("ORP OORUTL",$J ) | |
| 956 | Q | |
| 957 | GPTP ;GET PROVIDER T YPE | |
| 958 | N ORPOI,O RPOIEN,ORP O | |
| 959 | F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI)) Q:'ORPOI D ;PRINT D A N C S D S | |
| 960 | .Q:^TMP(" DILIST",$J ,"ID",ORPO I,.01)["IC PT" | |
| 961 | .S ORPOIE N=$P(^TMP( "DILIST",$ J,"ID",ORP OI,.01),"; ") | |
| 962 | .K ORPO | |
| 963 | .D FIND^D IC(8932.1, ,"@;5;6;", "Q","`"_OR POIEN,,,,, "ORPO") | |
| 964 | .S ^TMP(" ORPOORUTL" ,$J,ORPO(" DILIST","I D",1,5))=O RPO("DILIS T","ID",1, 6) | |
| 965 | D PTPV | |
| 966 | Q | |
| 967 | GCPT ;GET PROVIDER T YPE | |
| 968 | N ORPOI,O RPOIEN,ORP OCPT K ^TM P("ORPOORU TL",$J) | |
| 969 | F ORPOI=0 :0 S ORPOI =$O(^TMP(" DILIST",$J ,2,ORPOI)) Q:'ORPOI D ;PRINT D A N C S D S | |
| 970 | .Q:^TMP(" DILIST",$J ,"ID",ORPO I,.01)["US C" | |
| 971 | .S ORPOIE N=$P(^TMP( "DILIST",$ J,"ID",ORP OI,.01),"; ") | |
| 972 | .S ORPOCP T=$$GET1^D IQ(81,ORPO IEN,.01) | |
| 973 | .S ^TMP(" ORPOORUTL" ,$J,ORPOCP T)="" | |
| 974 | D PTCPT | |
| 975 | Q | |
| 976 | PTCPT ;PRI NT CPT | |
| 977 | N ORPOI,O RPOCOL,ORP OF,ORPORET S ORPOCOL =0,ORPORET ="!",ORPOF =0 | |
| 978 | W !!!!,"C PT codes f or CPRS ve sting",?40 ,"Print Da te: ",$$CN VDT(DT),! | |
| 979 | S ORPOI=" " F S ORP OI=$O(^TMP ("ORPOORUT L",$J,ORPO I)) Q:ORPO I="" D | |
| 980 | .I ORPORE T]"" W @OR PORET,?ORP OCOL,ORPOI | |
| 981 | .E W ?O RPOCOL,ORP OI | |
| 982 | .S:ORPOCO L=60 ORPOC OL=0,ORPOR ET="!",ORP OF=1 | |
| 983 | .S:ORPOCO L=50 ORPOC OL=60,ORPO RET="" | |
| 984 | .S:ORPOCO L=40 ORPOC OL=50,ORPO RET="" | |
| 985 | .S:ORPOCO L=30 ORPOC OL=40,ORPO RET="" | |
| 986 | .S:ORPOCO L=20 ORPOC OL=30,ORPO RET="" | |
| 987 | .S:ORPOCO L=10 ORPOC OL=20,ORPO RET="" | |
| 988 | .I ORPOCO L=0,ORPOF= 0 S ORPOCO L=10,ORPOR ET="" | |
| 989 | .S ORPOF= 0 | |
| 990 | Q | |
| 991 | CNVDT(Y) ; FORMAT INT ERNAL TO E XTERNAL DA TE | |
| 992 | D DD^%DT | |
| 993 | Q Y | |
| 994 | PTPV ;PRIN T PROVIDER TYPE | |
| 995 | N ORPOI,O RPOCOL,ORP OF,ORPORET S ORPOCOL =0,ORPORET ="!",ORPOF =0 | |
| 996 | W !!!,"Pr ovider Typ es for CPR S vesting" ,?45,"Prin t Date: ", $$CNVDT(DT ),! | |
| 997 | S ORPOI=" " F S ORP OI=$O(^TMP ("ORPOORUT L",$J,ORPO I)) Q:ORPO I="" D | |
| 998 | .I ORPORE T]"" W @OR PORET,?ORP OCOL,ORPOI ," - ",^TM P("ORPOORU TL",$J,ORP OI) | |
| 999 | .E W ?O RPOCOL,ORP OI," - ",^ TMP("ORPOO RUTL",$J,O RPOI) | |
| 1000 | .S:ORPOCO L=52 ORPOC OL=0,ORPOR ET="!",ORP OF=1 | |
| 1001 | .S:ORPOCO L=26 ORPOC OL=52,ORPO RET="" | |
| 1002 | .I ORPOCO L=0,ORPOF= 0 S ORPOCO L=26,ORPOR ET="" | |
| 1003 | .S ORPOF= 0 | |
| 1004 | Q | |
| 1005 | ; | |
| 1006 | ; | |
| 1007 | ; | |
| 1008 | TEST(DT) ; ***** cod e used for testing n ew dates ***** | |
| 1009 | ;The tran sition to the 2-year rolling p opulation will occur increment ally over the course of three consecutiv e VERA Mod els. | |
| 1010 | ;Each of the three impending models are listed be low | |
| 1011 | ;VERA 201 5: Fund 2. 66 years o f Basic Ca re populat ion (i.e. reduce thi rd year po pulation b y 33%) | |
| 1012 | ;VERA 201 6: Fund 2. 33 years o f Basic Ca re populat ion (i.e. reduce thi rd year po pulation b y 66 %) | |
| 1013 | ;VERA 201 7: Fund ro lling 2-ye ar Basic C are patien t populati on. | |
| 1014 | N ASV,ASV 1 | |
| 1015 | F ASV=1:1 :9 D ;yea r | |
| 1016 | .F ASV1=1 :1:12 D ; month | |
| 1017 | ..S DT=$E (DT,1,2)_A SV_$S($L(A SV1)=2:ASV 1,1:"0"_AS V1)_15 ; W !,DT | |
| 1018 | ..S ORPOY =$E(DT,1,3 ),ORPOM=$E (DT,4,5),O RPOY=$S(OR POM>9:ORPO Y-2,1:ORPO Y-3),ORPOB D=ORPOY_10 01,ORPOED= DT,ORPORET ="NON-VEST ED" | |
| 1019 | ..W !!,DT ,?16,ORPOB D,?30,$$CN VDT(ORPOBD ) | |
| 1020 | ..S (ORPO Y,ORPOM,OR POBD)="" | |
| 1021 | ..S ORPOY =$E(DT,1,3 ),ORPOM=$E (DT,4,5),O RPOED=DT,O RPORET="NO N-VESTED" S:ORPOM>9 ORPOY=ORPO Y+1 ;,ORPO BD=ORPOY_1 001, | |
| 1022 | ..D:ORPOY <315 | |
| 1023 | ...S ORPO Y=ORPOY-3, ORPOBD=ORP OY_1001 | |
| 1024 | ..D:ORPOY =315 | |
| 1025 | ...S ORPO Y=ORPOY-2, ORPOBD=ORP OY_"0201" | |
| 1026 | ..D:ORPOY =316 | |
| 1027 | ...S ORPO Y=ORPOY-2, ORPOBD=ORP OY_"0601" | |
| 1028 | ..D:ORPOY >=317 | |
| 1029 | ...S ORPO Y=ORPOY-2, ORPOBD=ORP OY_1001 | |
| 1030 | ..W !,$$C NVDT(DT),? 16,ORPOBD, ?30,$$CNVD T(ORPOBD) | |
| 1031 | Q | |
| 1032 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.