Produced by Araxis Merge on 4/27/2017 2:09:11 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 | PSS_10_203_cif.zip\PSS_10_203_cif\docs | EPIP_Remediation_Plan_(PSS_1.0_203).docx | Tue Apr 18 15:44:42 2017 UTC |
| 2 | PSS_10_203_cif.zip\PSS_10_203_cif\docs | EPIP_Remediation_Plan_(PSS_1.0_203).docx | Thu Apr 27 18:53:46 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 4 | 2280 |
| Changed | 3 | 10 |
| 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 PSS* 1.0*203 | |
| 3 | Remediatio n Plan | |
| 4 | ||
| 5 | ||
| 6 | Department of Vetera ns Affairs | |
| 7 | April 2017 | |
| 8 | Version 3. 0 | |
| 9 | ||
| 10 | ||
| 11 | Revision H istory | |
| 12 | Date | |
| 13 | Version | |
| 14 | Descriptio n | |
| 15 | Author | |
| 16 | 04/04/2017 | |
| 17 | 3.0 | |
| 18 | Updated pa tch descri ption, req uirements list, and appendixes due to re -remediati on for mis sing waive r function ality. Oth er minor u pdates thr oughout. | |
| 19 | EPIP Proje ct Team | |
| 20 | 12/22/2016 | |
| 21 | 2.0 | |
| 22 | Updated en tire docum ent | |
| 23 | EPIP Proje ct Team | |
| 24 | 11/28/2016 | |
| 25 | 1.0 | |
| 26 | Initial (d raft) vers ion | |
| 27 | EPIP Proje ct Team | |
| 28 | ||
| 29 | ||
| 30 | ||
| 31 | ||
| 32 | Table of C ontents | |
| 33 | 1.Introduc tion1 | |
| 34 | 2.Purpose1 | |
| 35 | 3.Patch De scription1 | |
| 36 | 3.1.Needs and Requir ements4 | |
| 37 | 4.Points o f Contact5 | |
| 38 | 5.Code Rem ediation5 | |
| 39 | 5.1.Standa rds and Co nventions5 | |
| 40 | 5.2.Review and Analy sis5 | |
| 41 | 5.3.Coding Changes6 | |
| 42 | 6.Testing6 | |
| 43 | 6.1.Test P lan6 | |
| 44 | 6.2.Test E nvironment 6 | |
| 45 | 6.3.Test R eadiness R eview7 | |
| 46 | 6.4.Testin g Phases7 | |
| 47 | 6.4.1.Unit Testing7 | |
| 48 | 6.4.2.Comp onent Inte gration an d Systems Testing (C I/ST)7 | |
| 49 | 6.4.3.Func tional Tes ting7 | |
| 50 | 6.4.4.Regr ession Tes ting7 | |
| 51 | 6.4.5.Sect ion 508 Co mpliance T esting7 | |
| 52 | 7.Document ation Reme diation8 | |
| 53 | 7.1.User G uides8 | |
| 54 | 7.2.Instal lation Gui des8 | |
| 55 | 7.3.Techni cal Manual s8 | |
| 56 | 7.4.Operat ions Manua ls8 | |
| 57 | 8.Project Reporting8 | |
| 58 | 9.Project Schedule8 | |
| 59 | 10.Deploym ent8 | |
| 60 | 11.Sustain ment Requi rements9 | |
| 61 | 12.Mainten ance and K nowledge T ransfer9 | |
| 62 | Appendix A :XINDEX Li sting for MUMPS Code Changes10 | |
| 63 | Appendix B :Source Co de Changes 11 | |
| 64 | ||
| 65 | ||
| 66 | ||
| 67 | Introducti on | |
| 68 | 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. | |
| 69 | Purpose | |
| 70 | 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 c ode to be deployed a s patch PS S*1.0*203. This patc h addresse s the foll owing NSRs : | |
| 71 | NSR2015011 5 Audits f or DRUG fi le 50 Chan ges | |
| 72 | This NSR h as been im plemented locally at the VA Me dical Cent ers in Buf falo NY, D ayton OH, Kansas Cit y MO, Bata via NY, Ca nandaigua NY, Bath N Y, Syracus e NY, Alba ny NY, Col umbia MO, Topeka KS, Leavenwor th KS, and Wichita K S. | |
| 73 | NSR2008071 4 Drug Fil e Price Ch ange Date/ Time Stamp | |
| 74 | This NSR h as been im plemented locally at the Centr al Plains VA Medical Centers ( Grand Isla nd and Oma ha NE). | |
| 75 | This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation, and delive ry of this remediati on effort. | |
| 76 | Patch Desc ription | |
| 77 | PSS*1.0*20 3 provides the follo wing enhan cements to VistA: | |
| 78 | Enables au diting of drug file changes. T his enhanc ement gene rates a me ssage to a new MailM an Group c alled PSS DEE AUDIT when a use r or autom ated proce ss makes c hanges to the DRUG f ile (#50). The messa ge shows t he date/ti me of the change, th e name of the user w ho made th e change, and before /after des criptions of the cha nged field (s). After installat ion, a Pha rmacy Clin ical Appli cation Coo rdinator ( CAC) or Ph armacy Aut omated Dat a Processi ng Applica tion Coord inator (AD PAC) must modify the PSS DEE A UDIT mail group to i nclude the necessary recipient s. This mo dification allows Ph armacy CAC s and ADPA Cs to main tain consi stency and control w hen multip le users c reate and edit DRUG file entri es across integrated facilitie s. | |
| 79 | Not all fi elds in th e DRUG fil e are subj ect to aud it. The fo llowing li st of audi table fiel ds is stor ed interna lly in the PSSDEEA r outine. | |
| 80 | GENERIC NA ME (#.01) | |
| 81 | VA CLASSIF ICATION (# 2) | |
| 82 | DEA, SPECI AL HDLG (# 3) | |
| 83 | MAXIMUM DO SE PER DAY (#4) | |
| 84 | STANDARD S IG (#5) | |
| 85 | FSN (#6) | |
| 86 | WARNING LA BEL (#8) | |
| 87 | MESSAGE (# 101) | |
| 88 | PHARMACY O RDERABLE I TEM (#2.1 ) | |
| 89 | RESTRICTIO N (#102) | |
| 90 | APPLICATIO N PACKAGES ’ USE (#63 ) | |
| 91 | NDC (#31) | |
| 92 | CMOP DISPE NSE (#213) | |
| 93 | ATC MNEMON IC (#212.2 ) | |
| 94 | REORDER LE VEL (#11) | |
| 95 | ORDER UNIT (#12) | |
| 96 | PRICE PER ORDER UNIT (#13) | |
| 97 | PRICE PER DISPENSE U NIT (#16) | |
| 98 | SOURCE OF SUPPLY (#1 7) | |
| 99 | DISPENSE U NIT (#14.5 ) | |
| 100 | CURRENT IN VENTORY (# 50) | |
| 101 | DAW CODE ( #81) | |
| 102 | NCPDP DISP ENSE UNIT (#82) | |
| 103 | NCPDP QUAN TITY MULTI PLIER (#83 ) | |
| 104 | INACTIVE D ATE (#100) | |
| 105 | NATIONAL D RUG FILE E NTRY (#20) | |
| 106 | VA PRODUCT NAME (#21 ) | |
| 107 | PSNDF VA P RODUCT NAM E ENTRY (# 22) | |
| 108 | PACKAGE SI ZE (#23) | |
| 109 | PACKAGE TY PE (#24) | |
| 110 | NATIONAL D RUG CLASS (#25) | |
| 111 | CMOP ID (# 27) | |
| 112 | NATIONAL F ORMULARY I NDICATOR ( #29) | |
| 113 | If a user makes chan ges to a n on-auditab le field, or views a ny field b ut does no t make cha nges, then the mail message Su bject is D RUG ENTER/ EDIT ACCES S, and the message b ody indica tes “No Au dited Chan ges Made.” | |
| 114 | ||
| 115 | Drug Audit Message E xample | |
| 116 | Tracks inf ormation o n the most recent dr ug price c hange in t he DRUG (# 50) file. When a use r or an au tomated pr ocess adds or change s the PRIC E/DISPENSE UNIT (#15 ) field, o r when the PRICE/DIS PENSE UNIT field is automatica lly update d by a cha nge to the PRICE PER ORDER UNI T (#13) fi eld, the s ystem will store the following in the ne w HISTORY PRICE DISP ENSE (#950 ) multiple in the DR UG (#50) f ile: the d ate and ti me of the update; th e user who updated t he field; and the ne w value in the PRICE /DISPENSE UNIT field . The HIST ORY PRICE DISPENSE m ultiple is searchabl e via File Man, and i s viewable using eit her FileMa n or the L ookup into Dispense Drug File [PSS LOOK] option in VistA. | |
| 117 | The new PS S DRUG AUD IT RETENTI ON MOS par ameter is used to li mit the hi storical d ata held i n the HIST ORY PRICE DISPENSE m ultiple. T his parame ter can be set to a positive w hole numbe r of reten tion month s. The tim e period f or retaini ng histori cal data i s based on the last date of a price chan ge, minus the parame ter number (retentio n months) times 30 d ays. Only those entr ies that f all within this time period wi ll be stor ed in the file multi ple. If th e paramete r is not s et to a wh ole number of retent ion months , then all entries i n the HIST ORY PRICE DISPENSE m ultiple wi ll be reta ined. | |
| 118 | This modif ication en ables phar macies to better man age drug p rices by v erifying t hat the pr ice shown is up to d ate, and b y providin g a price update his tory. | |
| 119 | ||
| 120 | Last Price Change in PSS LOOK | |
| 121 | Needs and Requiremen ts | |
| 122 | The Needs and Requir ements for the NSRs addressed in this re mediation are: | |
| 123 | NSR2015011 5 Audits f or DRUG fi le 50 Chan ges: | |
| 124 | NEED 49781 8: Audit D rug File C hanges – F or VistA P harmacy Ap plications Coordinat ors who su pport the Pharmacy a pplication at multi- divisional facilitie s. The abi lity to re ceive an e -mail (tha t is gener ated to a mail group that I am a member of) whenev er a user makes chan ges to: a) specific fields ass ociated wi th a drug file entry using the Drug Ente r/Edit opt ion; or b) a drug fi le cost vi a any meth od (i.e., Drug Enter /Edit opti ons or Fil eManager). | |
| 125 | NSR2008071 4 Drug Fil e Price Ch ange Date/ Time Stamp : | |
| 126 | NEED 38596 5: Drug Fi le Increas es to Drug File Pric es – Abili ty to know when ther e are incr eases to d rug file p rices and how they a ffect phar macy cost data acros s systems | |
| 127 | REQUIREMEN T 396092: Drug Price Increases – Provide the abili ty to dete ct when pr ice increa ses have o ccurred. | |
| 128 | NEED 38597 3: Drug Fi le Ability to assess drug file prices as current a nd accurat e – Abilit y to asses s drug fil e prices a s current and accura te | |
| 129 | REQUIREMEN T 396084: Current an d Accurate Prices – Provide th e ability to compare drug pric es against a nationa l drug pri ce list to ensure th ey are cur rent and a ccurate. | |
| 130 | NEED 38598 0: Drug Fi le Trends and Budget Forecasts – Ability to measur e trends a nd make ac curate bud get foreca sts. | |
| 131 | REQUIREMEN T 396093: Measure Tr ends – Pro vide the a bility to manage tre nds in dru g pricing. | |
| 132 | NEED 38597 8: Drug Fi le Ability to report on a pric e change d ate for a select dru g – Abilit y to repor t on a pri ce change date for a select dr ug | |
| 133 | REQUIREMEN T 396090: Price Chan ges – Prov ide the ab ility to r eport on a price cha nge for a specific d rug. | |
| 134 | NEED 88717 1: Date an d Time Sta mp Drug Fi le Price – For Pharm acy users who manage drug pric es, a proc ess to dat e/time sta mp the dru g file pri ce that ai ds the pha rmacy in m aintaining accurate drug price s. Unlike the curren t process, where the re is no p ractical w ay of asse ssing how current th e drug pri ces are, w hich leads to the po tential of inaccurat e reportin g. Our pro cess adds a date/tim e stamp to the drug file whene ver an ent ry is made or edited in the pr ice per or der unit f ield that is searcha ble using FileMan an d is viewa ble using the PSS LO OK option, thereby i ncreasing confidence that the price info rmation in the drug file is bo th up to d ate and ac curate, th at can be used for m easuring t rends, for ecasting b udgets, an d producin g accurate reports l ocally and nationall y. | |
| 135 | Points of Contact | |
| 136 | The VA Poi nt of Cont act (POC) for NSR201 50115 Audi ts for DRU G file 50 Changes is
|
|
| 137 | The VA POC for NSR20 080714 Dru g File Pri ce Change Date/Time Stamp is
|
|
| 138 | Code Remed iation | |
| 139 | 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. | |
| 140 | Standards and Conven tions | |
| 141 | Leidos wil l referenc e the
|
|
| 142 | The MUMPS coding sta ndards web site
|
|
| 143 | Review and Analysis | |
| 144 | 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 V istA, and 2) verific ation that the sourc e code cha nges do no t adversel y affect a ny other V istA funct ionality. | |
| 145 | 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. | |
| 146 | Coding Cha nges | |
| 147 | The coding changes r equired fo r NSR20150 115 Audits for DRUG file 50 Ch anges are in the fol lowing MUM PS routine s: | |
| 148 | Modified r outines: P SSDEE | |
| 149 | New routin es: PSSDEE A, PSSP203 , PSSPRICE | |
| 150 | The coding changes r equired fo r NSR20080 714 Drug F ile Price Change Dat e/Time Sta mp are in the follow ing MUMPS routines: | |
| 151 | Modified r outines: P SSLOOK | |
| 152 | New routin es: None | |
| 153 | A detailed analysis of the cod ing change s is provi ded in App endix B. | |
| 154 | Testing | |
| 155 | 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. | |
| 156 | Test Plan | |
| 157 | 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. | |
| 158 | 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. | |
| 159 | Test Envir onment | |
| 160 | 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. | |
| 161 | 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 v31 (1.0.30.7 5), and Sn agIt. | |
| 162 | Test Readi ness Revie w | |
| 163 | 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 ). | |
| 164 | Testing Ph ases | |
| 165 | Leidos wil l perform developmen t and SQA testing ac tivities i n phases, and will p rovide all required testing do cumentatio n. | |
| 166 | Unit Testi ng | |
| 167 | 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. | |
| 168 | Component Integratio n and Syst ems Testin g (CI/ST) | |
| 169 | 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. | |
| 170 | Functional Testing | |
| 171 | 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. | |
| 172 | Regression Testing | |
| 173 | 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. | |
| 174 | Section 50 8 Complian ce Testing | |
| 175 | Section 50 8 testing will be pe rformed on VistA and CPRS code when new CPRS GUI c hanges are introduce d by the d eveloper. The VA-rec ommended A ssistive T echnology tool, JAWS , will be used to co nduct the 508 testin g. Test re sults and related do cumentatio n will be submitted to the VA Section 50 8 team in accordance with the VA 508 tes ting requi rements. D efects fou nd during testing wi ll be asse ssed and r emediated by the dev eloper. | |
| 176 | Documentat ion Remedi ation | |
| 177 | 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. | |
| 178 | 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
|
|
| 179 | The follow ing sectio ns outline the VDL d ocuments t o be revis ed for thi s remediat ion. | |
| 180 | User Guide s | |
| 181 | The follow ing User G uide will be updated in the VD L: | |
| 182 | Pharmacy D ata Manage ment: Mana ger’s User Manual | |
| 183 | Installati on Guides | |
| 184 | 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. | |
| 185 | Technical Manuals | |
| 186 | The follow ing Techni cal Manual will be u pdated in the VDL: | |
| 187 | Pharmacy D ata Manage ment: Tech nical Manu al/Securit y Guide | |
| 188 | Operations Manuals | |
| 189 | No Operati ons Manual s require revision a s a result of this m odificatio n. | |
| 190 | Project Re porting | |
| 191 | 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. | |
| 192 | Project Sc hedule | |
| 193 | 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. | |
| 194 | Deployment | |
| 195 | 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. | |
| 196 | Sustainmen t Requirem ents | |
| 197 | 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 . | |
| 198 | Maintenanc e and Know ledge Tran sfer | |
| 199 | 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. | |
| 200 | XINDEX Lis ting for M UMPS Code Changes | |
| 201 | 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. | |
| 202 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 203 | [2008 V A Standard s & Conven tions] | |
| 204 | UC I: VISTA C PU: ROU Mar 31, 2 017@08:41: 18 | |
| 205 | ||
| 206 | The BUILD file Data Dictionari es are bei ng process ed. | |
| 207 | ||
| 208 | 50 DRUG | |
| 209 | 50.03 HIST ORY PRICE DISPENSE U NIT | |
| 210 | The option and funct ion files are being processed. | |
| 211 | ||
| 212 | ||
| 213 | Routines a re being p rocessed. | |
| 214 | Routines: 5 Faux Ro utines: 2 | |
| 215 | ||
| 216 | PSSDEE PSSDEEA PSSLOOK PSSP203 PSSPRICE | |
| 217 | ||
| 218 | Data Dicti onaries | |
| 219 | |dd50 |dd50 .03 | |
| 220 | ||
| 221 | --- CROSS REFERENCIN G --- | |
| 222 | ||
| 223 | ||
| 224 | Compiled l ist of Err ors and Wa rnings Mar 31, 20 17@08:41:1 8 page 1 | |
| 225 | No errors or warning s to repor t | |
| 226 | ||
| 227 | ||
| 228 | ||
| 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: P SSDEE, PSS LOOK | |
| 232 | New routin es: PSSDEE A, PSSP203 , PSSPRICE | |
| 233 | PSSDEE | |
| 234 | Before: | |
| 235 | PSSDEE ; BIR/WRT-MA STER DRUG ENTER/EDIT ROUTINE ; 01/21/00 | |
| 236 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **3,5,15,1 6,20,22,28 ,32,34,33, 38,57,47,6 | |
| 237 | 8,61,82,90 ,110,155,1 56,180,193 ,200,207** ;9/30/97;B uild 31 | |
| 238 | ; | |
| 239 | ; Reference to ^PS(59 supported by DBIA #1 976 | |
| 240 | ; Reference to REACT1^ PSNOUT sup ported by DBIA #2080 | |
| 241 | ; Reference to $$UP^XL FSTR(X) su pported by DBIA #101 04 | |
| 242 | ; Reference to $$PSJDF ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 243 | ; Reference to PSNAPIS supported by DBIA # 2531 | |
| 244 | ; Reference to ^XMB("N ETNAME" su pported by DBIA #113 1 | |
| 245 | ; Reference to ^XUSEC supported by DIBA #1 0076 | |
| 246 | ; | |
| 247 | BEGIN N PSSUPRAF, PSSTDRUG | |
| 248 | S PSSFLAG=0 D ^PSSDEE 2 S PSSZ=1 F PSSXX=1 :1 K DA D ASK Q:PSSF LAG | |
| 249 | DONE D ^PSSDEE2 K PSSFLAGK ,PSSXX,DIE ,DIR,CLFLA G,CLFALG,D ISPDRG,DLA YGO,DR,ENT | |
| 250 | RY,FLAG,FL G1,FLG2,FL G4,FLG5,FL G6,FLG7,FL GKY,FLGMTH ,FLGNDF,FL GOI,K,NEWD F | |
| 251 | K NFLAG,NWN D,NWPC1,NW PC2,NWPC3O LDDF,PSIUD A,PSIUX,PS NP,PSSANS, PSSASK,PSS | |
| 252 | DA,PSSDD,P SSFLAG,PSS OR,PSSZ,PS XBT,PSXF,P SXFL,PSXUM ,PSXGOOD,P SXLOC,ZAPF LG | |
| 253 | Q | |
| 254 | ASK ; | |
| 255 | W ! S DIC=" ^PSDRUG(", DIC(0)="QE ALMNTV",DL AYGO=50,DI C("T")="", DIC("W")=" | |
| 256 | S PSSTDRUG =Y D GETTI ER^PSSDEE( PSSTDRUG)" D ^DIC K DIC I Y<0 S PSSFLAG= 1 Q | |
| 257 | N PSINACT S (FLG1,FLG 2,FLG3,FLG 4,FLG5,FLG 6,FLG7,FLA G,FLGKY,FL GOI,PSINAC | |
| 258 | T)=0 K ^TM P($J,"ADD" ),^TMP($J, "SOL") | |
| 259 | S DA=+Y,DIS PDRG=DA L +^PSDRUG(D ISPDRG):0 I '$T W !, $C(7),"Ano ther perso | |
| 260 | n is editi ng this on e." Q | |
| 261 | I $G(^PSDRU G(DA,"I")) S PSINACT =$G(^PSDRU G(DA,"I")) I PSINACT ,PSINACT<D | |
| 262 | T S PSINAC T=1 ;;<<* 180 - RJS | |
| 263 | S PSSHUIDG= 1,PSSNEW=$ P(Y,"^",3) D USE,NOP E,COMMON,D EA,MF K PS SHUIDG,PSS | |
| 264 | UPRAF | |
| 265 | ; if any ou tpatient s ite has a dispense m achine run ning HL7 V .2.4, then | |
| 266 | ; run the n ew routine and creat e message | |
| 267 | N XX,DNSNAM ,DNSPORT,D VER,DMFU,P SSUPRA S X X="" | |
| 268 | F XX=0:0 S XX=$O(^PS( 59,XX)) Q: 'XX D | |
| 269 | . S DVER=$$G ET1^DIQ(59 ,XX_",",10 5,"I"),DMF U=$$GET1^D IQ(59,XX_" ,",105.2) | |
| 270 | . S DNSNAM=$ $GET1^DIQ( 59,XX_",", 2006),DNSP ORT=$$GET1 ^DIQ(59,XX _",",2007) | |
| 271 | . D:DVER="2. 4"&(DNSNAM '="")&(DMF U="YES") D RG^PSSDGUP D(DISPDRG, PSSNEW,DNS | |
| 272 | NAM,DNSPOR T) | |
| 273 | D DRG^PSSHU IDG(DISPDR G,PSSNEW) L -^PSDRUG (DISPDRG) | |
| 274 | S XX=$P($G( ^PSDRUG(DI SPDRG,2)), "^",3) I X X["U"!(XX[ "I") D S XX="" | |
| 275 | . S XX=$$SND HL7^PSSMST R() D:XX | |
| 276 | . .Q:PSSNEW& '((XX=2)!( XX=3)) ;U =1,N=2,B=3 | |
| 277 | . .Q:'PSSNEW &(XX=2) ; U=1,N=2,B= 3 | |
| 278 | . .N VAR | |
| 279 | . .I PSSNEW& ((XX=2)!(X X=3)) S VA R="Would y ou like to send this new drug | |
| 280 | to PADE" | |
| 281 | . .E S VAR= "Would you like to s end a drug file upda te to PADE " | |
| 282 | . .W !!,"Thi s drug is marked for either UD or IV use , and you have at le | |
| 283 | ast" | |
| 284 | . .W !,"one active Pha rmacy Auto mated Disp ensing Equ ipment (PA DE)." | |
| 285 | . .K DIR,DIR UT,DUOUT,D TOUT | |
| 286 | . .S DIR(0)= "Y",DIR("A ")=VAR | |
| 287 | . .S DIR("?" )="Enter Y for Yes o r N for No ." D ^DIR K DIR | |
| 288 | . .Q:'Y | |
| 289 | . .N PSSPADE S PSSPADE =1 S XX="" | |
| 290 | . .D ENP^PSS HLDFS(DISP DRG,$S(PSS NEW:"MAD", 1:"MUP")) | |
| 291 | K FLG3,PSSN EW | |
| 292 | . | |
| 293 | . | |
| 294 | . | |
| 295 | ========== ========== ========== ========== ========== ========== ======== | |
| 296 | After: | |
| 297 | PSSDEE ; BIR/WRT-MA STER DRUG ENTER/EDIT ROUTINE ; 01 Dec 20 16 2:24 P M | |
| 298 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **3,5,15,1 6,20,22,28 ,32,34,33, 38,57,47,6 | |
| 299 | 8,61,82,90 ,110,155,1 56,180,193 ,200,207,2 03**;9/30/ 97;Build 1 | |
| 300 | ; | |
| 301 | ; Reference to ^PS(59 supported by DBIA #1 976 | |
| 302 | ; Reference to REACT1^ PSNOUT sup ported by DBIA #2080 | |
| 303 | ; Reference to $$UP^XL FSTR(X) su pported by DBIA #101 04 | |
| 304 | ; Reference to $$PSJDF ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 305 | ; Reference to PSNAPIS supported by DBIA # 2531 | |
| 306 | ; Reference to ^XMB("N ETNAME" su pported by DBIA #113 1 | |
| 307 | ; Reference to ^XUSEC supported by DIBA #1 0076 | |
| 308 | ; | |
| 309 | BEGIN N PSSUPRAF, PSSTDRUG | |
| 310 | S PSSFLAG=0 D ^PSSDEE 2 S PSSZ=1 F PSSXX=1 :1 K DA D ASK Q:PSSF LAG | |
| 311 | DONE D ^PSSDEE2 K PSSFLAGK ,PSSXX,DIE ,DIR,CLFLA G,CLFALG,D ISPDRG,DLA YGO,DR,ENT | |
| 312 | RY,FLAG,FL G1,FLG2,FL G4,FLG5,FL G6,FLG7,FL GKY,FLGMTH ,FLGNDF,FL GOI,K,NEWD F | |
| 313 | K NFLAG,NWN D,NWPC1,NW PC2,NWPC3O LDDF,PSIUD A,PSIUX,PS NP,PSSANS, PSSASK,PSS | |
| 314 | DA,PSSDD,P SSFLAG,PSS OR,PSSZ,PS XBT,PSXF,P SXFL,PSXUM ,PSXGOOD,P SXLOC,ZAPF LG | |
| 315 | Q | |
| 316 | ASK ; | |
| 317 | W ! S DIC=" ^PSDRUG(", DIC(0)="QE ALMNTV",DL AYGO=50,DI C("T")="", DIC("W")=" | |
| 318 | S PSSTDRUG =Y D GETTI ER^PSSDEE( PSSTDRUG)" D ^DIC K DIC I Y<0 S PSSFLAG= 1 Q | |
| 319 | N PSINACT S (FLG1,FLG 2,FLG3,FLG 4,FLG5,FLG 6,FLG7,FLA G,FLGKY,FL GOI,PSINAC | |
| 320 | T)=0 K ^TM P($J,"ADD" ),^TMP($J, "SOL") | |
| 321 | S DA=+Y,DIS PDRG=DA L +^PSDRUG(D ISPDRG):0 I '$T W !, $C(7),"Ano ther perso | |
| 322 | n is editi ng this on e." Q | |
| 323 | D BEFORE^PS SDEEA($T(+ 0)) ; dru g enter/ed it auditin g | |
| 324 | I $G(^PSDRU G(DA,"I")) S PSINACT =$G(^PSDRU G(DA,"I")) I PSINACT ,PSINACT<D | |
| 325 | T S PSINAC T=1 ;;<<* 180 - RJS | |
| 326 | S PSSHUIDG= 1,PSSNEW=$ P(Y,"^",3) D USE,NOP E,COMMON,D EA,MF K PS SHUIDG,PSS | |
| 327 | UPRAF | |
| 328 | ; if any ou tpatient s ite has a dispense m achine run ning HL7 V .2.4, then | |
| 329 | ; run the n ew routine and creat e message | |
| 330 | N XX,DNSNAM ,DNSPORT,D VER,DMFU,P SSUPRA S X X="" | |
| 331 | F XX=0:0 S XX=$O(^PS( 59,XX)) Q: 'XX D | |
| 332 | . S DVER=$$G ET1^DIQ(59 ,XX_",",10 5,"I"),DMF U=$$GET1^D IQ(59,XX_" ,",105.2) | |
| 333 | . S DNSNAM=$ $GET1^DIQ( 59,XX_",", 2006),DNSP ORT=$$GET1 ^DIQ(59,XX _",",2007) | |
| 334 | . D:DVER="2. 4"&(DNSNAM '="")&(DMF U="YES") D RG^PSSDGUP D(DISPDRG, PSSNEW,DNS | |
| 335 | NAM,DNSPOR T) | |
| 336 | D DRG^PSSHU IDG(DISPDR G,PSSNEW) L -^PSDRUG (DISPDRG) | |
| 337 | D AFTER^PSS DEEA($T(+0 )) ; drug enter/edi t auditing | |
| 338 | S XX=$P($G( ^PSDRUG(DI SPDRG,2)), "^",3) I X X["U"!(XX[ "I") D S XX="" | |
| 339 | . S XX=$$SND HL7^PSSMST R() D:XX | |
| 340 | . .Q:PSSNEW& '((XX=2)!( XX=3)) ;U =1,N=2,B=3 | |
| 341 | . .Q:'PSSNEW &(XX=2) ; U=1,N=2,B= 3 | |
| 342 | . .N VAR | |
| 343 | . .I PSSNEW& ((XX=2)!(X X=3)) S VA R="Would y ou like to send this new drug | |
| 344 | to PADE" | |
| 345 | . .E S VAR= "Would you like to s end a drug file upda te to PADE " | |
| 346 | . .W !!,"Thi s drug is marked for either UD or IV use , and you have at le | |
| 347 | ast" | |
| 348 | . .W !,"one active Pha rmacy Auto mated Disp ensing Equ ipment (PA DE)." | |
| 349 | . .K DIR,DIR UT,DUOUT,D TOUT | |
| 350 | . .S DIR(0)= "Y",DIR("A ")=VAR | |
| 351 | . .S DIR("?" )="Enter Y for Yes o r N for No ." D ^DIR K DIR | |
| 352 | . .Q:'Y | |
| 353 | . .N PSSPADE S PSSPADE =1 S XX="" | |
| 354 | . .D ENP^PSS HLDFS(DISP DRG,$S(PSS NEW:"MAD", 1:"MUP")) | |
| 355 | K FLG3,PSSN EW | |
| 356 | Q | |
| 357 | ASK+4 D BEFORE ^PSSDEEA($ T(+0)) ; drug enter /edit audi ting | |
| 358 | ASK+15 D AFTER^ PSSDEEA($T (+0)) ; d rug enter/ edit audit ing | |
| 359 | . | |
| 360 | . | |
| 361 | . | |
| 362 | ========== ========== ========== ========== ========== ========== ======== | |
| 363 | PSSLOOK | |
| 364 | Before: | |
| 365 | PSSLOOK ; BIR/WRT-Dr ug file lo okup ;02/0 3/00 | |
| 366 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **3,7,15,1 6,20,24,29 ,38,68,61, 87,90,127, | |
| 367 | 147,170,18 9,192,200* *;9/30/97; Build 29 | |
| 368 | ; | |
| 369 | ; Reference to ^PS(50. 605 suppor ted by DBI A #2138 | |
| 370 | ; Reference to ^PS(50. 608 suppor ted by DBI A #2136 | |
| 371 | ||
| 372 | VISTAS2:VI STA>ZP | |
| 373 | PSSLOOK ; BIR/WRT-Dr ug file lo okup ;02/0 3/00 | |
| 374 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **3,7,15,1 6,20,24,29 ,38,68,61, 87,90,127, | |
| 375 | 147,170,18 9,192,200* *;9/30/97; Build 29 | |
| 376 | ; | |
| 377 | ; Reference to ^PS(50. 605 suppor ted by DBI A #2138 | |
| 378 | ; Reference to ^PS(50. 608 suppor ted by DBI A #2136 | |
| 379 | ; Reference to ^PS(50. 609 suppor ted by DBI A #2137 | |
| 380 | ; Reference to ^PS(50. 607 suppor ted by DBI A #2221 | |
| 381 | ; Reference to $$FORMR X^PSNAPIS( DA,K,.LIST ) supporte d by DBIA #2574 | |
| 382 | ; Reference to $$FORMI ^PSNAPIS(P 1,P3) supp orted by D BIA #2574 | |
| 383 | ; Reference to $$PSJDF ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 384 | ; Reference to $$PSJST ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 385 | ; Reference to $$PROD2 ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 386 | ; Reference to $$CPTIE R^PSNAPIS( P1,P3) sup ported by DBIA #2531 | |
| 387 | ; Reference to $$VAGN^ PSNAPIS(P1 ) supporte d by DBIA #2531 | |
| 388 | ; Reference to ^PSNDF( 50.68 supp orted by D BIA 3735 | |
| 389 | ; | |
| 390 | START S QUIT=0,PS SFG=0 D KI LL F PSSXX =1:1 D PIC K Q:PSSFG | |
| 391 | DONE D KILL K PS SFG,PSSXX, QUIT,FM,FM S,Y2K | |
| 392 | Q | |
| 393 | PICK W ! K DIC S DIC="^PSD RUG(",DIC( 0)="AEQMVT N",DIC("T" )="",DIC(" W")="S PSS | |
| 394 | TDRUG=Y D GETTIER^PS SDEE(PSSTD RUG)" D ^D IC K DIC I Y<0 S PSS FG=1 Q | |
| 395 | S IFN=+Y D NDDATA,GET DATA,INACT ,NOD66,FOR MAT,KILL | |
| 396 | Q | |
| 397 | NDDATA I $D(^PSDRU G(IFN,"ND" )) S CLPTR =$P(^PSDRU G(IFN,"ND" ),"^",6) I $P(^PSDRU | |
| 398 | G(IFN,"ND" ),"^",2)]" " S NDNODE =^PSDRUG(I FN,"ND"),V AGNPTR=$P( NDNODE,"^" ,1),VAPN=$ | |
| 399 | P(NDNODE," ^",2),SZPT R=$P(NDNOD E,"^",4),T YPTR=$P(ND NODE,"^",5 ) D NDF,ND F1 | |
| 400 | Q | |
| 401 | NDF S DA=VAGNPT R,X=$$VAGN ^PSNAPIS(D A),VAGN=X, PS=$P(^PS( 50.609,SZP TR,0),"^", | |
| 402 | 1),PT=$P(^ PS(50.608, TYPTR,0)," ^",1),P3=$ P(NDNODE," ^",3) | |
| 403 | K X S DA=VA GNPTR,K=P3 ,X=$$PROD2 ^PSNAPIS(D A,K) I X]" ",$P(X,"^" )]"" S VAP | |
| 404 | RN=$P(X,"^ "),VADU=$P (X,"^",4), CMOPID=$P( X,"^",2) | |
| 405 | S CSF="" I $P(NDNODE, "^",3) S C SF=$$GET1^ DIQ(50.68, $P(NDNODE, "^",3),19, | |
| 406 | "I") | |
| 407 | Q | |
| 408 | IT S CMOPID=$P (X,"^",2) | |
| 409 | Q | |
| 410 | NDF1 S X=$$PSJDF ^PSNAPIS(D A,K),VADF= $P(X,"^",2 ) | |
| 411 | Q | |
| 412 | INACT S ACT="" I $D(^PSDRUG (IFN,"I")) S Y=$P(^P SDRUG(IFN, "I"),"^",1 ) X ^DD("D | |
| 413 | D") S ACT= Y | |
| 414 | Q | |
| 415 | GETDATA S NODE0=^PS DRUG(IFN,0 ),GN=$P(NO DE0,"^",1) ,CL=$P(NOD E0,"^",2), DEA=$P(NOD | |
| 416 | E0,"^",3), WRN=$P(NOD E0,"^",8), NF=$P(NODE 0,"^",9),M ESS=$P(NOD E0,"^",10) ,VNF=$P(NO | |
| 417 | DE0,"^",11 ),CLASS="" ,WARN="" S :NF=1 NF=" N/F" S:VNF =1 VNF="V- N/F" | |
| 418 | S PSSNODE=$ G(^PSDRUG( IFN,"DOS") ) | |
| 419 | I CL]"" S C LASS=CL_" "_$P(^PS( 50.605,CLP TR,0),"^", 2) | |
| 420 | I $D(^PSDRU G(IFN,3)) S:$P(^PSDR UG(IFN,3), "^")=0 CMO P="NO" S:$ P(^PSDRUG( | |
| 421 | IFN,3),"^" )=1 CMOP=" YES" | |
| 422 | I $D(^PSDRU G(IFN,5)) S QDM=^PSD RUG(IFN,5) | |
| 423 | S OINM="" S NDC="" I $D(^PSDRUG (IFN,2)) S NODE2=^PS DRUG(IFN,2 ) S:$P(NOD | |
| 424 | E2,"^",1)] "" OIPTR=$ P(NODE2,"^ ",1) S NDC =$P(NODE2, "^",4) S:$ P(NODE2,"^ ",6)]"" PD | |
| 425 | PTR=$P(NOD E2,"^",6) S APP=$P(N ODE2,"^",3 ),FM="" D TWOA | |
| 426 | Q | |
| 427 | TWOA I $D(OIPTR) S OI=$P(^ PS(50.7,OI PTR,0),"^" ,1),DFPTR= $P(^PS(50. 7,OIPTR,0) | |
| 428 | ,"^",2),DF =$P(^PS(50 .606,DFPTR ,0),"^",1) ,FMS=$P(^P S(50.7,OIP TR,0),"^", 12) S:FMS] | |
| 429 | "" FM=" (N /F)" S OIN M=OI_" "_D F_FM | |
| 430 | ; I $D(PDPTR ) S PD=$P( ^PS(50.3,P DPTR,0),"^ ",1) | |
| 431 | Q | |
| 432 | NOD66 S (DUPOU,PP DU,PPOU,DU ,SS)="" I $D(^PSDRUG (IFN,660)) S NDE=^PS DRUG(IFN,6 | |
| 433 | 60),OUPTR= $P(NDE,"^" ,2),PPOU=$ P(NDE,"^", 3),DUPOU=$ P(NDE,"^", 5),PPDU=$P (NDE,"^",6 | |
| 434 | ),SS=$P(ND E,"^",7),D U=$P(NDE," ^",8) I OU PTR]"" S O U=$P(^DIC( 51.5,OUPTR ,0),"^") | |
| 435 | Q | |
| 436 | SYN I $D(^PSDRU G(IFN,1,0) ) F ZZZ=0: 0 S ZZZ=$O (^PSDRUG(I FN,1,ZZZ)) Q:'ZZZ S | |
| 437 | SYNM=$P(^ PSDRUG(IFN ,1,ZZZ,0), "^",1),INT =$P(^PSDRU G(IFN,1,ZZ Z,0),"^",3 ) D SYN1 | |
| 438 | Q | |
| 439 | SYN1 S INT=$S(IN T=0:"Trade Name",INT =1:"Quick Code",INT= "C":"Ctrl Substances | |
| 440 | ",INT="D": "Drug Acco untability ",1:"") D FULL Q:$G( QUIT) W ? 14,SYNM,?5 5,INT,! | |
| 441 | Q | |
| 442 | SYN2 S :INT=0 INT ="Trade" S :INT=1 INT ="Quick" S :INT="C" I NT="Ctrl S ubs" S:INT | |
| 443 | ="D" INT=" Drug Acct" W ?16,SYN M,?57,INT, ! | |
| 444 | Q | |
| 445 | IFCAP I $D(^PSDRU G(IFN,441, 0)) F QQQ= 0:0 S QQQ= $O(^PSDRUG (IFN,441,Q QQ)) Q:'QQ | |
| 446 | Q S IFCAP NM=$P(^PSD RUG(IFN,44 1,QQQ,0)," ^",1) | |
| 447 | Q | |
| 448 | FORMAT ; BEGIN WRI TING | |
| 449 | N DAW | |
| 450 | W @IOF,"DRU G NAME: ", GN," (IEN : ",IFN,") ",! | |
| 451 | F XX=1:1:77 W "=" | |
| 452 | W ! | |
| 453 | W :$D(VAPRN) "VA PRINT NAME: ",? 17,VAPRN W :$D(CMOPID ) ?60,"CMO P ID#: ",C | |
| 454 | MOPID W:$D (VAPN) !," VA PRODUCT NAME: ",? 17,VAPN W: $D(CMOP) ? 60,"CMOP D ISPENSE: " | |
| 455 | ,CMOP | |
| 456 | W :$D(OINM) !,"ORDERAB LE ITEM: " ,?17,OINM W:$D(VAPN) ?60,"NDF DF: ",VADF | |
| 457 | I $D(OIPTR) ,OIPTR]"" W !,"ORDER ABLE ITEM TEXT: ",! D OITXT | |
| 458 | W :$D(PD) !, "PRIMARY D RUG: ",?17 ,PD | |
| 459 | W !,"SYNONY M(S): " D SYN D FULL Q:$G(QUIT ) W !,"ME SSAGE: ",M ESS,! | |
| 460 | D FULL Q:$G (QUIT) F XX=1:1:77 W "-" | |
| 461 | W ! | |
| 462 | D FULL Q:$G (QUIT) W "DEA, SPEC IAL HDLG: ",DEA,?48, "NDC: ",?6 3,NDC | |
| 463 | S DAW=+$$GE T1^DIQ(50, IFN,81) | |
| 464 | D FULL Q:$G (QUIT) W !,"DAW COD E: ",DAW, " - ",$$DA WEXT^PSSDA WUT(DAW) | |
| 465 | D FULL Q:$G (QUIT) W !,"CS FEDE RAL SCHEDU LE: ",$G(C SF) | |
| 466 | D FULL Q:$G (QUIT) W !,"INACTIV E DATE: ", ACT | |
| 467 | D FULL Q:$G (QUIT) W: $D(QDM) !, "QUANTITY DISPENSE M ESSAGE: ", QDM,! | |
| 468 | D FULL Q:$G (QUIT) I WRN]"" W ! ,"WARNING LABEL: " S X=WRN F Z 0=1:1 Q:$P | |
| 469 | (X,",",Z0, 99)="" S Z1=$P(X,", ",Z0) W:$D (^PS(54,Z1 ,0)) ?19,$ P(^(0),"^" ,1),! I '$ | |
| 470 | D(^(0)) W ?19,"NO SU CH WARNING LABEL" K X Q | |
| 471 | D FULL Q:$G (QUIT) S PSSLOOK=1 D | |
| 472 | . N DRUG | |
| 473 | . I $P($G(^P SDRUG(IFN, 0)),"^")=" " K PSSLOO K Q | |
| 474 | . S PSSWSITE =+$O(^PS(5 9.7,0)) W !,"WARNING LABEL SOU RCE is " D | |
| 475 | . .I $P($G(^ PS(59.7,PS SWSITE,10) ),"^",9)=" N" W "set to 'NEW'" Q | |
| 476 | . .W "not se t to 'NEW' " | |
| 477 | . K PSSWRN | |
| 478 | . D FULL Q:$ G(QUIT) W !,"NEW WA RNING LABE L:" | |
| 479 | . S ^TMP("PS SWRNB",$J, $P(^PSDRUG (IFN,0),"^ "))="" D ^ PSSWRNE | |
| 480 | . K PSSLOOK, ^TMP("PSSW RNB",$J),P SSWRN | |
| 481 | D FULL Q:$G (QUIT) W: '$D(QDM) ! F XX=1:1: 77 W "-" | |
| 482 | D FULL Q:$G (QUIT) W ! | |
| 483 | W "ORDER UN IT: ",?27 W:$D(OU) O U W ?40,"P RICE/ORDER UNIT: ",? 67,PPOU | |
| 484 | D FULL Q:$G (QUIT) W !,"DISPENS E UNIT: ", ?27,DU W:$ D(VADU) ?4 0,"VA DISP | |
| 485 | ENSE UNIT: ",?67,VAD U | |
| 486 | D FULL Q:$G (QUIT) W !,"DISPENS E UNITS/OR DER UNIT: ",?21,DUPO U,?40,"PRI | |
| 487 | CE/DISPENS E UNIT: ", ?67,PPDU | |
| 488 | D FULL Q:$G (QUIT) W !,"NCPDP D ISPENSE UN IT: ",$$GE T1^DIQ(50, IFN,82),?4 | |
| 489 | 0,"NCPDP Q UANTITY MU LTIPLIER: ",?67,$J($ $GET1^DIQ( 50,IFN,83) ,8,3) | |
| 490 | D FULL Q:$G (QUIT) W !,"MAXIMUM DAYS SUPP LY: ",$$GE T1^DIQ(50, IFN,66) | |
| 491 | D FULL Q:$G (QUIT) W !,"ePharma cy Billabl e: ",$$GET 1^DIQ(50,I FN,84) | |
| 492 | D FULL Q:$G (QUIT) W !?2,"ePhar macy Billa ble (TRICA RE): ",$$G ET1^DIQ(50 | |
| 493 | ,IFN,85) W ?40,"ePha rmacy Bill able (CHAM PVA): ",$$ GET1^DIQ(5 0,IFN,86) | |
| 494 | D FULL Q:$G (QUIT) W !,"Sensiti ve Diagnos is Drug: " ,$$GET1^DI Q(50,IFN,8 | |
| 495 | 7) W ! | |
| 496 | D FULL Q:$G (QUIT) W !,"APPL PK G USE:" S APPL="" S: '$D(APP) A PPL=" NON | |
| 497 | E" | |
| 498 | I $D(APP) D | |
| 499 | . S:APP["O" APPL=APPL _" Outpat ient" S:AP P["U" APPL =APPL_" U nit Dose" | |
| 500 | . S:APP["I" APPL=APPL _" IV" S: APP["W" AP PL=APPL_" Ward Stoc k" | |
| 501 | . S:APP["N" APPL=APPL _" Contro l Subs" S: APP["X" AP PL=APPL_" Non-VA Me | |
| 502 | d" | |
| 503 | . S:APPL="" APPL=" N ONE" | |
| 504 | W ?13,APPL | |
| 505 | I $P(PSSNOD E,"^",2) S (PSSCALC, PSSUNIT)=$ P($G(^PS(5 0.607,+$P( PSSNODE,U, | |
| 506 | 2),0)),U), PSSSTR=$P( PSSNODE,"^ ") | |
| 507 | I $G(PSSUNI T)'="",$G( PSSUNIT)[" /" D UNCAL C | |
| 508 | D FULL Q:$G (QUIT) W !,"STRENGT H: ",$S($E ($P(PSSNOD E,U),1)=". ":"0",1:"" | |
| 509 | )_$P(PSSNO DE,U),?35, "UNIT: ",$ G(PSSCALC) | |
| 510 | D FULL Q:$G (QUIT) W !,"POSSIBL E DOSAGES: " | |
| 511 | I $D(^PSDRU G(IFN,"DOS 1",0)) F P DS=0:0 S P DS=$O(^PSD RUG(IFN,"D OS1",PDS)) | |
| 512 | Q:'PDS D | |
| 513 | . S POSDOS=^ PSDRUG(IFN ,"DOS1",PD S,0) | |
| 514 | . D FULL Q:$ G(QUIT) W !," DIS PENSE UNIT S PER DOSE : ",$S($E( $P(POSDOS, | |
| 515 | U),1)=".": "0",1:"")_ $P(POSDOS, U),?40,"DO SE: ",$S($ E($P(POSDO S,U,2),1)= ".":"0",1: | |
| 516 | "")_$P(POS DOS,U,2),? 55,"PACKAG E: ",$P(PO SDOS,U,3) | |
| 517 | . D FULL Q:$ G(QUIT) W !," BCMA UNIT S PER DOSE : ",$P(POS DOS,U,4) | |
| 518 | D FULL Q:$G (QUIT) W !,"LOCAL P OSSIBLE DO SAGES:" | |
| 519 | I $D(^PSDRU G(IFN,"DOS 2",0)) F P DS=0:0 S P DS=$O(^PSD RUG(IFN,"D OS2",PDS)) | |
| 520 | Q:'PDS D | |
| 521 | . S LPDOS=^P SDRUG(IFN, "DOS2",PDS ,0) | |
| 522 | . D FULL Q:$ G(QUIT) W !," LOC AL POSSIBL E DOSAGE: " D | |
| 523 | . .I $L($P(L PDOS,U))'> 27 W $P(LP DOS,U),?55 ,"PACKAGE: ",$P(LPDO S,U,2) | |
| 524 | . .E W !,? 10,$P(LPDO S,U),!,?55 ,"PACKAGE: ",$P(LPDO S,U,2) | |
| 525 | . .D FULL Q: $G(QUIT) W !," BCMA UNITS PER DOSE: ",$P(LPDO S,U,3) D F | |
| 526 | ULL Q:$G(Q UIT) D LP DNW | |
| 527 | D FULL Q:$G (QUIT) W ! F XX=1:1 :77 W "-" | |
| 528 | D FULL Q:$G (QUIT) W !,"VA CLAS S: ",$G(CL ASS) | |
| 529 | D FULL Q:$G (QUIT) W !,"LOCAL N ON-FORMULA RY: ",$G(N F)," ","VIS | |
| 530 | N NON-FORM ULARY: ",$ G(VNF) | |
| 531 | N DA,K,LIST ,PSXDN,PSX GN,PSXVP,X ,XX1,XX2 | |
| 532 | K PSXGN,PSX VP I $D(^P SDRUG(IFN, "ND")) S P SXDN=$G(^P SDRUG(IFN, "ND")),PSX | |
| 533 | GN=$P(PSXD N,"^"),PSX VP=$P(PSXD N,"^",3) | |
| 534 | I $G(PSXGN) ,$G(PSXVP) S X=$$PRO D2^PSNAPIS (PSXGN,PSX VP),XX1=$$ FORMI^PSNA | |
| 535 | PIS(PSXGN, PSXVP) | |
| 536 | D FULL Q:$G (QUIT) W !,"Nationa l Formular y Indicato r: "_$S($G (XX1)=1:"Y | |
| 537 | ES",$G(XX1 )=0:"NO",1 :"Not Matc hed to NDF ") | |
| 538 | I $D(^PSDRU G(IFN,65,0 )) D FULL Q:$G(QUIT) W !,"FOR MULARY ALT ERNATIVES: | |
| 539 | ",! F FA= 0:0 S FA=$ O(^PSDRUG( IFN,65,FA) ) Q:'FA S LDFPTR=$P ($G(^PSDRU G(IFN,65,F | |
| 540 | A,0)),"^") I LDFPTR D FULL Q:$ G(QUIT) W ?26,$P($G (^PSDRUG(L DFPTR,0)), "^"),! | |
| 541 | N CPDATE,PS STIER D NO W^%DTC S C PDATE=$P(% ,".") S PS STIER=$$CP TIER^PSNAP | |
| 542 | IS($P($G(^ PSDRUG(IFN ,"ND")),"^ ",3),CPDAT E,IFN,1) K CPDATE,% | |
| 543 | ; PSSTIER = Copay Ti er^Effecti ve Date^En d Date | |
| 544 | W !,"Copay Tier: ",$P (PSSTIER," ^",1) | |
| 545 | W !,"Copay Effective Date: " S Y=$P(PSSTI ER,"^",2) D DD^%DT W Y K Y | |
| 546 | D FULL Q:$G (QUIT) I $G(PSXGN), $G(PSXVP) W !,"Natio nal Restri ction: " S | |
| 547 | XX2=$$FOR MRX^PSNAPI S(PSXGN,PS XVP,.LIST) I $G(XX2) =1,$D(LIST ) F XX2=0: 0 S XX2=$O | |
| 548 | (LIST(XX2) ) Q:'XX2 D FULL Q:$ G(QUIT) W !,LIST(XX 2,0) | |
| 549 | W !,"Local Drug Text: ",! I $D( ^PSDRUG(IF N,9,0)) D LDT | |
| 550 | Q | |
| 551 | LDT F TXT1=0:0 S TXT1=$O( ^PSDRUG(IF N,9,TXT1)) Q:'TXT1 S TEXPTR=^ PSDRUG(IFN | |
| 552 | ,9,TXT1,0) F PPP=0:0 S PPP=$O( ^PS(51.7,T EXPTR,2,PP P)) Q:'PPP S PST=$P ($G(^PS(51 | |
| 553 | .7,TEXPTR, 0)),"^",2) I 'PST S WPT=^PS(51 .7,TEXPTR, 2,PPP,0) D FULL Q:$G (QUIT) W | |
| 554 | WPT,! | |
| 555 | ; | |
| 556 | ; | |
| 557 | KILL K IFN,APP,I NT,VADU,VA GN,VAPN,VA PRN,P3,VAG NPTR,MESS, CLASS,DEA, ACT,CL,CLP | |
| 558 | TR,CMOP,DF ,DFPTR,DU, DUPOUGN,IF CAPNM,NDC, NDE,NDNODE ,NF,NODE0, NODE2,OI,O INM,OIPTR, | |
| 559 | OU,PD,PDPT R,PPDU,PPO U,PS,PT,NO D66,SYNM,S ZPTR,TYPTR ,WARN,WRN, XX,ZZZ,SS, OUPTR,CMOP | |
| 560 | ID | |
| 561 | K DUPOU,QQQ ,GN,QDM,AP PL,VADF,DF P,DFRM,Y,Z 0,Z1,DDD,P PP,TEXT,TX TPTR,TXT,T | |
| 562 | XT1,TEXPTR ,VNF,WPT,F A,LDFPTR,T EXTPTR,QUI T,PST,D0,D A,K,DIR | |
| 563 | K PSSNODE,P SDOSUN,PDS ,POSDOS,LP DOS,CSF,PS SSTR,PSSUN IT,PSSCALC ,PSSTIER | |
| 564 | Q | |
| 565 | OITXT I $D(^PS(50 .7,OIPTR,1 ,0)) F TXT =0:0 S TXT =$O(^PS(50 .7,OIPTR,1 ,TXT)) Q:' | |
| 566 | TXT S TEX TPTR=^PS(5 0.7,OIPTR, 1,TXT,0) F DDD=0:0 S DDD=$O(^P S(51.7,TEX TPTR,2,DDD | |
| 567 | )) Q:'DDD D IDATE I 'Y2K S TE XT=^PS(51. 7,TEXTPTR, 2,DDD,0) D FULL Q:$G (QUIT) W | |
| 568 | TEXT,! | |
| 569 | Q | |
| 570 | FULL D :($Y+5)>IO SL&('$G(QU IT)) FSCRN | |
| 571 | Q | |
| 572 | FSCRN Q :$G(QUIT) W ! K DIR S DIR(0)= "E",DIR("A ")="Press Return to continue,' | |
| 573 | ^' to exit " D ^DIR W @IOF S:Y' =1 QUIT=1 | |
| 574 | Q | |
| 575 | IDATE S Y2K=$P($G (^PS(51.7, TEXTPTR,0) ),"^",2) | |
| 576 | Q | |
| 577 | UNCALC ; | |
| 578 | N PSSVA,PSS VA1,PSSVB, PSSVB1,PSS DASH,PSSND FS,PSSDASH 2,PSSDASH3 ,PSSDASH5 | |
| 579 | K PSSCALC | |
| 580 | S PSSDASH=0 S PSSNDFS =$$PSJST^P SNAPIS(+$P ($G(^PSDRU G(IFN,"ND" )),"^"),+$ | |
| 581 | P($G(^PSDR UG(IFN,"ND ")),"^",3) ) S PSSNDF S=+$P($G(P SSNDFS),"^ ",2) | |
| 582 | I $G(PSSNDF S),$G(PSSS TR),+$G(PS SSTR)'=+$G (PSSNDFS) S PSSDASH= 1 | |
| 583 | S PSSVA=$P( PSSUNIT,"/ "),PSSVB=$ P(PSSUNIT, "/",2),PSS VA1=+$G(PS SVA),PSSVB | |
| 584 | 1=+$G(PSSV B) | |
| 585 | I $G(PSSDAS H) S PSSDA SH2=PSSSTR /PSSNDFS,P SSDASH3=PS SDASH2*$S( $G(PSSVB1) | |
| 586 | :PSSVB1,1: 1) S PSSDA SH5=$S('$G (PSSVB1):P SSDASH3_$G (PSSVB),1: PSSDASH3_$ P(PSSVB,PS | |
| 587 | SVB1,2)) | |
| 588 | S PSSCALC=$ S($G(PSSDA SH):$S('$G (PSSVA1):P SSVA,1:$P( PSSVA1,PSS VA1,2))_"/ | |
| 589 | "_$G(PSSDA SH5),1:PSS UNIT) | |
| 590 | Q | |
| 591 | ; | |
| 592 | LPDNW ; Display Do se Unit an d Numeric Dose field s, added w ith patch PSS*1*147 | |
| 593 | N PSSLKL1,P SSLKL2,PSS LKL3,PSSLK L4 | |
| 594 | S PSSLKL4=" " | |
| 595 | S PSSLKL1=$ P(LPDOS,"^ ",5),PSSLK L2=$P(LPDO S,"^",6) | |
| 596 | I PSSLKL1 S PSSLKL4=$ P($G(^PS(5 1.24,+PSSL KL1,0)),"^ ") | |
| 597 | S PSSLKL3=$ S($E(PSSLK L2)=".":"0 ",1:"")_PS SLKL2 | |
| 598 | I $L(PSSLKL 3)<18 D FU LL Q:$G(QU IT) W !?5 ,"NUMERIC DOSE: "_PS SLKL3,?38, | |
| 599 | "DOSE UNIT : "_PSSLKL 4 Q | |
| 600 | D FULL Q:$G (QUIT) W !?5,"NUMER IC DOSE: " _PSSLKL3 | |
| 601 | D FULL Q:$G (QUIT) W !?38,"DOSE UNIT: "_P SSLKL4 | |
| 602 | Q | |
| 603 | ========== ========== ========== ========== ========== ========== ======== | |
| 604 | After: | |
| 605 | PSSLOOK ; BIR/WRT-Dr ug file lo okup ; 16 Mar 2017 10:57 PM | |
| 606 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **3,7,15,1 6,20,24,29 ,38,68,61, 87,90,127, | |
| 607 | 147,170,18 9,192,200, 203**;9/30 /97;Build 29 | |
| 608 | ; | |
| 609 | ; Reference to ^PS(50. 605 suppor ted by DBI A #2138 | |
| 610 | ; Reference to ^PS(50. 608 suppor ted by DBI A #2136 | |
| 611 | ; Reference to ^PS(50. 609 suppor ted by DBI A #2137 | |
| 612 | ; Reference to ^PS(50. 607 suppor ted by DBI A #2221 | |
| 613 | ; Reference to $$FORMR X^PSNAPIS( DA,K,.LIST ) supporte d by DBIA #2574 | |
| 614 | ; Reference to $$FORMI ^PSNAPIS(P 1,P3) supp orted by D BIA #2574 | |
| 615 | ; Reference to $$PSJDF ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 616 | ; Reference to $$PSJST ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 617 | ; Reference to $$PROD2 ^PSNAPIS(P 1,P3) supp orted by D BIA #2531 | |
| 618 | ; Reference to $$CPTIE R^PSNAPIS( P1,P3) sup ported by DBIA #2531 | |
| 619 | ; Reference to $$VAGN^ PSNAPIS(P1 ) supporte d by DBIA #2531 | |
| 620 | ; Reference to ^PSNDF( 50.68 supp orted by D BIA 3735 | |
| 621 | ; Reference to FMTE^XL FDT suppor ted by DBI A 10103 | |
| 622 | ; | |
| 623 | START S QUIT=0,PS SFG=0 D KI LL F PSSXX =1:1 D PIC K Q:PSSFG | |
| 624 | DONE D KILL K PS SDAT,PSSDT ,PSSERR,PS SFG,PSSMAX ,PSSXX,PSS USR,PSSVAL ,PSSX,QUIT | |
| 625 | ,FM,FMS,Y2 K | |
| 626 | Q | |
| 627 | PICK W ! K DIC S DIC="^PSD RUG(",DIC( 0)="AEQMVT N",DIC("T" )="",DIC(" W")="S PSS | |
| 628 | TDRUG=Y D GETTIER^PS SDEE(PSSTD RUG)" D ^D IC K DIC I Y<0 S PSS FG=1 Q | |
| 629 | S IFN=+Y D NDDATA,GET DATA,INACT ,NOD66,FOR MAT,KILL | |
| 630 | Q | |
| 631 | NDDATA I $D(^PSDRU G(IFN,"ND" )) S CLPTR =$P(^PSDRU G(IFN,"ND" ),"^",6) I $P(^PSDRU | |
| 632 | G(IFN,"ND" ),"^",2)]" " S NDNODE =^PSDRUG(I FN,"ND"),V AGNPTR=$P( NDNODE,"^" ,1),VAPN=$ | |
| 633 | P(NDNODE," ^",2),SZPT R=$P(NDNOD E,"^",4),T YPTR=$P(ND NODE,"^",5 ) D NDF,ND F1 | |
| 634 | Q | |
| 635 | NDF S DA=VAGNPT R,X=$$VAGN ^PSNAPIS(D A),VAGN=X, PS=$P(^PS( 50.609,SZP TR,0),"^", | |
| 636 | 1),PT=$P(^ PS(50.608, TYPTR,0)," ^",1),P3=$ P(NDNODE," ^",3) | |
| 637 | K X S DA=VA GNPTR,K=P3 ,X=$$PROD2 ^PSNAPIS(D A,K) I X]" ",$P(X,"^" )]"" S VAP | |
| 638 | RN=$P(X,"^ "),VADU=$P (X,"^",4), CMOPID=$P( X,"^",2) | |
| 639 | S CSF="" I $P(NDNODE, "^",3) S C SF=$$GET1^ DIQ(50.68, $P(NDNODE, "^",3),19, | |
| 640 | "I") | |
| 641 | Q | |
| 642 | IT S CMOPID=$P (X,"^",2) | |
| 643 | Q | |
| 644 | NDF1 S X=$$PSJDF ^PSNAPIS(D A,K),VADF= $P(X,"^",2 ) | |
| 645 | Q | |
| 646 | INACT S ACT="" I $D(^PSDRUG (IFN,"I")) S Y=$P(^P SDRUG(IFN, "I"),"^",1 ) X ^DD("D | |
| 647 | D") S ACT= Y | |
| 648 | Q | |
| 649 | GETDATA S NODE0=^PS DRUG(IFN,0 ),GN=$P(NO DE0,"^",1) ,CL=$P(NOD E0,"^",2), DEA=$P(NOD | |
| 650 | E0,"^",3), WRN=$P(NOD E0,"^",8), NF=$P(NODE 0,"^",9),M ESS=$P(NOD E0,"^",10) ,VNF=$P(NO | |
| 651 | DE0,"^",11 ),CLASS="" ,WARN="" S :NF=1 NF=" N/F" S:VNF =1 VNF="V- N/F" | |
| 652 | S PSSNODE=$ G(^PSDRUG( IFN,"DOS") ) | |
| 653 | S PSSX=$Q(^ PSDRUG(IFN ,950)),PSS MAX=$P(@PS SX,"^",3) | |
| 654 | D GETS^DIQ( 50.03,PSSM AX_","_IFN _",","*"," E","PSSDAT ","PSSERR" ) | |
| 655 | S PSSDT=$G( PSSDAT(50. 03,PSSMAX_ ","_IFN_", ",.01,"E") ) | |
| 656 | S PSSUSR=$G (PSSDAT(50 .03,PSSMAX _","_IFN_" ,",1,"E")) | |
| 657 | S PSSVAL=$G (PSSDAT(50 .03,PSSMAX _","_IFN_" ,",3,"E")) | |
| 658 | I CL]"" S C LASS=CL_" "_$P(^PS( 50.605,CLP TR,0),"^", 2) | |
| 659 | I $D(^PSDRU G(IFN,3)) S:$P(^PSDR UG(IFN,3), "^")=0 CMO P="NO" S:$ P(^PSDRUG( | |
| 660 | IFN,3),"^" )=1 CMOP=" YES" | |
| 661 | I $D(^PSDRU G(IFN,5)) S QDM=^PSD RUG(IFN,5) | |
| 662 | S OINM="" S NDC="" I $D(^PSDRUG (IFN,2)) S NODE2=^PS DRUG(IFN,2 ) S:$P(NOD | |
| 663 | E2,"^",1)] "" OIPTR=$ P(NODE2,"^ ",1) S NDC =$P(NODE2, "^",4) S:$ P(NODE2,"^ ",6)]"" PD | |
| 664 | PTR=$P(NOD E2,"^",6) S APP=$P(N ODE2,"^",3 ),FM="" D TWOA | |
| 665 | Q | |
| 666 | TWOA I $D(OIPTR) S OI=$P(^ PS(50.7,OI PTR,0),"^" ,1),DFPTR= $P(^PS(50. 7,OIPTR,0) | |
| 667 | ,"^",2),DF =$P(^PS(50 .606,DFPTR ,0),"^",1) ,FMS=$P(^P S(50.7,OIP TR,0),"^", 12) S:FMS] | |
| 668 | "" FM=" (N /F)" S OIN M=OI_" "_D F_FM | |
| 669 | ; I $D(PDPTR ) S PD=$P( ^PS(50.3,P DPTR,0),"^ ",1) | |
| 670 | Q | |
| 671 | NOD66 S (DUPOU,PP DU,PPOU,DU ,SS)="" I $D(^PSDRUG (IFN,660)) S NDE=^PS DRUG(IFN,6 | |
| 672 | 60),OUPTR= $P(NDE,"^" ,2),PPOU=$ P(NDE,"^", 3),DUPOU=$ P(NDE,"^", 5),PPDU=$P (NDE,"^",6 | |
| 673 | ),SS=$P(ND E,"^",7),D U=$P(NDE," ^",8) I OU PTR]"" S O U=$P(^DIC( 51.5,OUPTR ,0),"^") | |
| 674 | Q | |
| 675 | SYN I $D(^PSDRU G(IFN,1,0) ) F ZZZ=0: 0 S ZZZ=$O (^PSDRUG(I FN,1,ZZZ)) Q:'ZZZ S | |
| 676 | SYNM=$P(^ PSDRUG(IFN ,1,ZZZ,0), "^",1),INT =$P(^PSDRU G(IFN,1,ZZ Z,0),"^",3 ) D SYN1 | |
| 677 | Q | |
| 678 | SYN1 S INT=$S(IN T=0:"Trade Name",INT =1:"Quick Code",INT= "C":"Ctrl Substances | |
| 679 | ",INT="D": "Drug Acco untability ",1:"") D FULL Q:$G( QUIT) W ? 14,SYNM,?5 5,INT,! | |
| 680 | Q | |
| 681 | SYN2 S :INT=0 INT ="Trade" S :INT=1 INT ="Quick" S :INT="C" I NT="Ctrl S ubs" S:INT | |
| 682 | ="D" INT=" Drug Acct" W ?16,SYN M,?57,INT, ! | |
| 683 | Q | |
| 684 | IFCAP I $D(^PSDRU G(IFN,441, 0)) F QQQ= 0:0 S QQQ= $O(^PSDRUG (IFN,441,Q QQ)) Q:'QQ | |
| 685 | Q S IFCAP NM=$P(^PSD RUG(IFN,44 1,QQQ,0)," ^",1) | |
| 686 | Q | |
| 687 | FORMAT ; BEGIN WRI TING | |
| 688 | N DAW,PSSWS ITE | |
| 689 | W @IOF,"DRU G NAME: ", GN," (IEN : ",IFN,") ",! | |
| 690 | F XX=1:1:77 W "=" | |
| 691 | W ! | |
| 692 | W :$D(VAPRN) "VA PRINT NAME: ",? 17,VAPRN W :$D(CMOPID ) ?60,"CMO P ID#: ",C | |
| 693 | MOPID W:$D (VAPN) !," VA PRODUCT NAME: ",? 17,VAPN W: $D(CMOP) ? 60,"CMOP D ISPENSE: " | |
| 694 | ,CMOP | |
| 695 | W :$D(OINM) !,"ORDERAB LE ITEM: " ,?17,OINM W:$D(VAPN) ?60,"NDF DF: ",VADF | |
| 696 | I $D(OIPTR) ,OIPTR]"" W !,"ORDER ABLE ITEM TEXT: ",! D OITXT | |
| 697 | W :$D(PD) !, "PRIMARY D RUG: ",?17 ,PD | |
| 698 | W !,"SYNONY M(S): " D SYN D FULL Q:$G(QUIT ) W !,"ME SSAGE: ",M ESS,! | |
| 699 | D FULL Q:$G (QUIT) F XX=1:1:77 W "-" | |
| 700 | W ! | |
| 701 | D FULL Q:$G (QUIT) W "DEA, SPEC IAL HDLG: ",DEA,?48, "NDC: ",?6 3,NDC | |
| 702 | S DAW=+$$GE T1^DIQ(50, IFN,81) | |
| 703 | D FULL Q:$G (QUIT) W !,"DAW COD E: ",DAW, " - ",$$DA WEXT^PSSDA WUT(DAW) | |
| 704 | D FULL Q:$G (QUIT) W !,"CS FEDE RAL SCHEDU LE: ",$G(C SF) | |
| 705 | D FULL Q:$G (QUIT) W !,"INACTIV E DATE: ", ACT | |
| 706 | D FULL Q:$G (QUIT) W: $D(QDM) !, "QUANTITY DISPENSE M ESSAGE: ", QDM,! | |
| 707 | D FULL Q:$G (QUIT) I WRN]"" W ! ,"WARNING LABEL: " S X=WRN F Z 0=1:1 Q:$P | |
| 708 | (X,",",Z0, 99)="" S Z1=$P(X,", ",Z0) W:$D (^PS(54,Z1 ,0)) ?19,$ P(^(0),"^" ,1),! I '$ | |
| 709 | D(^(0)) W ?19,"NO SU CH WARNING LABEL" K X Q | |
| 710 | D FULL Q:$G (QUIT) S PSSLOOK=1 D | |
| 711 | . N DRUG | |
| 712 | . I $P($G(^P SDRUG(IFN, 0)),"^")=" " K PSSLOO K Q | |
| 713 | . S PSSWSITE =+$O(^PS(5 9.7,0)) W !,"WARNING LABEL SOU RCE is " D | |
| 714 | . .I $P($G(^ PS(59.7,PS SWSITE,10) ),"^",9)=" N" W "set to 'NEW'" Q | |
| 715 | . .W "not se t to 'NEW' " | |
| 716 | . K PSSWRN | |
| 717 | . D FULL Q:$ G(QUIT) W !,"NEW WA RNING LABE L:" | |
| 718 | . S ^TMP("PS SWRNB",$J, $P(^PSDRUG (IFN,0),"^ "))="" D ^ PSSWRNE | |
| 719 | . K PSSLOOK, ^TMP("PSSW RNB",$J),P SSWRN | |
| 720 | D FULL Q:$G (QUIT) W: '$D(QDM) ! F XX=1:1: 77 W "-" | |
| 721 | D FULL Q:$G (QUIT) W ! | |
| 722 | W "ORDER UN IT: ",?27 W:$D(OU) O U W ?40,"P RICE/ORDER UNIT: ",? 67,PPOU | |
| 723 | D FULL Q:$G (QUIT) W !,"DISPENS E UNIT: ", ?27,DU W:$ D(VADU) ?4 0,"VA DISP | |
| 724 | ENSE UNIT: ",?67,VAD U | |
| 725 | D FULL Q:$G (QUIT) W !,"DISPENS E UNITS/OR DER UNIT: ",?21,DUPO U,?40,"PRI | |
| 726 | CE/DISPENS E UNIT: ", ?67,PPDU | |
| 727 | D :$G(PSSVAL )]"" | |
| 728 | . D FULL Q: $G(QUIT) W !,"DATE PRICE/DISP ENSE UNIT LAST CHANG ED: ",?27 | |
| 729 | ,PSSDT | |
| 730 | . D FULL Q: $G(QUIT) W !,"BY: ",PSSUSR,? 27,"VALUE: ",PSSVAL | |
| 731 | D FULL Q:$G (QUIT) W !,"NCPDP D ISPENSE UN IT: ",$$GE T1^DIQ(50, IFN,82),?4 | |
| 732 | 0,"NCPDP Q UANTITY MU LTIPLIER: ",?67,$J($ $GET1^DIQ( 50,IFN,83) ,8,3) | |
| 733 | D FULL Q:$G (QUIT) W !,"MAXIMUM DAYS SUPP LY: ",$$GE T1^DIQ(50, IFN,66) | |
| 734 | D FULL Q:$G (QUIT) W !,"ePharma cy Billabl e: ",$$GET 1^DIQ(50,I FN,84) | |
| 735 | D FULL Q:$G (QUIT) W !?2,"ePhar macy Billa ble (TRICA RE): ",$$G ET1^DIQ(50 | |
| 736 | ,IFN,85) W ?40,"ePha rmacy Bill able (CHAM PVA): ",$$ GET1^DIQ(5 0,IFN,86) | |
| 737 | D FULL Q:$G (QUIT) W !,"Sensiti ve Diagnos is Drug: " ,$$GET1^DI Q(50,IFN,8 | |
| 738 | 7) W ! | |
| 739 | D FULL Q:$G (QUIT) W !,"APPL PK G USE:" S APPL="" S: '$D(APP) A PPL=" NON | |
| 740 | E" | |
| 741 | I $D(APP) D | |
| 742 | . S:APP["O" APPL=APPL _" Outpat ient" S:AP P["U" APPL =APPL_" U nit Dose" | |
| 743 | . S:APP["I" APPL=APPL _" IV" S: APP["W" AP PL=APPL_" Ward Stoc k" | |
| 744 | . S:APP["N" APPL=APPL _" Contro l Subs" S: APP["X" AP PL=APPL_" Non-VA Me | |
| 745 | d" | |
| 746 | . S:APPL="" APPL=" N ONE" | |
| 747 | W ?13,APPL | |
| 748 | I $P(PSSNOD E,"^",2) S (PSSCALC, PSSUNIT)=$ P($G(^PS(5 0.607,+$P( PSSNODE,U, | |
| 749 | 2),0)),U), PSSSTR=$P( PSSNODE,"^ ") | |
| 750 | I $G(PSSUNI T)'="",$G( PSSUNIT)[" /" D UNCAL C | |
| 751 | D FULL Q:$G (QUIT) W !,"STRENGT H: ",$S($E ($P(PSSNOD E,U),1)=". ":"0",1:"" | |
| 752 | )_$P(PSSNO DE,U),?35, "UNIT: ",$ G(PSSCALC) | |
| 753 | D FULL Q:$G (QUIT) W !,"POSSIBL E DOSAGES: " | |
| 754 | I $D(^PSDRU G(IFN,"DOS 1",0)) F P DS=0:0 S P DS=$O(^PSD RUG(IFN,"D OS1",PDS)) | |
| 755 | Q:'PDS D | |
| 756 | . S POSDOS=^ PSDRUG(IFN ,"DOS1",PD S,0) | |
| 757 | . D FULL Q:$ G(QUIT) W !," DIS PENSE UNIT S PER DOSE : ",$S($E( $P(POSDOS, | |
| 758 | U),1)=".": "0",1:"")_ $P(POSDOS, U),?40,"DO SE: ",$S($ E($P(POSDO S,U,2),1)= ".":"0",1: | |
| 759 | "")_$P(POS DOS,U,2),? 55,"PACKAG E: ",$P(PO SDOS,U,3) | |
| 760 | . D FULL Q:$ G(QUIT) W !," BCMA UNIT S PER DOSE : ",$P(POS DOS,U,4) | |
| 761 | D FULL Q:$G (QUIT) W !,"LOCAL P OSSIBLE DO SAGES:" | |
| 762 | I $D(^PSDRU G(IFN,"DOS 2",0)) F P DS=0:0 S P DS=$O(^PSD RUG(IFN,"D OS2",PDS)) | |
| 763 | Q:'PDS D | |
| 764 | . S LPDOS=^P SDRUG(IFN, "DOS2",PDS ,0) | |
| 765 | . D FULL Q:$ G(QUIT) W !," LOC AL POSSIBL E DOSAGE: " D | |
| 766 | . .I $L($P(L PDOS,U))'> 27 W $P(LP DOS,U),?55 ,"PACKAGE: ",$P(LPDO S,U,2) | |
| 767 | . .E W !,? 10,$P(LPDO S,U),!,?55 ,"PACKAGE: ",$P(LPDO S,U,2) | |
| 768 | . .D FULL Q: $G(QUIT) W !," BCMA UNITS PER DOSE: ",$P(LPDO S,U,3) D F | |
| 769 | ULL Q:$G(Q UIT) D LP DNW | |
| 770 | D FULL Q:$G (QUIT) W ! F XX=1:1 :77 W "-" | |
| 771 | D FULL Q:$G (QUIT) W !,"VA CLAS S: ",$G(CL ASS) | |
| 772 | D FULL Q:$G (QUIT) W !,"LOCAL N ON-FORMULA RY: ",$G(N F)," ","VIS | |
| 773 | N NON-FORM ULARY: ",$ G(VNF) | |
| 774 | N DA,K,LIST ,PSXDN,PSX GN,PSXVP,X ,XX1,XX2 | |
| 775 | K PSXGN,PSX VP I $D(^P SDRUG(IFN, "ND")) S P SXDN=$G(^P SDRUG(IFN, "ND")),PSX | |
| 776 | GN=$P(PSXD N,"^"),PSX VP=$P(PSXD N,"^",3) | |
| 777 | I $G(PSXGN) ,$G(PSXVP) S X=$$PRO D2^PSNAPIS (PSXGN,PSX VP),XX1=$$ FORMI^PSNA | |
| 778 | PIS(PSXGN, PSXVP) | |
| 779 | D FULL Q:$G (QUIT) W !,"Nationa l Formular y Indicato r: "_$S($G (XX1)=1:"Y | |
| 780 | ES",$G(XX1 )=0:"NO",1 :"Not Matc hed to NDF ") | |
| 781 | I $D(^PSDRU G(IFN,65,0 )) D FULL Q:$G(QUIT) W !,"FOR MULARY ALT ERNATIVES: | |
| 782 | ",! F FA= 0:0 S FA=$ O(^PSDRUG( IFN,65,FA) ) Q:'FA S LDFPTR=$P ($G(^PSDRU G(IFN,65,F | |
| 783 | A,0)),"^") I LDFPTR D FULL Q:$ G(QUIT) W ?26,$P($G (^PSDRUG(L DFPTR,0)), "^"),! | |
| 784 | N CPDATE,PS STIER D NO W^%DTC S C PDATE=$P(% ,".") S PS STIER=$$CP TIER^PSNAP | |
| 785 | IS($P($G(^ PSDRUG(IFN ,"ND")),"^ ",3),CPDAT E,IFN,1) K CPDATE,% | |
| 786 | ; PSSTIER = Copay Ti er^Effecti ve Date^En d Date | |
| 787 | W !,"Copay Tier: ",$P (PSSTIER," ^",1) | |
| 788 | W !,"Copay Effective Date: " S Y=$P(PSSTI ER,"^",2) D DD^%DT W Y K Y | |
| 789 | D FULL Q:$G (QUIT) I $G(PSXGN), $G(PSXVP) W !,"Natio nal Restri ction: " S | |
| 790 | XX2=$$FOR MRX^PSNAPI S(PSXGN,PS XVP,.LIST) I $G(XX2) =1,$D(LIST ) F XX2=0: 0 S XX2=$O | |
| 791 | (LIST(XX2) ) Q:'XX2 D FULL Q:$ G(QUIT) W !,LIST(XX 2,0) | |
| 792 | W !,"Local Drug Text: ",! I $D( ^PSDRUG(IF N,9,0)) D LDT | |
| 793 | Q | |
| 794 | LDT F TXT1=0:0 S TXT1=$O( ^PSDRUG(IF N,9,TXT1)) Q:'TXT1 S TEXPTR=^ PSDRUG(IFN | |
| 795 | ,9,TXT1,0) F PPP=0:0 S PPP=$O( ^PS(51.7,T EXPTR,2,PP P)) Q:'PPP S PST=$P ($G(^PS(51 | |
| 796 | .7,TEXPTR, 0)),"^",2) I 'PST S WPT=^PS(51 .7,TEXPTR, 2,PPP,0) D FULL Q:$G (QUIT) W | |
| 797 | WPT,! | |
| 798 | ; | |
| 799 | ; | |
| 800 | KILL K IFN,APP,I NT,VADU,VA GN,VAPN,VA PRN,P3,VAG NPTR,MESS, CLASS,DEA, ACT,CL,CLP | |
| 801 | TR,CMOP,DF ,DFPTR,DU, DUPOUGN,IF CAPNM,NDC, NDE,NDNODE ,NF,NODE0, NODE2,OI,O INM,OIPTR, | |
| 802 | OU,PD,PDPT R,PPDU,PPO U,PS,PT,NO D66,SYNM,S ZPTR,TYPTR ,WARN,WRN, XX,ZZZ,SS, OUPTR,CMOP | |
| 803 | ID | |
| 804 | K DUPOU,QQQ ,GN,QDM,AP PL,VADF,DF P,DFRM,Y,Z 0,Z1,DDD,P PP,TEXT,TX TPTR,TXT,T | |
| 805 | XT1,TEXPTR ,VNF,WPT,F A,LDFPTR,T EXTPTR,QUI T,PST,D0,D A,K,DIR | |
| 806 | K PSSNODE,P SDOSUN,PDS ,POSDOS,LP DOS,CSF,PS SSTR,PSSUN IT,PSSCALC ,PSSTIER | |
| 807 | Q | |
| 808 | OITXT I $D(^PS(50 .7,OIPTR,1 ,0)) F TXT =0:0 S TXT =$O(^PS(50 .7,OIPTR,1 ,TXT)) Q:' | |
| 809 | TXT S TEX TPTR=^PS(5 0.7,OIPTR, 1,TXT,0) F DDD=0:0 S DDD=$O(^P S(51.7,TEX TPTR,2,DDD | |
| 810 | )) Q:'DDD D IDATE I 'Y2K S TE XT=^PS(51. 7,TEXTPTR, 2,DDD,0) D FULL Q:$G (QUIT) W | |
| 811 | TEXT,! | |
| 812 | Q | |
| 813 | FULL D :($Y+5)>IO SL&('$G(QU IT)) FSCRN | |
| 814 | Q | |
| 815 | FSCRN Q :$G(QUIT) W ! K DIR S DIR(0)= "E",DIR("A ")="Press Return to continue,' | |
| 816 | ^' to exit " D ^DIR W @IOF S:Y' =1 QUIT=1 | |
| 817 | Q | |
| 818 | IDATE S Y2K=$P($G (^PS(51.7, TEXTPTR,0) ),"^",2) | |
| 819 | Q | |
| 820 | UNCALC ; | |
| 821 | N PSSVA,PSS VA1,PSSVB, PSSVB1,PSS DASH,PSSND FS,PSSDASH 2,PSSDASH3 ,PSSDASH5 | |
| 822 | K PSSCALC | |
| 823 | S PSSDASH=0 S PSSNDFS =$$PSJST^P SNAPIS(+$P ($G(^PSDRU G(IFN,"ND" )),"^"),+$ | |
| 824 | P($G(^PSDR UG(IFN,"ND ")),"^",3) ) S PSSNDF S=+$P($G(P SSNDFS),"^ ",2) | |
| 825 | I $G(PSSNDF S),$G(PSSS TR),+$G(PS SSTR)'=+$G (PSSNDFS) S PSSDASH= 1 | |
| 826 | S PSSVA=$P( PSSUNIT,"/ "),PSSVB=$ P(PSSUNIT, "/",2),PSS VA1=+$G(PS SVA),PSSVB | |
| 827 | 1=+$G(PSSV B) | |
| 828 | I $G(PSSDAS H) S PSSDA SH2=PSSSTR /PSSNDFS,P SSDASH3=PS SDASH2*$S( $G(PSSVB1) | |
| 829 | :PSSVB1,1: 1) S PSSDA SH5=$S('$G (PSSVB1):P SSDASH3_$G (PSSVB),1: PSSDASH3_$ P(PSSVB,PS | |
| 830 | SVB1,2)) | |
| 831 | S PSSCALC=$ S($G(PSSDA SH):$S('$G (PSSVA1):P SSVA,1:$P( PSSVA1,PSS VA1,2))_"/ | |
| 832 | "_$G(PSSDA SH5),1:PSS UNIT) | |
| 833 | Q | |
| 834 | ; | |
| 835 | LPDNW ; Display Do se Unit an d Numeric Dose field s, added w ith patch PSS*1*147 | |
| 836 | N PSSLKL1,P SSLKL2,PSS LKL3,PSSLK L4 | |
| 837 | S PSSLKL4=" " | |
| 838 | S PSSLKL1=$ P(LPDOS,"^ ",5),PSSLK L2=$P(LPDO S,"^",6) | |
| 839 | I PSSLKL1 S PSSLKL4=$ P($G(^PS(5 1.24,+PSSL KL1,0)),"^ ") | |
| 840 | S PSSLKL3=$ S($E(PSSLK L2)=".":"0 ",1:"")_PS SLKL2 | |
| 841 | I $L(PSSLKL 3)<18 D FU LL Q:$G(QU IT) W !?5 ,"NUMERIC DOSE: "_PS SLKL3,?38, | |
| 842 | "DOSE UNIT : "_PSSLKL 4 Q | |
| 843 | D FULL Q:$G (QUIT) W !?5,"NUMER IC DOSE: " _PSSLKL3 | |
| 844 | D FULL Q:$G (QUIT) W !?38,"DOSE UNIT: "_P SSLKL4 | |
| 845 | Q | |
| 846 | ========== ========== ========== ========== ========== ========== ======== | |
| 847 | PSSDEEA (N ew) | |
| 848 | ||
| 849 | PSSDEEA ; PBM/RMS - DRUG FILE ENTER/EDIT AUDIT ; 0 1 Feb 2017 4:55 PM | |
| 850 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **203**;;B uild 1 | |
| 851 | ; ---------- ---------- ---------- ---------- ---------- ---------- ------ | |
| 852 | BEFORE(TAG ) ; | |
| 853 | ; Capture t he drug en try before it is edi ted to hav e to compa re to | |
| 854 | ; after the user comp letes the editing. Email chan ges in | |
| 855 | ; linetag ' AFTER' (ca lled at th e end of P SSDEE). | |
| 856 | ; From: PSS DEE [PSS D RUG ENTER/ EDIT] | |
| 857 | ; Output: | |
| 858 | ; 1. ^UTI LITY(TAG,$ J,DA)=Drug file entr y number D A before e diting | |
| 859 | ; 2. ZDA ; DA or IE N of Drug file #50 e ntry | |
| 860 | ; 3. ZN ; Will b e equal to 1 if a ne w drug was entered i nto file | |
| 861 | ; | |
| 862 | ; ZEXCEPT: D A,Y,ZDA,ZN | |
| 863 | ; | |
| 864 | K ^UTILITY( TAG,$J,DA) | |
| 865 | M ^UTILITY( TAG,$J,DA) =^PSDRUG(D A) | |
| 866 | ; | |
| 867 | S ZDA=DA,ZN =$P(Y,"^", 3) | |
| 868 | ; | |
| 869 | Q | |
| 870 | ; ---------- ---------- ---------- ---------- ---------- ---------- ------ | |
| 871 | AFTER(TAG) ; | |
| 872 | ; | |
| 873 | ; DOCUMENTA TION AND S ETUP INFOR MATION | |
| 874 | ; | |
| 875 | ; Modificat ions: | |
| 876 | ; | |
| 877 | ; * PSSDEE calls BEFO RE^PSSDEEA to create ^UTILITY( "PSSDEE",$ J,DA) data | |
| 878 | . | |
| 879 | ; ^UTILIT Y data hol ds all ^PS DRUG data for drug p rior to an y | |
| 880 | ; editing . | |
| 881 | ; * PSSDEE later call s AFTER^PS SDEEA to c ompare the value of the drug | |
| 882 | ; file en try after editing to the pre-s napshot va lues held in | |
| 883 | ; ^UTILIT Y. If cha nges have been made, a Mailman message i s | |
| 884 | ; sent to members o f a mail g roup. (Se e SETUP be low) | |
| 885 | ; | |
| 886 | ; Note: USI NG the Dru g Enter/Ed it option is suffici ent to tri gger | |
| 887 | ; the audit email, ev en if a no n-audited field is t he only ch ange | |
| 888 | ; made by t he user. | |
| 889 | ; | |
| 890 | ; ZEXCEPT: PSSZMES,PS SZNOC,ANS, CHANGES,CO UNT,FIELD, FLAG,LABEL ,NEWVAL,OL | |
| 891 | DVAL,USER, ZDA,ZDAN,Z N,PSSZNODE ,ZZJ | |
| 892 | EN Q :'$G(ZDA) | |
| 893 | N COUNT,USE R S COUNT= 6,USER=$P( ^VA(200,DU Z,0),"^"), ZDAN=$P(^P SDRUG(ZDA, | |
| 894 | 0),"^") | |
| 895 | D HEADER | |
| 896 | D COMPAR | |
| 897 | D SEND | |
| 898 | K PSSZMES,Z DA,ZDAN,LA BEL,PSSZNO DE,OLDVAL, NEWVAL,FIE LD,CHANGES ,FLAG,ZZJ, | |
| 899 | ANS,ZN,PSS ZNOC | |
| 900 | S NEWVAL="" | |
| 901 | Q | |
| 902 | HEADER ; HEADER FOR FIELDS CH ANGED IN T HE DRUG EN TER/EDIT O PTION | |
| 903 | ; ZEXCEPT: PSSZMES,US ER,ZDAN | |
| 904 | S PSSZMES(1 )="Please Note: The Drug Ente r/Edit opt ion was us ed by "_US | |
| 905 | ER_"." | |
| 906 | S PSSZMES(2 )="The dru g that was entered/e dited was "_ZDAN_"." | |
| 907 | S PSSZMES(3 )="------- ---------- ---------- ---------- ---------- ---------- | |
| 908 | ---------- ---------- --" | |
| 909 | Q | |
| 910 | COMPAR ; | |
| 911 | ; ZEXCEPT: PSSZMES,AN S,FLAG,LAB EL,NEWVAL, OLDVAL,ZDA ,TAG,PSSZN OC | |
| 912 | N CHANGES,N EWVAL,OLDV AL,SPACES, PSSZNODE,Z ZJ | |
| 913 | S $P(SPACES ," ",80)=" ",PSSZNOC= 0 | |
| 914 | F PSSZNODE= 0,2,3,8.5, 660,660.1, "EPH","I", "ND" I $G( ZDA) D | |
| 915 | . S:ZN=1 ^UT ILITY(TAG, $J,ZDA,PSS ZNODE)="" | |
| 916 | . Q:'$D(^PSD RUG(ZDA,PS SZNODE))&( '$D(^UTILI TY(TAG,$J, ZDA,PSSZNO DE))) | |
| 917 | . I '$D(^UTI LITY(TAG,$ J,ZDA,PSSZ NODE))&($D (^PSDRUG(Z DA,PSSZNOD E))) S CHA | |
| 918 | NGES(PSSZN ODE)=^PSDR UG(ZDA,PSS ZNODE) | |
| 919 | . I '$D(^PSD RUG(ZDA,PS SZNODE))&( $D(^UTILIT Y(TAG,$J,Z DA,PSSZNOD E))) S CHA | |
| 920 | NGES(PSSZN ODE)=^UTIL ITY(TAG,$J ,ZDA,PSSZN ODE) | |
| 921 | . Q:$D(CHANG ES(PSSZNOD E))!('$D(^ PSDRUG(ZDA ,PSSZNODE) ))!('$D(^U TILITY(TAG | |
| 922 | ,$J,ZDA,PS SZNODE))) | |
| 923 | . Q:^UTILITY (TAG,$J,ZD A,PSSZNODE )=^PSDRUG( ZDA,PSSZNO DE) | |
| 924 | . S CHANGES( PSSZNODE)= "" | |
| 925 | . F ZZJ=1:1: 10 S FLAG= 0,ANS="" S :$P(^PSDRU G(ZDA,PSSZ NODE),"^", ZZJ)'=$P(^ | |
| 926 | UTILITY(TA G,$J,ZDA,P SSZNODE)," ^",ZZJ) AN S=$P(^UTIL ITY(TAG,$J ,ZDA,PSSZN ODE),"^",Z | |
| 927 | ZJ),FLAG=1 S:FLAG=1& (ANS="") A NS="NULL" S CHANGES( PSSZNODE)= CHANGES(PS SZNODE)_AN | |
| 928 | S_"^" | |
| 929 | I '$D(CHANG ES) S PSSZ NOC=1,PSSZ MES(4)=" *** N o Audited Changes Ma | |
| 930 | de ***" Q | |
| 931 | S FLAG=0 | |
| 932 | F PSSZNODE= 0,2,3,8.5, 660,660.1, "EPH","I", "ND" S LAB EL="SUB"_P SSZNODE I | |
| 933 | $D(CHANGES (PSSZNODE) ) F ZZJ=1: 1:11 Q:"^^ ^^^^^^^^^^ ^^^^^"[$P( CHANGES(PS SZNODE),"^ | |
| 934 | ",ZZJ,11) Q:$P(CHAN GES(PSSZNO DE),"^",ZZ J,11)="" D:'$D(^UTI LITY(TAG,$ J,ZDA)) SE | |
| 935 | TLB Q:FLAG D | |
| 936 | . S OLDVAL=$ P(CHANGES( PSSZNODE), "^",ZZJ) Q :OLDVAL="" S OLDVAL =OLDVAL_$$ | |
| 937 | OLDEXT(OLD VAL,PSSZNO DE,ZZJ) | |
| 938 | . S:$D(^PSDR UG(ZDA,PSS ZNODE)) NE WVAL=$P(^P SDRUG(ZDA, PSSZNODE), "^",ZZJ)_$ | |
| 939 | $NEWEXT(ZD A,PSSZNODE ,ZZJ) | |
| 940 | . D STOR | |
| 941 | Q | |
| 942 | OLDEXT(OLD VAL,PSSZNO DE,PIECE) ;COMPUTE E XTERNAL 'O LD' VALUE WHERE NECE SSARY | |
| 943 | N FIELDNUM, FIELDTYP,P TRFILE | |
| 944 | S FIELDNUM= $O(^DD(50, "GL",PSSZN ODE,PIECE, 0)) | |
| 945 | Q :'+FIELDNU M "" | |
| 946 | S FIELDTYP= $P(^DD(50, FIELDNUM,0 ),U,2) | |
| 947 | I $E(FIELDT YP)'="P" Q "" | |
| 948 | S PTRFILE=+ $E(FIELDTY P,2,99) | |
| 949 | Q " ("_$$GE T1^DIQ(PTR FILE,OLDVA L,.01)_")" | |
| 950 | NEWEXT(ZDA ,PSSZNODE, PIECE) ;CO MPUTE EXTE RNAL 'NEW' VALUE WHE RE NECESSA RY | |
| 951 | N FIELDNUM, INTERNAL,E XTERNAL | |
| 952 | S FIELDNUM= $O(^DD(50, "GL",PSSZN ODE,PIECE, 0)) | |
| 953 | Q :'+FIELDNU M "" | |
| 954 | S EXTERNAL= $$GET1^DIQ (50,ZDA,FI ELDNUM) | |
| 955 | S INTERNAL= $$GET1^DIQ (50,ZDA,FI ELDNUM,"I" ) | |
| 956 | Q :(INTERNAL =EXTERNAL) "" | |
| 957 | Q " ("_EXTE RNAL_")" | |
| 958 | SEND ; | |
| 959 | ; ZEXCEPT: ZDA,ZDAN,P SSZNOC | |
| 960 | N XMDUZ,XMS UB,XMTEXT, XMY | |
| 961 | S XMSUB=$S( PSSZNOC:"D RUG ENTER/ EDIT ACCES S (",1:"DR UG ENTER/E DIT AUDIT | |
| 962 | (")_$G(ZDA )_":"_$G(Z DAN)_")",X MDUZ=$S($G (DUZ):DUZ, 1:.5) | |
| 963 | S XMTEXT="P SSZMES(" | |
| 964 | S XMY("G.PS S DEE AUDI T")="",XMY (DUZ)="" | |
| 965 | D ^XMD | |
| 966 | Q | |
| 967 | STOR ; STORES VAL UES INTO M AILMAN VAR IABLES | |
| 968 | ; ZEXCEPT: PSSZMES,CO UNT,FIELD, LABEL,NEWV AL,OLDVAL, SPACES | |
| 969 | S :LABEL["66 0.1" LABEL ="SUB6601" | |
| 970 | S :LABEL["8. 5" LABEL=" SUB85" | |
| 971 | S FIELD=$P( $T(@(LABEL )+ZZJ),";" ,3) | |
| 972 | ; S PSSZMES( COUNT)=FIE LD_$E(SPAC ES,1,30-$L (FIELD))_O LDVAL_$E(S PACES,1,30 | |
| 973 | -$L(OLDVAL ))_$G(NEWV AL),COUNT= COUNT+1 | |
| 974 | S PSSZMES(C OUNT)=FIEL D,COUNT=CO UNT+1 | |
| 975 | S PSSZMES(C OUNT)=$E(S PACES,1,5) _"OLD: "_O LDVAL,COUN T=COUNT+1 | |
| 976 | S PSSZMES(C OUNT)=$E(S PACES,1,5) _"NEW: "_$ G(NEWVAL), COUNT=COUN T+1 | |
| 977 | S PSSZMES(C OUNT)=" ", COUNT=COUN T+1 | |
| 978 | Q | |
| 979 | SETLB ; SETS $TEXT LABEL | |
| 980 | ; ZEXCEPT: LABEL,PSSZ NODE | |
| 981 | S LABEL=$S( PSSZNODE=0 :"SUB0",PS SZNODE=2:" SUB2",PSSZ NODE=3:"SU B3",PSSZNO | |
| 982 | DE=8.5:"SU B85",PSSZN ODE=660:"S UB660",PSS ZNODE=660. 1:"SUB6601 ",PSSZNODE ="EPH":"SU | |
| 983 | BEPH",PSSZ NODE="ND": "SUBND",1: "SUBI") | |
| 984 | Q | |
| 985 | SUB0 ; FIELDS FOR ^PSDRUG(Z DA,0) | |
| 986 | ; ;GENERIC N AME | |
| 987 | ; ;VA CLASSI FICATION | |
| 988 | ; ;DEA, SPEC IAL HDLG | |
| 989 | ; ;MAXIMUM D OSE PER DA Y | |
| 990 | ; ;STANDARD SIG | |
| 991 | ; ;FSN | |
| 992 | ; ;DRUG GROU P/INTERACT ION | |
| 993 | ; ;WARNING L ABEL | |
| 994 | ; ;NON-FORMU LARY | |
| 995 | ; ;MESSAGE | |
| 996 | SUB2 ; FIELDS FOR ^PSDRUG(Z DA,2) | |
| 997 | ; ;PHARMACY ORDERABLE ITEM | |
| 998 | ; ;RESTRICTI ON | |
| 999 | ; ;APPLICATI ON PACKAGE S' USE | |
| 1000 | ; ;NDC | |
| 1001 | ; ; | |
| 1002 | ; ;*PRIMARY DRUG | |
| 1003 | SUB3 ; FIELDS FOR ^PSDRUG(Z DA,3) | |
| 1004 | ; ;CMOP DISP ENSE | |
| 1005 | SUB85 ; | |
| 1006 | ; ;*ATC CANI STER | |
| 1007 | ; ;ATC MNEMO NIC | |
| 1008 | SUB660 ; FIELDS FOR ^PSDRUG(Z DA,660) | |
| 1009 | ; ;REORDER L EVEL | |
| 1010 | ; ;ORDER UNI T | |
| 1011 | ; ;PRICE PER ORDER UNI T | |
| 1012 | ; ;NORMAL AM OUNT TO OR DER | |
| 1013 | ; ;DISPENSE UNITS PER ORDER UNIT | |
| 1014 | ; ;PRICE PER DISPENSE UNIT | |
| 1015 | ; ;SOURCE OF SUPPLY | |
| 1016 | ; ;DISPENSE UNIT | |
| 1017 | SUB6601 ; FIELDS FOR ^PSDRUG(Z DA,660.1) | |
| 1018 | ; ;CURRENT I NVENTORY | |
| 1019 | SUBEPH ; FIELDS FOR ^PSDRUG(Z DA,"EPH") | |
| 1020 | ; ;DAW CODE | |
| 1021 | ; ;NCPDP DIS PENSE UNIT | |
| 1022 | ; ;NCPDP QUA NTITY MULT IPLIER | |
| 1023 | SUBI ; FIELDS FOR ^PSDRUG(Z DA,"I") | |
| 1024 | ; ;INACTIVE DATE | |
| 1025 | SUBND ; FIELDS FOR ^PSDRUG(Z DA,"ND") | |
| 1026 | ; ;NATIONAL DRUG FILE ENTRY | |
| 1027 | ; ;VA PRODUC T NAME | |
| 1028 | ; ;PSNDF VA PRODUCT NA ME ENTRY | |
| 1029 | ; ;PACKAGE S IZE | |
| 1030 | ; ;PACKAGE T YPE | |
| 1031 | ; ;NATIONAL DRUG CLASS | |
| 1032 | ; ; | |
| 1033 | ; ; | |
| 1034 | ; ; | |
| 1035 | ; ;CMOP ID | |
| 1036 | ; ;NATIONAL FORMULARY INDICATOR | |
| 1037 | ========== ========== ========== ========== ========== ========== ======== | |
| 1038 | PSSP203 (N ew) | |
| 1039 | ||
| 1040 | PSSP203 ; EPIP/WLC - POST-INST ALLATION F OR PACKAGE --CHECKS E XISTANCE O F MAIL GRO UP AND IF NOT CREATE S IT ; 08 Dec 2016 10:19 AM | |
| 1041 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **203**;12 /08/17;Bui ld 1 | |
| 1042 | ; | |
| 1043 | EN ; | |
| 1044 | N PSSMGPNM, PSSMGPOR,P SSMGPDS,PS SMGPRS,PSS MGPMY,PSSM GPNM,PSSMG PSL,PSSMGP | |
| 1045 | QT,PSSMGPT P | |
| 1046 | N DTOUT,DUO UT,Y | |
| 1047 | K XPDABORT, PSSMGPAR | |
| 1048 | ; If mail gr oup alread y exists q uit. | |
| 1049 | I $$FIND1^D IC(3.8,"", "X","PSS D EE AUDIT", "B") Q | |
| 1050 | S PSSMGPAR( 1)="A 'PSS DEE AUDIT ' Mail Gro up is now being crea ted. Mail | |
| 1051 | Group memb ers will" | |
| 1052 | S PSSMGPAR( 2)="receiv e notifica tions when ever there are modif ications p | |
| 1053 | erformed" | |
| 1054 | S PSSMGPAR( 3)="on the DRUG (#50 ) file thr ough PSS D RUG ENTER/ EDIT optio | |
| 1055 | n." | |
| 1056 | S PSSMGPAR( 4)="Please enter the Pharmacy ADPAC or a designee to be the | |
| 1057 | Mail Group Organizer ." | |
| 1058 | S PSSMGPAR( 5)=" " | |
| 1059 | S PSSMGPAR( 6)="To con tinue this install, you must n ow enter a Mail Grou | |
| 1060 | p organize r." | |
| 1061 | S PSSMGPAR( 7)=" " | |
| 1062 | D MES^XPDUT L(.PSSMGPA R) | |
| 1063 | K DIC S DIC =200,DIC(0 )="QEAMZ", DIC("A")=" Enter Mail Group Org anizer: " | |
| 1064 | ; abort inst all if use r does not enter a c oordinator | |
| 1065 | D ^DIC K DI C I $D(DTO UT)!($D(DU OUT))!(+Y' >0) K PSSM GPAR S XPD ABORT=2 Q | |
| 1066 | S PSSMGPOR= +Y,PSSMGPM Y(+Y)="" | |
| 1067 | S PSSMGPNM= "PSS DEE A UDIT",PSSM GPTP=0,PSS MGPSL=0,PS SMGPQT=1 | |
| 1068 | S PSSMGPDS( 1)="Member s of this mail group will rece ive notifi cations wh | |
| 1069 | enever the re" | |
| 1070 | S PSSMGPDS( 2)="are mo dification s made to the DRUG ( #50) file " | |
| 1071 | S PSSMGPDS( 3)="throug h the PSS DRUG ENTER /EDIT menu option." | |
| 1072 | S PSSMGPRS= $$MG^XMBGR P(PSSMGPNM ,PSSMGPTP, PSSMGPOR,P SSMGPSL,.P SSMGPMY,.P | |
| 1073 | SSMGPDS,PS SMGPQT) | |
| 1074 | I 'PSSMGPRS D BMES^XP DUTL(" ") D Q | |
| 1075 | . D BMES^XPD UTL("Unabl e to creat e PSS DEE AUDIT Mail Group, ab orting ins | |
| 1076 | tall.") S XPDABORT=2 | |
| 1077 | . K PSSMGPAR | |
| 1078 | ; Last line above also aborts in stall if t he call to MG^XMBGRP fails to | |
| 1079 | create the Mail Grou p | |
| 1080 | K PSSMGPAR | |
| 1081 | Q | |
| 1082 | ========== ========== ========== ========== ========== ========== ======== | |
| 1083 | PSSPRICE ( New) | |
| 1084 | ||
| 1085 | PSSPRICE ; EPIP/WC - PHARMACY P RICE TRACK ER FILE 50 ;03-06-201 7 ; 14 Ma r 2017 10 | |
| 1086 | :17 AM | |
| 1087 | ; ;1.0;PHARM ACY DATA M ANAGEMENT; **203**;2/ 28/17;Buil d 2 | |
| 1088 | Q ; call b y line tag | |
| 1089 | ; UDPATE^DI E supporte d by ICR # 2053 | |
| 1090 | ; ^XMD supp orted by I CR #10113 | |
| 1091 | ST(PSSIEN, PSSDUZ) ; | |
| 1092 | ; PSSIEN=D RUG IEN | |
| 1093 | ; PSSNEW=N EW PRICE | |
| 1094 | ; PSSDUZ=U SER CHANGI NG PRICE | |
| 1095 | ; CLASS 3 C ROSS REFER ON FILE 5 0 FIELD #1 6 | |
| 1096 | N DA,DIE,X, Y,DIC | |
| 1097 | ; LEAST GET THE TIME T HE CHANGE WAS MADE | |
| 1098 | D NOW^%DTC S PSSTIME= % | |
| 1099 | S PSSNEW=$P ($G(^PSDRU G(PSSIEN,6 60)),"^",6 ) | |
| 1100 | ; | |
| 1101 | QUE ; ENTER THE DATA IN FI LE 50 MULT IPLE FIELD 950 | |
| 1102 | S ZTRTN="HI S^PSSPRICE " | |
| 1103 | S ZTDESC="P HARMACY PR ICE TRACKE R " | |
| 1104 | S ZTSAVE("P SSIEN")="" | |
| 1105 | S ZTSAVE("P SSNEW")="" | |
| 1106 | S ZTSAVE("P SSDUZ")="" | |
| 1107 | S ZTSAVE("P SSTIME")=" " | |
| 1108 | S ZTIO="" | |
| 1109 | D NOW^%DTC S ZTDTH=% | |
| 1110 | D ^%ZTLOAD | |
| 1111 | D HOME^%ZIS | |
| 1112 | Q | |
| 1113 | HIS ; LOGS CHANG ES IN FILE 50 HISTOR Y PRICE DI SPENSE #95 0 | |
| 1114 | ; first del ete any pr ice update s greater than 60 da ys old fro m multiple | |
| 1115 | N DEFDT,PSI EN2 S DEFD T=+$$GET^X PAR("ALL", "PSS DRUG AUDIT RETE NTION MOS" | |
| 1116 | ) | |
| 1117 | S DEFMOS=$S (DEFDT>0:D EFDT,1:999 999999) | |
| 1118 | S X1=$$NOW^ XLFDT,X2=D EFMOS*30 D C^%DTC S ENDDT=X | |
| 1119 | S X1=$P($$N OW^XLFDT," .",1),X2=- 60 | |
| 1120 | S ENDDT=$$F MADD^XLFDT (DT,"-"_(D EFMOS*30)) | |
| 1121 | I $O(^PSDRU G(PSSIEN,9 50,0)) D | |
| 1122 | . F S PSIE N2=$O(^PSD RUG(PSSIEN ,950,0)) Q :^(PSIEN2, 0)>ENDDT D | |
| 1123 | . . N DIK,D A | |
| 1124 | . . S DIK=" ^PSDRUG(PS SIEN,950," ,DA(1)=PSS IEN,DA=PSI EN2 D ^DIK ; Delete | |
| 1125 | old data | |
| 1126 | N FDA | |
| 1127 | S FDA(50.03 ,"?+1,"_PS SIEN_",",. 01)=PSSTIM E | |
| 1128 | S FDA(50.03 ,"?+1,"_PS SIEN_",",1 )=PSSDUZ | |
| 1129 | S FDA(50.03 ,"?+1,"_PS SIEN_",",3 )=PSSNEW | |
| 1130 | D UPDATE^DI E("","FDA" ) | |
| 1131 | S PSSNAME=$ $GET1^DIQ( 200,PSSDUZ _",",.01) | |
| 1132 | BULL ; Generate t he bulleti n. | |
| 1133 | S XMY("G.PS S DEE AUDI T")="" | |
| 1134 | S XMSUB="Ph armacy Pri ce Tracker ",XMDUZ=.5 | |
| 1135 | S ^UTILITY( $J,"PHARM TRACK",1)= PSSNAME_" has change d the PRIC E DISPENSE | |
| 1136 | of:" | |
| 1137 | S ^UTILITY( $J,"PHARM TRACK",2)= $P($G(^PSD RUG(PSSIEN ,0)),"^",1 )_" to: "_ | |
| 1138 | PSSNEW | |
| 1139 | S XMTEXT="^ UTILITY($J ,""PHARM T RACK""," D ^XMD | |
| 1140 | K %,PSSTIME ,PSSIEN,PS SNAME,PSSO LD,PSSNEW, PSSDUZ,^UT ILITY($J), XMSUB,XMTE | |
| 1141 | XT,XMDUZ | |
| 1142 | Q | |
| 1143 | ; | |
| 1144 | ||
| 1145 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.