Produced by Araxis Merge on 10/17/2017 1:23:32 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 | PSGW_2.3_19.zip\PSGW_2.3_19\docs | EPIP_Remediation_Plan_(PSGW_2.3_19).doc | Tue Oct 17 17:04:28 2017 UTC |
| 2 | PSGW_2.3_19.zip\PSGW_2.3_19\docs | EPIP_Remediation_Plan_(PSGW_2.3_19).doc | Tue Oct 17 18:02:59 2017 UTC |
| Description | Between Files 1 and 2 |
|
|---|---|---|
| Text Blocks | Lines | |
| Unchanged | 4 | 1060 |
| Changed | 3 | 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 | DRAFT_EPIP _Remediati on_PlanExi sting Prod uct Intake Program ( EPIP) | |
| 2 | Patch PSGW *2.3*19 | |
| 3 | Remediatio n Plan | |
| 4 | ||
| 5 | Department of Vetera ns Affairs | |
| 6 | August 201 7 | |
| 7 | Version 2. 0 | |
| 8 | Revision H istory | |
| 9 | DateVersio nDescripti onAuthor08 /17/20172. 0Updated s ection 3, Appendix A , and Appe ndix BEPIP Project T eam05/03/2 0171.0Init ial (draft ) versionE PIP Projec t TeamTabl e of Conte nts | |
| 10 | 11. | |
| 11 | Introducti on | |
| 12 | ||
| 13 | ||
| 14 | 12. | |
| 15 | Purpose | |
| 16 | ||
| 17 | ||
| 18 | 13. | |
| 19 | Patch Desc ription | |
| 20 | ||
| 21 | ||
| 22 | 23.1. | |
| 23 | Needs and Requiremen ts | |
| 24 | ||
| 25 | ||
| 26 | 24. | |
| 27 | Points of Contact | |
| 28 | ||
| 29 | ||
| 30 | 35. | |
| 31 | Code Remed iation | |
| 32 | ||
| 33 | ||
| 34 | 35.1. | |
| 35 | Standards and Conven tions | |
| 36 | ||
| 37 | ||
| 38 | 35.2. | |
| 39 | Review and Analysis | |
| 40 | ||
| 41 | ||
| 42 | 35.3. | |
| 43 | Coding Cha nges | |
| 44 | ||
| 45 | ||
| 46 | 46. | |
| 47 | Testing | |
| 48 | ||
| 49 | ||
| 50 | 46.1. | |
| 51 | Test Plan | |
| 52 | ||
| 53 | ||
| 54 | 46.2. | |
| 55 | Test Envir onment | |
| 56 | ||
| 57 | ||
| 58 | 46.3. | |
| 59 | Test Readi ness Revie w | |
| 60 | ||
| 61 | ||
| 62 | 46.4. | |
| 63 | Testing Ph ases | |
| 64 | ||
| 65 | ||
| 66 | 56.4.1. | |
| 67 | Unit Testi ng | |
| 68 | ||
| 69 | ||
| 70 | 56.4.2. | |
| 71 | Component Integratio n and Syst ems Testin g (CI/ST) | |
| 72 | ||
| 73 | ||
| 74 | 56.4.3. | |
| 75 | Functional Testing | |
| 76 | ||
| 77 | ||
| 78 | 56.4.4. | |
| 79 | Regression Testing | |
| 80 | ||
| 81 | ||
| 82 | 56.4.5. | |
| 83 | Section 50 8 Complian ce Testing | |
| 84 | ||
| 85 | ||
| 86 | 57. | |
| 87 | Documentat ion Remedi ation | |
| 88 | ||
| 89 | ||
| 90 | 67.1. | |
| 91 | User Guide s | |
| 92 | ||
| 93 | ||
| 94 | 67.2. | |
| 95 | Installati on Guides | |
| 96 | ||
| 97 | ||
| 98 | 67.3. | |
| 99 | Technical Manuals | |
| 100 | ||
| 101 | ||
| 102 | 67.4. | |
| 103 | Operations Manuals | |
| 104 | ||
| 105 | ||
| 106 | 68. | |
| 107 | Project Re porting | |
| 108 | ||
| 109 | ||
| 110 | 69. | |
| 111 | Project Sc hedule | |
| 112 | ||
| 113 | ||
| 114 | 610. | |
| 115 | Deployment | |
| 116 | ||
| 117 | ||
| 118 | 611. | |
| 119 | Sustainmen t Requirem ents | |
| 120 | ||
| 121 | ||
| 122 | 612. | |
| 123 | Maintenanc e and Know ledge Tran sfer | |
| 124 | ||
| 125 | ||
| 126 | 7Appendix A: | |
| 127 | XINDEX Lis ting for M UMPS Code Changes | |
| 128 | ||
| 129 | ||
| 130 | 8Appendix B: | |
| 131 | Source Cod e Changes | |
| 132 | ||
| 133 | ||
| 134 | ||
| 135 | ||
| 136 | Introducti on | |
| 137 | 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. | |
| 138 | Purpose | |
| 139 | The purpos e of this document i s to fully describe the remedi ation plan to be use d for the successful remediati on of the intake pro duct code to be depl oyed as pa tch PSGW*2 .3*19. Thi s patch ad dresses th e followin g NSRs: | |
| 140 | NSR2017030 8 Add Stoc k Level to On-Demand Reports | |
| 141 | This NSR h as been im plemented locally at the VA Me dical Cent er in San Francisco CA. | |
| 142 | NSR2017031 4 Auto Pri nt Ward St ock Reques ts on Desi gnated Pha rmacy Prin ter | |
| 143 | This NSR h as been im plemented locally at the VA Me dical Cent er in Chic ago IL. | |
| 144 | This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation, and delive ry of this remediati on effort. | |
| 145 | Patch Desc ription | |
| 146 | PSGW*2.3*1 9 provides the follo wing enhan cements to VistA: | |
| 147 | Displays t he maximum allowed w ard stock level when using the Enter/Edi t Nurses' On-Demand Request [P SGW ON-DEM AND NURSIN G EDIT] op tion in th e Auto Rep lenishment /Ward Stoc k Nurses’ Menu [PSGW RN]. Sinc e the Phar macy will fill an or der for no more than the allow ed stock l evel, nurs es need to know the amount of stock that they can receive at one time. Currently , the allo wed stock level disp lays only when a req uest is pl aced for m ore than d ouble the allowed am ount. This modificat ion always displays the allowe d stock le vel, thus preventing delays an d frustrat ion when t rying to r eorder sto ck. | |
| 148 | This modif ication al so display s the maxi mum allowe d ward sto ck level w hen using the On-Dem and Reques t Report b y Date/AOU [PSGW ON- DEMAND PRI NT] option . This opt ion is use d by Pharm acy staff to review nurses' wa rd stock r equests. T he allowed stock lev el is not currently displayed on the rep ort, so Ph armacy sta ff must lo ok up this informati on to dete rmine whet her a requ est exceed s the allo wed amount . This mod ification always dis plays the allowed st ock level on the rep ort, which allows Ph armacy sta ff to easi ly compare the allow ed and req uested amo unts. | |
| 149 | This patch adds a sy stem-level parameter WS_LVL_ON in the PA RAMETER DE FINITION ( #8989.51) file to tu rn the dis play funct ionality O n/Off. Ini tially, th is paramet er is set to OFF (No ). A Clini cal Applic ation Coor dinator (C AC) or Aut omated Dat a Processi ng Applica tion Coord inator (AD PAC) at ea ch site wi ll need to set this parameter to ON (Yes ) to activ ate this f unctionali ty at the site. | |
| 150 | Adds the a bility to automatica lly print ward stock medicatio ns on a de signated p rinter wit hin a phar macy. Curr ently, pha rmacy tech nicians do not have a quick wa y to deter mine which ward stoc k medicati ons need t o be deliv ered to th e various wards and clinics. T he pharmac y manager determines whether t o use this functiona lity and w hich pharm acy printe r should b e designat ed as the default pr inter. Thi s enhancem ent provid es a new D EFAULT PHA RMACY PRIN TER (#32) field in t he PATIENT SITE (#59 .4) file. If a defau lt printer is reques ted by the pharmacy manager, t hen a CAC or ADPAC m ust popula te this fi eld with a printer f rom the DE VICE (#3.5 ) file. If the field is not po pulated wi th a print er, then t he auto-pr int functi onality is effective ly turned off. For s ites with multiple l ocation en tries in t he PATIENT SITE file , managers can desig nate a def ault print er for eac h location . | |
| 151 | Needs and Requiremen ts | |
| 152 | The Needs and Requir ements for the NSR(s ) addresse d in this remediatio n are: | |
| 153 | NSR2017030 8 Add Stoc k Level to On-Demand Reports: | |
| 154 | NEED 88348 8: Print S tock Level on Report s – For Nu rses and P harmacists who order and fill stock leve l requests , a proces s that all ows me to order/fill up to, bu t not exce eding, the maximum s tock level that prev ents frust ration, de lays, and adding ext ra work. U nlike the current pr ocess whic h delays t he stock i tems reque sted due t o the inab ility of k nowing how much can be ordered and fille d and havi ng to go c heck the s tock level of most i tems, our process di splays the maximum s tock level s so the n urses know how much stock to o rder and t he pharmac ists know how much s tock they can fill o n the orde r. | |
| 155 | NSR2017031 4 Auto Pri nt Ward St ock Reques ts on Desi gnated Pha rmacy Prin ter | |
| 156 | NEED 88377 7: Print W ard Stock Requests – For Pharm acy Techni cians who receive an d fill war d stock re quests, a process th at automat ically inf orms me (w ithout use r action r equired) w hich ward stock medi cations ar e needed i n the ward s and clin ics that p revents co nfusion, d oes not wa ste my tim e, and doe s not disr upt the wo rkflow of the clinic s and ward s. Unlike the curren t process which allo ws the use r to not c hoose a pr inter and the reques t is displ ayed on th e screen w ithout ale rting phar macy of th e request, our proce ss autopri nts the wa rd stock r equests on a designa ted printe r within p harmacy. | |
| 157 | Points of Contact | |
| 158 | The VA Poi nts of Con tact (POCs ) for NSR2 0170308 Ad d Stock Le vel to On- Demand Rep orts are: | |
| 159 | Functional POC: Maur een Boro E M AIL PHONE | |
| 160 | Technical POC: Ron M aenpaa E M AIL PHONE | |
| 161 | The D A N P S C
|
|
| 162 | Functional POC: Duan e Machaj E M AIL PHONE | |
| 163 | Technical POC: Shirl ey Tir EMAIL PHONE | |
| 164 | Code Remed iation | |
| 165 | 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. | |
| 166 | Standards and Conven tions | |
| 167 | Leidos wil l referenc e the http ://go. DNS /sacc webs ite for ap plicable d ocuments a nd will ad here to VA standards to comple te the ana lysis of t his intake product. The output of the VA XINDEX ut ility will be used t o analyze the MUMPS source cod e and docu ment the a ffected ro utines (se e Appendix A). | |
| 168 | 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. | |
| 169 | Review and Analysis | |
| 170 | Review and analysis of this in take produ ct involve s two part s: 1) veri fication t hat the so urce code changes sp ecified in this docu ment provi de the des ired effec t, and 2) verificati on that th e source c ode change s do not a dversely a ffect any other Vist A or CPRS functional ity. | |
| 171 | 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. | |
| 172 | Coding Cha nges | |
| 173 | The coding changes r equired fo r NSR20170 308 Add St ock Level to On-Dema nd Reports are in th e followin g routines : | |
| 174 | Modified M UMPS routi nes: PSGWO DP, PSGWOD PR, PSGWOD RN | |
| 175 | New MUMPS routines: None | |
| 176 | The coding changes r equired fo r NSR20170 314 Auto P rint Ward Stock Requ ests on De signated P harmacy Pr inter are in the fol lowing rou tines: | |
| 177 | Modified M UMPS routi nes: PSGWO DRN | |
| 178 | New MUMPS routines: None | |
| 179 | A detailed analysis of the cod ing change s is provi ded in App endix B. | |
| 180 | Testing | |
| 181 | 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. | |
| 182 | Test Plan | |
| 183 | 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. | |
| 184 | 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. | |
| 185 | Test Envir onment | |
| 186 | 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. | |
| 187 | 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. | |
| 188 | Test Readi ness Revie w | |
| 189 | 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 ). | |
| 190 | Testing Ph ases | |
| 191 | Leidos wil l perform developmen t and SQA testing ac tivities i n phases, and will p rovide all required testing do cumentatio n. | |
| 192 | Unit Testi ng | |
| 193 | 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. | |
| 194 | Component Integratio n and Syst ems Testin g (CI/ST) | |
| 195 | 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. | |
| 196 | Functional Testing | |
| 197 | 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. | |
| 198 | Regression Testing | |
| 199 | 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. | |
| 200 | Section 50 8 Complian ce Testing | |
| 201 | Section 50 8 testing will be pe rformed on VistA and CPRS code when new user inter face chang es are int roduced by the devel oper. The VA-recomme nded Assis tive Techn ology tool , JAWS, wi ll be used to conduc t the 508 testing. T est result s and rela ted docume ntation wi ll be subm itted to t he VA Sect ion 508 te am in acco rdance wit h the VA 5 08 testing requireme nts. Defec ts found d uring test ing will b e assessed and remed iated by t he develop er. | |
| 202 | Documentat ion Remedi ation | |
| 203 | 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. | |
| 204 | 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 /vdl/. Key word searc hes using terms rele vant to th is remedia tion effor t will be used to id entify doc uments tha t might be impacted; those doc uments wil l then be reviewed i n their en tirety for any neede d revision s. | |
| 205 | The follow ing sectio ns outline the VDL d ocuments t o be revis ed for thi s remediat ion. | |
| 206 | User Guide s | |
| 207 | The follow ing User G uide will be updated in the VD L: | |
| 208 | Inpatient Pharmacy A utomatic R eplenishme nt/Ward St ock Module User Manu al | |
| 209 | Installati on Guides | |
| 210 | 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 | |
| 211 | Pre-Produc tion envir onments. T herefore, no Install ation Guid es will be updated. | |
| 212 | Technical Manuals | |
| 213 | No Technic al Manuals require r evision as a result of this mo dification . | |
| 214 | Operations Manuals | |
| 215 | No Operati ons Manual s require revision a s a result of this m odificatio n. | |
| 216 | Project Re porting | |
| 217 | 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. | |
| 218 | Project Sc hedule | |
| 219 | 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 six 2-week sprints. | |
| 220 | Deployment | |
| 221 | 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. | |
| 222 | Sustainmen t Requirem ents | |
| 223 | 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 . | |
| 224 | Maintenanc e and Know ledge Tran sfer | |
| 225 | 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. | |
| 226 | XINDEX Lis ting for M UMPS Code Changes | |
| 227 | 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 | |
| 228 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 229 | [2008 V A Standard s & Conven tions] | |
| 230 | UC I: VISTA C PU: ROU Aug 08, 2 017@17:43: 27 | |
| 231 | All Routin es? No => No | |
| 232 | Routine: P SGWODP | |
| 233 | Routine: P SGWODPR | |
| 234 | Routine: P SGWODRN | |
| 235 | Routine: | |
| 236 | 3 routines | |
| 237 | Select BUI LD NAME: P SGW*2.3*19 AUT O REPLENIS HMENT/WARD STOCK | |
| 238 | Include th e compiled template routines: N// | |
| 239 | Print more than comp iled error s and warn ings? YES/ /N | |
| 240 | Save param eters in R OUTINE fil e? NO// | |
| 241 | Index all called rou tines? NO/ / | |
| 242 | This repor t could ta ke some ti me, Rememb er to QUEU E the repo rt. | |
| 243 | DEVICE: HOME (CRT ) Right Margin: 8 0// | |
| 244 | V . A. C R O S S R E F E R E N C E R 7. 3 | |
| 245 | [2008 V A Standard s & Conven tions] | |
| 246 | UC I: VISTA C PU: ROU Aug 08, 2 017@17:43: 27 | |
| 247 | The BUILD file Data Dictionari es are bei ng process ed. | |
| 248 | 59.4 INPAT IENT SITE | |
| 249 | The option and funct ion files are being processed. | |
| 250 | Routines a re being p rocessed. | |
| 251 | Routines: 3 Faux Ro utines: 1 | |
| 252 | PSGWODP PSGWODPR PSGWODRN | |
| 253 | Data Dicti onaries | |
| 254 | |dd59.4 | |
| 255 | --- CROSS REFERENCIN G --- | |
| 256 | Compiled l ist of Err ors and Wa rnings Aug 08, 20 17@17:43:2 7 page 1 | |
| 257 | No errors or warning s to repor t | |
| 258 | --- END -- - | |
| 259 | Source Cod e Changes | |
| 260 | 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: | |
| 261 | Modified M UMPS routi nes: PSGWO DP, PSGWOD PR, PSGWOD RN | |
| 262 | New MUMPS routines: None | |
| 263 | PSGWODP | |
| 264 | Before: | |
| 265 | PSGWODP ; BHAM ISC/P TD,CML-Pri nt an On-D emand Repo rt by Date /AOU ; 17 Aug 93 / 8 :49 AM | |
| 266 | ; ;2.3; Auto matic Repl enishment/ Ward Stock ;;4 JAN 9 4 | |
| 267 | BDT S %DT="AEXT ",%DT("A") ="BEGINNIN G date for report: " D ^%DT K %DT G:Y<0 END S BDT= Y,BDT=BDT- .1 | |
| 268 | EDT S %DT="AEXT ",%DT(0)=B DT,%DT("A" )="ENDING date for r eport: " D ^%DT K %D T G:Y<0 EN D S EDT=Y, EDT=EDT+.3 | |
| 269 | EN D SEL^PSGWU TL1 G:'$D( SEL) END G :SEL="I" E N2 | |
| 270 | ASKAOU ; | |
| 271 | F JJ=0:0 S DIC="^PSI( 58.1,",DIC (0)="QEAM" D ^DIC K DIC Q:Y<0 S AOULP(+ Y)="" | |
| 272 | I '$D(AOULP )&(X'="^AL L") G END | |
| 273 | I X="^ALL" F AOU=0:0 S AOU=$O(^ PSI(58.1,A OU)) Q:'AO U S AOULP (AOU)="" | |
| 274 | EN2 G :'$D(AOULP ) END W !! ,"The righ t margin f or this re port is 80 .",!,"You may queue the report to print at a later time.",!! | |
| 275 | DEV K %ZIS,IOP S %ZIS="QM ",%ZIS("B" )="" D ^%Z IS I POP W !,"NO DEV ICE SELECT ED OR REPO RT PRINTED !" G END | |
| 276 | I $D(IO("Q" )) K IO("Q ") S ZTRTN ="ENQ^PSGW ODP",ZTDES C="Print O n-Demand R equest" S: $D(AOULP) ZTSAVE("AO ULP(")="" F G="BDT", "E | |
| 277 | DT","SEL", "IGDA" S:$ D(@G) ZTSA VE(G)="" | |
| 278 | I D ^%ZTLO AD,HOME^%Z IS K ZTSK G END | |
| 279 | U IO | |
| 280 | ; | |
| 281 | ENQ ; ENTRY POIN T WHEN QUE UED | |
| 282 | K ^TMP("PSG WOD",$J) S AOU=0 | |
| 283 | AOU I $D(AOULP) S AOU=$O( AOULP(AOU) ) I 'AOU D PRINT^PSG WODPR G DO NE | |
| 284 | I '$D(AOULP ) S AOU=$O (^PSI(58.1 ,AOU)) I ' AOU D PRIN T^PSGWODPR G DONE | |
| 285 | DRUG ; LOOP THROU GH DRUGS F OR AOU | |
| 286 | S DRGDA=0 | |
| 287 | DRGLP S DRGDA=$O( ^PSI(58.1, AOU,1,DRGD A)) G:'DRG DA AOU D O D G DRGLP | |
| 288 | ; | |
| 289 | OD ; ON DEMAND REQUESTS | |
| 290 | Q :'$O(^PSI( 58.1,AOU,1 ,DRGDA,5,0 )) S ODA= 0 | |
| 291 | ODLP S ODA=$O(^P SI(58.1,AO U,1,DRGDA, 5,ODA)) Q: 'ODA S LO C=^(ODA,0) ,ODT=$P(LO C,"^") I ( ODT<BDT)!( ODT>EDT) G ODLP | |
| 292 | S QD=$P(LOC ,"^",2),ED UZ=$S($P(L OC,"^",3)' ="":$P(LOC ,"^",3),1: "NOT LISTE D"),DRGNM= $P(^PSI(58 .1,AOU,1,D RGDA,0),"^ "),STAN=$S ($ | |
| 293 | P(^(0),"^" ,3)="":0,$ P(^(0),"^" ,3)>DT:0,1 :1) | |
| 294 | S LEDUZ=$S( +$P(LOC,"^ ",5):$P(LO C,"^",5),1 :"N/A"),LE DT=$S(+$P( LOC,"^",6) :$P(LOC,"^ ",6),1:"N/ A") D BACK ORD | |
| 295 | I '$O(^PSDR UG(DRGNM,0 )) S DIK=" ^PSI(58.1, "_AOU_",1, ",DA=DRGDA ,DA(1)=AOU D ^DIK K DIK G ODLP | |
| 296 | S DRGNAME=$ P(^PSDRUG( DRGNM,0)," ^"),^TMP(" PSGWOD",$J ,$P(ODT,". "),AOU,EDU Z,ODT,DRGN AME)=QD_"^ "_STAN_"^" _DRGDA_"^" _BOTOT_"^" _L | |
| 297 | EDUZ_"^"_L EDT G ODLP | |
| 298 | DONE I $E(IOST)' ="C" W @IO F | |
| 299 | I $E(IOST)= "C" D:'QFL G SS^PSGWU TL1 | |
| 300 | END K EDITDT,PR EV,ZTSK,^T MP("PSGWOD ",$J),AOUL P,JJ,ANS,A OU,BDT,DRG DA,DRGNAME ,DRGNM,EDT ,EDUZ,J,LE DT,LEDUZ,L OC,ODA,ODT ,PGCT,QD,S TA | |
| 301 | N,PSGDA,AD T,CAT,PSGW DT,PSGWODT ,PSGWAOU,A MISFL,KEY, ODTM,TMDT, %,%I,%H,DA ,G,D,DIE | |
| 302 | K %DT,%W,C, SEL,IGDA,D 0,D1,D2,DI ,DIC,DIYS, DLAYGO,DQ, IO("Q"),PS GWV,BOTOT, X,Y,BO,QFL G,PSGWDUZ, PRTFLG,PSG WDT,PSGWCA T,BON,ALL, BC | |
| 303 | FLG,NEWI,P SGDR,PSGWA DT,PSGWD,P SGWDN D ^% ZISC | |
| 304 | S :$D(ZTQUEU ED) ZTREQ= "@" Q | |
| 305 | BACKORD ; TOTAL ANY BACKORDERS | |
| 306 | S X=DRGNM,B OTOT=0,DIC ="^PSI(58. 3,",DIC(0) ="" D ^DIC Q:Y<0 S BO=+Y F J= 0:0 S J=$S ($D(^PSI(5 8.3,BO,1,A OU,1,J)):$ O(^(J)),1: "" | |
| 307 | ) Q:'J S: $S($P(^(J, 0),"^",5)= "":1,1:0) BOTOT=BOTO T+$P(^(0), "^",2) | |
| 308 | Q | |
| 309 | After: | |
| 310 | PSGWODP ; BHAM ISC/P TD,CML-Pri nt an On-D emand Repo rt by Date /AOU ; 14 JUN 17 / 2 | |
| 311 | :48 PM | |
| 312 | ; ;2.3;Autom atic Reple nishment/W ard Stock; **18,19**; 4 JAN 94 | |
| 313 | ; | |
| 314 | BDT S %DT="AEXT ",%DT("A") ="BEGINNIN G date for report: " D ^%DT K %DT G:Y<0 | |
| 315 | END S BDT= Y,BDT=BDT- .00001 | |
| 316 | N PSGWPFLG S PSGWPFLG =0 I $$GET ^XPAR("ALL ","WS_LVL_ ON") S PSG WPFLG=1 ; | |
| 317 | Patch PSGW *2.3*19 ar e changes active | |
| 318 | EDT S %DT="AEXT ",%DT(0)=B DT,%DT("A" )="ENDING date for r eport: " D ^%DT K %D | |
| 319 | T G:Y<0 EN D S EDT=Y S:EDT'["." EDT=EDT+. 24 | |
| 320 | I PSGWPFLG S EDT=EDT+ .00001 | |
| 321 | EN D SEL^PSGWU TL1 G:'$D( SEL) END G :SEL="I" E N2 | |
| 322 | ASKAOU ; | |
| 323 | F JJ=0:0 S DIC="^PSI( 58.1,",DIC (0)="QEAM" D ^DIC K DIC Q:Y<0 S AOULP(+ | |
| 324 | Y)="" | |
| 325 | I '$D(AOULP )&(X'="^AL L") G END | |
| 326 | I X="^ALL" F AOU=0:0 S AOU=$O(^ PSI(58.1,A OU)) Q:'AO U S AOULP (AOU)="" | |
| 327 | EN2 G :'$D(AOULP ) END W !! ,"The righ t margin f or this re port is 80 .",!,"You | |
| 328 | may queue the report to print at a later time.",!! | |
| 329 | DEV K %ZIS,IOP S %ZIS="QM ",%ZIS("B" )="" D ^%Z IS I POP W !,"NO DEV ICE SELECT | |
| 330 | ED OR REPO RT PRINTED !" G END | |
| 331 | I $D(IO("Q" )) K IO("Q ") S ZTRTN ="ENQ^PSGW ODP",ZTDES C="Print O n-Demand R | |
| 332 | equest" S: $D(AOULP) ZTSAVE("AO ULP(")="" F G="BDT", "EDT","SEL ","IGDA" S :$D(@G) ZT | |
| 333 | SAVE(G)="" | |
| 334 | I D ^%ZTLO AD,HOME^%Z IS K ZTSK G END | |
| 335 | U IO | |
| 336 | ; | |
| 337 | ENQ ; ENTRY POIN T WHEN QUE UED | |
| 338 | I '$D(PSGWP FLG) N PSG WPFLG S PS GWPFLG=0 I $$GET^XPA R("ALL","W S_LVL_ON") | |
| 339 | S PSGWPFL G=1 ; Patc h PSGW*2.3 *19 are ch anges acti ve | |
| 340 | K ^TMP("PSG WOD",$J) S AOU=0 | |
| 341 | AOU I $D(AOULP) S AOU=$O( AOULP(AOU) ) I 'AOU D PRINT^PSG WODPR G DO NE | |
| 342 | I '$D(AOULP ) S AOU=$O (^PSI(58.1 ,AOU)) I ' AOU D PRIN T^PSGWODPR G DONE | |
| 343 | DRUG ; LOOP THROU GH DRUGS F OR AOU | |
| 344 | S DRGDA=0 | |
| 345 | DRGLP S DRGDA=$O( ^PSI(58.1, AOU,1,DRGD A)) G:'DRG DA AOU D O D G DRGLP | |
| 346 | ; | |
| 347 | OD ; ON DEMAND REQUESTS | |
| 348 | Q :'$O(^PSI( 58.1,AOU,1 ,DRGDA,5,0 )) S ODA= 0 | |
| 349 | ODLP S ODA=$O(^P SI(58.1,AO U,1,DRGDA, 5,ODA)) Q: 'ODA S LO C=^(ODA,0) ,ODT=$P(LO | |
| 350 | C,"^") I ( ODT<BDT)!( ODT>EDT) G ODLP | |
| 351 | S QD=$P(LOC ,"^",2),ED UZ=$S($P(L OC,"^",3)' ="":$P(LOC ,"^",3),1: "NOT LISTE | |
| 352 | D"),DRGNM= $P(^PSI(58 .1,AOU,1,D RGDA,0),"^ "),STAN=$S ($P(^(0)," ^",3)="":0 ,$P(^(0)," | |
| 353 | ^",3)>DT:0 ,1:1) | |
| 354 | S LEDUZ=$S( +$P(LOC,"^ ",5):$P(LO C,"^",5),1 :"N/A"),LE DT=$S(+$P( LOC,"^",6) | |
| 355 | :$P(LOC,"^ ",6),1:"N/ A") D BACK ORD | |
| 356 | I '$O(^PSDR UG(DRGNM,0 )) S DIK=" ^PSI(58.1, "_AOU_",1, ",DA=DRGDA ,DA(1)=AOU | |
| 357 | D ^DIK K DIK G ODLP | |
| 358 | I PSGWPFLG D | |
| 359 | . N IEN S D RGNAME=$$G ET1^DIQ(50 ,DRGNM,.01 ),IEN=DRGD A_","_AOU_ "," | |
| 360 | . S ^TMP("P SGWOD",$J, "ARCHSTOCK ",$P(ODT," ."),AOU,ED UZ,ODT,DRG NAME)=$$GE | |
| 361 | T1^DIQ(58. 11,IEN,1) | |
| 362 | S DRGNAME=$ P(^PSDRUG( DRGNM,0)," ^"),^TMP(" PSGWOD",$J ,$P(ODT,". "),AOU,EDU | |
| 363 | Z,ODT,DRGN AME)=QD_"^ "_STAN_"^" _DRGDA_"^" _BOTOT_"^" _LEDUZ_"^" _LEDT G OD LP | |
| 364 | DONE I $E(IOST)' ="C" W @IO F | |
| 365 | I $E(IOST)= "C" D:'QFL G SS^PSGWU TL1 | |
| 366 | END K EDITDT,PR EV,ZTSK,^T MP("PSGWOD ",$J),AOUL P,JJ,ANS,A OU,BDT,DRG DA,DRGNAME | |
| 367 | ,DRGNM,EDT ,EDUZ,J,LE DT,LEDUZ,L OC,ODA,ODT ,PGCT,QD,S TAN,PSGDA, ADT,CAT,PS GWDT,PSGWO | |
| 368 | DT,PSGWAOU ,AMISFL,KE Y,ODTM,TMD T,%,%I,%H, DA,G,D,DIE | |
| 369 | K %DT,%W,C, SEL,IGDA,D 0,D1,D2,DI ,DIC,DIYS, DLAYGO,DQ, IO("Q"),PS GWV,BOTOT, | |
| 370 | X,Y,BO,QFL G,PSGWDUZ, PRTFLG,PSG WDT,PSGWCA T,BON,ALL, BCFLG,NEWI ,PSGDR,PSG WADT,PSGWD | |
| 371 | ,PSGWDN,PS GWPFLG D ^ %ZISC | |
| 372 | S :$D(ZTQUEU ED) ZTREQ= "@" Q | |
| 373 | BACKORD ; TOTAL ANY BACKORDERS | |
| 374 | S X=DRGNM,B OTOT=0,DIC ="^PSI(58. 3,",DIC(0) ="" D ^DIC Q:Y<0 S BO=+Y F J= | |
| 375 | 0:0 S J=$S ($D(^PSI(5 8.3,BO,1,A OU,1,J)):$ O(^(J)),1: "") Q:'J S:$S($P(^( J,0),"^",5 | |
| 376 | )="":1,1:0 ) BOTOT=BO TOT+$P(^(0 ),"^",2) | |
| 377 | Q | |
| 378 | PSGWODPR | |
| 379 | Before: | |
| 380 | PSGWODPR ; BIR/PTD,CM L-PRINT AN ON-DEMAND REPORT BY DATE/AOU - CONTINUE D ;05/01/9 1 15:01 | |
| 381 | ; ;2.3; Auto matic Repl enishment/ Ward Stock ; **15** ;4 JAN 94 | |
| 382 | PRINT ; PRINT AN O N DEMAND R EQUEST | |
| 383 | S PGCT=1,OD T=0,QFLG=" " I '$O(^T MP("PSGWOD ",$J,0)) D HDR W !," NO ON-DEMA ND DATA FO R SELECTED DATE RANG E." Q | |
| 384 | DTLP S ODT=$O(^T MP("PSGWOD ",$J,ODT)) ,AOU=0 Q:' ODT | |
| 385 | AOULP S AOU=$O(^T MP("PSGWOD ",$J,ODT,A OU)),EDUZ= 0 G:'AOU D TLP D:PGCT >1 PRTCHK Q:QFLG D HDR W !!," ==> AREA O F USE: ",$ P(^PSI(58. 1, | |
| 386 | AOU,0),"^" ) | |
| 387 | DUZLP S EDUZ=$O(^ TMP("PSGWO D",$J,ODT, AOU,EDUZ)) ,ODTM=0 G: EDUZ="" AO ULP W !!?6 ,"ENTERED BY: ",$S(+ EDUZ'=0:$P (^VA(200,E DUZ,0),"^" ), | |
| 388 | 1:"UNKNOWN ") | |
| 389 | TMLP S ODTM=$O(^ TMP("PSGWO D",$J,ODT, AOU,EDUZ,O DTM)),DRGN AME="" G:' ODTM DUZLP S Y=ODTM X ^DD("DD" ) S TMDT=Y | |
| 390 | DRLP S DRGNAME=$ O(^TMP("PS GWOD",$J,O DT,AOU,EDU Z,ODTM,DRG NAME)) G:D RGNAME="" TMLP S LOC =^(DRGNAME ),QD=$P(LO C,"^"),STA N=$P(LOC," ^" | |
| 391 | ,2),DRGDA= $P(LOC,"^" ,3),BOTOT= $P(LOC,"^" ,4),LEDUZ= $P(LOC,"^" ,5),LEDT=$ P(LOC,"^", 6) | |
| 392 | I $Y+5>IOSL D PRTCHK Q:QFLG D HDR | |
| 393 | I +LEDUZ W !?6,"Next Item LAST EDITED BY: ",$S($D(^ VA(200,LED UZ,0)):$P( ^(0),"^"), 1:"UNKNOWN ") I +LEDT S Y=LEDT X ^DD("DD" ) | |
| 394 | W " on ",Y | |
| 395 | W !,DRGNAME ,!?36,TMDT ,?55,$J(QD ,4),?62,$S (BOTOT>0:$ J(BOTOT,4) ,1:""),?68 ,$S(STAN'= 1:"*Std. S tock",1:"" ) I $D(^PS I(58.1,AOU ,1 | |
| 396 | ,DRGDA,"EX P")),+^("E XP") S Y=+ ^("EXP") X ^DD("DD") W !?2,"Ex piration D ate: ",Y | |
| 397 | G DRLP | |
| 398 | HDR ; PRINT REPO RT MAIN HE ADER | |
| 399 | D NOW^%DTC S Y=$P(%," .") X ^DD( "DD") W:$Y @IOF W !, "ON DEMAND REQUEST L IST BY DAT E",?50,"DA TE: ",Y,?7 0,"PAGE: " ,PGCT I $D (S | |
| 400 | EL),SEL="I ",$D(IGDA) W !,"FOR INVENTORY GROUP - ", $P(^PSI(58 .2,IGDA,0) ,"^") | |
| 401 | S Y=ODT X ^ DD("DD") W !!?25,"RE QUEST DATE : ",$S(Y'= 0:Y,1:"NON E FOUND"), !?12,"ITEM ",?62,"BAC K-" | |
| 402 | W !?36,"DT/ TIME ORDER ED",?56,"Q TY",?62,"O RDER",! S PGCT=PGCT+ 1 F J=1:1: 80 W "-" | |
| 403 | Q | |
| 404 | ; | |
| 405 | PRTCHK ; | |
| 406 | I $E(IOST)= "C" W !!," Press <RET URN> to Co ntinue or ""^"" to E xit: " R A NS:DTIME S :'$T ANS=" ^" D:ANS?1 ."?" HELP^ PSGWUTL1 I A | |
| 407 | NS="^" S Q FLG=1 | |
| 408 | Q | |
| 409 | After: | |
| 410 | PSGWODPR ; BIR/PTD,CM L-PRINT AN ON-DEMAND REPORT BY DATE/AOU - CONTINUE D ;14 JUN | |
| 411 | 17 / 2:48 PM | |
| 412 | ; ;2.3;Autom atic Reple nishment/W ard Stock; **15,18,19 **;4 JAN 9 4 | |
| 413 | PRINT ; PRINT AN O N DEMAND R EQUEST | |
| 414 | N PSGWPFLG S PSGWPFLG =0 I $$GET ^XPAR("ALL ","WS_LVL_ ON") S PSG WPFLG=1 ; | |
| 415 | Patch PSGW *2.3*19 ar e changes active | |
| 416 | S PGCT=1,OD T=0,QFLG=" " I '$O(^T MP("PSGWOD ",$J,0)) D HDR W !," NO ON-DEMA | |
| 417 | ND DATA FO R SELECTED DATE RANG E." Q | |
| 418 | DTLP S ODT=$O(^T MP("PSGWOD ",$J,ODT)) ,AOU=0 Q:' ODT | |
| 419 | AOULP S AOU=$O(^T MP("PSGWOD ",$J,ODT,A OU)),EDUZ= 0 G:'AOU D TLP D:PGCT >1 PRTCHK | |
| 420 | Q:QFLG D HDR W !!," ==> AREA O F USE: ",$ P(^PSI(58. 1,AOU,0)," ^") | |
| 421 | DUZLP S EDUZ=$O(^ TMP("PSGWO D",$J,ODT, AOU,EDUZ)) ,ODTM=0 G: EDUZ="" AO ULP W !!?6 | |
| 422 | ,"ENTERED BY: ",$S(+ EDUZ'=0:$P (^VA(200,E DUZ,0),"^" ),1:"UNKNO WN") | |
| 423 | TMLP S ODTM=$O(^ TMP("PSGWO D",$J,ODT, AOU,EDUZ,O DTM)),DRGN AME="" G:' ODTM DUZLP | |
| 424 | S Y=ODTM X ^DD("DD" ) S TMDT=Y | |
| 425 | DRLP S DRGNAME=$ O(^TMP("PS GWOD",$J,O DT,AOU,EDU Z,ODTM,DRG NAME)) G:D RGNAME="" | |
| 426 | TMLP S LOC =^(DRGNAME ),QD=$P(LO C,"^"),STA N=$P(LOC," ^",2),DRGD A=$P(LOC," ^",3),BOTO | |
| 427 | T=$P(LOC," ^",4),LEDU Z=$P(LOC," ^",5),LEDT =$P(LOC,"^ ",6) | |
| 428 | I $Y+5>IOSL D PRTCHK Q:QFLG D HDR | |
| 429 | I +LEDUZ W !?6,"Next Item LAST EDITED BY: ",$S($D(^ VA(200,LED UZ,0)):$P( | |
| 430 | ^(0),"^"), 1:"UNKNOWN ") I +LEDT S Y=LEDT X ^DD("DD" ) W " on " ,Y | |
| 431 | W !,DRGNAME ,!?36,TMDT ,?55,$J(QD ,4),?62,$S (BOTOT>0:$ J(BOTOT,4) ,1:""),?68 | |
| 432 | ,$S(STAN'= 1:"*Std. S tock",1:"" ) | |
| 433 | S Y="" I $D (^PSI(58.1 ,AOU,1,DRG DA,"EXP")) ,+^("EXP") S Y=+^("E XP") X ^DD | |
| 434 | ("DD") W ! ?2,"Expira tion Date: ",Y | |
| 435 | I PSGWPFLG W:Y="" ! W ?30,"STOC K LEVEL: " ,$G(^TMP(" PSGWOD",$J ,"ARCHSTOC | |
| 436 | K",ODT,AOU ,EDUZ,ODTM ,DRGNAME)) | |
| 437 | G DRLP | |
| 438 | HDR ; PRINT REPO RT MAIN HE ADER | |
| 439 | D NOW^%DTC S Y=$P(%," .") X ^DD( "DD") W:$Y @IOF W !, "ON DEMAND REQUEST L | |
| 440 | IST BY DAT E",?50,"DA TE: ",Y,?7 0,"PAGE: " ,PGCT I $D (SEL),SEL= "I",$D(IGD A) W !,"FO | |
| 441 | R INVENTOR Y GROUP - ",$P(^PSI( 58.2,IGDA, 0),"^") | |
| 442 | S Y=ODT X ^ DD("DD") W !!?25,"RE QUEST DATE : ",$S(Y'= 0:Y,1:"NON E FOUND"), | |
| 443 | !?12,"ITEM ",?62,"BAC K-" | |
| 444 | W !?36,"DT/ TIME ORDER ED",?56,"Q TY",?62,"O RDER",! S PGCT=PGCT+ 1 F J=1:1: | |
| 445 | 80 W "-" | |
| 446 | Q | |
| 447 | ; | |
| 448 | PRTCHK ; | |
| 449 | I $E(IOST)= "C" W !!," Press <RET URN> to Co ntinue or ""^"" to E xit: " R A | |
| 450 | NS:DTIME S :'$T ANS=" ^" D:ANS?1 ."?" HELP^ PSGWUTL1 I ANS="^" S QFLG=1 | |
| 451 | Q | |
| 452 | PSGWODRN | |
| 453 | Before: | |
| 454 | PSGWODRN ; BHAM ISC/M PH,PTD,CML -Enter an On-Demand Request - for Nursin g Staff ; 17 Mar 97 / 2:48 PM | |
| 455 | ; ;2.3; Auto matic Repl enishment/ Ward Stock ;**11**;4 JAN 94 | |
| 456 | I '$D(PSGWS ITE) D ^PS GWSET Q:'$ D(PSGWSITE ) S PSGWF LG=1 | |
| 457 | S BCFLG=0 G DATE ; I '$P(PSGWSI TE,"^",27) S BCFLG=0 G DATE | |
| 458 | W !!,"This option can be used w ith a Bar Code Reade r and a pr inted list ing from", !,"the opt ion 'LIST BAR CODED STOCK ITEM S' | |
| 459 | .",!!,"If you choose to use a bar code r eader, you MUST use it to ente r both",!, "the AOU a nd the ITE M." | |
| 460 | ASK W !!,"Do yo u wish to use a Bar Code Reade r" S %=2 D YN^DICN G :%<0!(%="" ) BOT I %< 1 W !,"PLE ASE ANSWER 'YES' OR 'NO'." G A SK | |
| 461 | S BCFLG=$S( %<2:1,1:0) | |
| 462 | DATE S PSGWV="AM IS COMPILE FLAG" R ! !,"SELECT DATE/TIME FOR ON-DEM AND REQUES T: NOW // ",ODT:DTIM E S:'$T OD T="^" G:OD T="^" BOT S: | |
| 463 | ODT="" ODT ="NOW" | |
| 464 | I "?"[$E(OD T) S X="?" ,DIC(0)="M ",DIC="^PS I(58.1,",D ="OND" D I X^DIC K DI C G DATE | |
| 465 | DT S %DT="ET", %DT(0)="-N OW",X=ODT D ^%DT K % DT(0) G:Y< 0 DATE S ( ODT,PSGWAD T)=Y,PSGWC AT="W",AMI SFL=0,PRTF LG=0 | |
| 466 | AOU R !,"Select MEDICATIO N AREA OF USE: ",X:D TIME S:'$T X="^" G B OT:"^"[X I BCFLG,X'? 1"A".N W * 7," ??",! ,"Wand the bar code. | |
| 467 | It should be in the format of an 'A' fol lowed by a series",! ,"of numbe r(s). Ex. - 'A123'" G AOU | |
| 468 | S :BCFLG X=$ P(X,"A",2) S DIC="^P SI(58.1,", DIC(0)="QE MN",DIC("S ")="I $S(' $D(^(""I"" )):1,'^("" I""):1,^(" "I"")>DT:1 ,1:0)" D ^ DI | |
| 469 | C K DIC | |
| 470 | G :X?1."?" A OU G:Y<0 B OT S (AOU, PSGWAOU)=+ Y S:($P(^P SI(58.1,AO U,0),"^",3 )'=1)&($P( PSGWSITE," ^",25)=1) AMISFL=1 | |
| 471 | I '$D(^PSI( 58.1,AOU,1 ,0)) S ^(0 )="^58.11I P^^" | |
| 472 | ITEM R !,"Select ITEM: ",X :DTIME S:' $T X="^" G BOT:X="^" ,END:X="" I BCFLG,X' ?1"I".N W *7," ??", !,"Wand th e bar code . It shou ld | |
| 473 | be in the format of an 'I' fo llowed by a series", !,"of numb er(s). Ex . - 'I123' " G ITEM | |
| 474 | S :BCFLG X=$ P(X,"I",2) S DIC="^P SI(58.1,AO U,1,",DIC( 0)="QEM",D A(1)=AOU,D IC("S")="S DRGDA=+^( 0) I $S('$ D(^(""I"") ):1,$O(^(" "I | |
| 475 | "",0))'>DT :0,1:1) D SCR2^PSGWO D2" D ^DIC K DIC G I TEM:X?1."? "!(Y<0) S (PSGDR,PSG WDN)=$P(Y, "^",2),ITE M=+Y | |
| 476 | BACKOD S X=PSGDR,P SGBOT=0,DI C="^PSI(58 .3,",DIC(0 )="" D ^DI C K DIC G: Y<0 UPD S PSGBON=+Y | |
| 477 | F J=0:0 S J =$S($D(^PS I(58.3,PSG BON,1,AOU, 1,J)):$O(^ (J)),1:0) Q:J'>0 S: $S($P(^(J, 0),"^",5)= "":1,1:0) PSGBOT=PSG BOT+$P(^(0 ), | |
| 478 | "^",2) | |
| 479 | W :PSGBOT'=0 !!,"Item is on BACK ORDER. Yo u may not enter a qu antity.",! ,"Total Ba ckordered for this i tem is ",P SGBOT,".", !! | |
| 480 | UPD I PSGBOT'>0 S DR="16/ //"_ODT,DR (2,58.28)= "2////"_DU Z_";S PSGW OLD=$P(^PS I(58.1,AOU ,1,DA(1),5 ,DA,0),""^ "",2);1T;S PSGWQD=X- PS | |
| 481 | GWOLD" | |
| 482 | I S PSGDR= $P(^PSDRUG (PSGDR,0), "^"),DIE=" ^PSI(58.1, AOU,1,",DA (1)=AOU,DA =ITEM D ^D IE K DIE I $D(PSGWQD ),(PSGWQD' =0) S PRTF LG | |
| 483 | =1 I AMISF L=1 S ^PSI (58.5,"AMI S",$H,PSGW ADT,PSGWCA T,PSGWAOU, PSGWDN,PSG WQD)="" | |
| 484 | DONE K PSGBON,PS GBOT,PSGDR ,PSGWDN,PS GWQD,PSGWO LD,X,Y,J,D R G ITEM | |
| 485 | END G :'PRTFLG B OT R !!,"D o you wish to print a copy of this on-de mand reque st ? N//", ANS:DTIME S:'$T ANS= "^" S:ANS= "" ANS="^" G | |
| 486 | :ANS="^" B OT | |
| 487 | I "YyNn"'[$ E(ANS) W ! !,"Answer ""Y"" or " "N"". If y ou answer yes, the p rogram wil l print a ""pick lis t"" or",!, "hard copy o | |
| 488 | f this on- demand req uest. The report lis ts the dat e, AOU, it ems,",!,"q uantities, and perso n entering request." G END | |
| 489 | I "Yy"[$E(A NS) S ALL= 0,(BDT,EDT )=ODT G DE V^PSGWODP | |
| 490 | BOT K %,BCFLG,P SGBON,PSGB OT,PSGDR,D R,AOU,ODT, ANS,PSGWAD T,PSGWCAT, PSGWDN,PSG WOLD,PSGWQ D,PSGWAOU, AMISFL,KEY ,PSGWV,DA, D,DIE,%DT, %W | |
| 491 | ,D0,D1,D2, DI,DLAYGO, DQ,ITEM,PR TFLG,DRGDA K:$D(PSGW FLG) PSGWS ITE,PSGWFL G Q | |
| 492 | After: | |
| 493 | PSGWODRN ; BHAM ISC/M PH,PTD,CML -Enter an On-Demand Request - for Nursin g Staff ; | |
| 494 | 14 JUN 17 / 2:48 PM | |
| 495 | ; ;2.3;Autom atic Reple nishment/W ard Stock; **11,19**; 4 JAN 94 | |
| 496 | N PSGWITMC S PSGWITMC =0 ; PSGWI TMC is a c ounter of the number of passes | |
| 497 | through I TEM | |
| 498 | I '$D(PSGWS ITE) D ^PS GWSET Q:'$ D(PSGWSITE ) S PSGWF LG=1 | |
| 499 | S BCFLG=0 G DATE ; I '$P(PSGWSI TE,"^",27) S BCFLG=0 G DATE | |
| 500 | W !!,"This option can be used w ith a Bar Code Reade r and a pr inted list | |
| 501 | ing from", !,"the opt ion 'LIST BAR CODED STOCK ITEM S'.",!!,"I f you choo se to use | |
| 502 | a bar code reader, y ou MUST us e it to en ter both", !,"the AOU and the I TEM." | |
| 503 | ASK W !!,"Do yo u wish to use a Bar Code Reade r" S %=2 D YN^DICN G :%<0!(%="" | |
| 504 | ) BOT I %< 1 W !,"PLE ASE ANSWER 'YES' OR 'NO'." G A SK | |
| 505 | S BCFLG=$S( %<2:1,1:0) | |
| 506 | DATE S PSGWV="AM IS COMPILE FLAG" R ! !,"SELECT DATE/TIME FOR ON-DEM AND REQUES T: NOW // ",ODT:DTIM E S:'$T OD T="^" G:OD T="^" BOT S:ODT="" O DT="NOW" | |
| 507 | I "?"[$E(OD T) S X="?" ,DIC(0)="M ",DIC="^PS I(58.1,",D ="OND" D I X^DIC K DI C G DATE | |
| 508 | DT S %DT="ET", %DT(0)="-N OW",X=ODT D ^%DT K % DT(0) G:Y< 0 DATE S ( ODT,PSGWAD T)=Y,PSGWC AT="W",AMI SFL=0,PRTF LG=0 | |
| 509 | AOU R !,"Select MEDICATIO N AREA OF USE: ",X:D TIME S:'$T X="^" G B OT:"^"[X I BCFLG,X'? 1"A".N W * 7," ??",! ,"Wand the bar code. It shoul d be in th e format o f an 'A' f ollowed by a series" ,!,"of num ber(s). E x. - 'A123 '" G AOU | |
| 510 | S :BCFLG X=$ P(X,"A",2) S DIC="^P SI(58.1,", DIC(0)="QE MN",DIC("S ")="I $S(' $D(^(""I"" )):1,'^("" I""):1,^(" "I"")>DT:1 ,1:0)" D ^ DIC K DIC | |
| 511 | G :X?1."?" A OU G:Y<0 B OT S (AOU, PSGWAOU)=+ Y S:($P(^P SI(58.1,AO U,0),"^",3 )'=1)&($P( PSGWSITE," ^",25)=1) AMISFL=1 | |
| 512 | I '$D(^PSI( 58.1,AOU,1 ,0)) S ^(0 )="^58.11I P^^" | |
| 513 | ITEM R !,"Select ITEM: ",X :DTIME S:' $T X="^" G BOT:(X="^ "&(PSGWITM C<1)),END: X="" I BCF LG,X'?1"I" .N W *7," ??",!,"Wa nd the bar code. It should be in the fo rmat of an 'I' follo wed by a s eries",!," of number( s). Ex. - 'I123'" G ITEM | |
| 514 | S :BCFLG X=$ P(X,"I",2) S DIC="^P SI(58.1,AO U,1,",DIC( 0)="QEM",D A(1)=AOU,D IC("S")="S DRGDA=+^( 0) I $S('$ D^""I"")): 1,$O(^(""I "",0))'>DT :0,1:1) D SCR2^PSGWO D2" D ^DIC K DIC G I TEM:X?1."? "!(Y<0) S (PSGDR,PSG WDN)=$P(Y, "^",2),ITE M=+Y | |
| 515 | BACKOD S X=PSGDR,P SGBOT=0,DI C="^PSI(58 .3,",DIC(0 )="" D ^DI C K DIC G: Y<0 UPD S PSGBON=+Y | |
| 516 | F J=0:0 S J =$S($D(^PS I(58.3,PSG BON,1,AOU, 1,J)):$O(^ (J)),1:0) Q:J'>0 S: $S($P(^(J, 0),"^",5)= "":1,1:0) PSGBOT=PSG BOT+$P(^(0 ),"^",2) | |
| 517 | W :PSGBOT'=0 !!,"Item is on BACK ORDER. Yo u may not enter a qu antity.",! ,"Total Ba ckordered for this i tem is ",P SGBOT,".", !! | |
| 518 | UPD I PSGBOT'>0 S DR(2,58 .11)="16// /"_ODT,DR( 3,58.28)=" 2////"_DUZ _";S PSGWO LD=$P(^PSI (58.1,AOU, 1,DA(1),5, DA,0),""^" ",2);1T;S PSGWQD=X-P SGWOLD" | |
| 519 | I $$GET^XPA R("ALL","W S_LVL_ON") N IEN S I EN=ITEM_", "_AOU_"," W !,"Stock Level All owed is ", $$GET1^DIQ (58.11,IEN ,1),"." K IEN ;Patch PSWG*2.3* 19 | |
| 520 | I PSGBOT'>0 S PSGDR=$ P(^PSDRUG( PSGDR,0)," ^"),DIE("N O^")="Othe r value",D IE="^PSI58 .1,",DA=AO U,DR="1/// "_PSGDR D ^DIE I $D( PSGWQD),(P SGWQD'=0) S PRTFLG=1 I AMISFL= 1 S ^PSI(5 8.5,"AMIS" ,$H,PSGWAD T,PSGWCAT, PSGWAOU,PS GWDN,PSGWQ D)="" | |
| 521 | DONE K PSGBON,PS GBOT,PSGDR ,PSGWDN,PS GWQD,PSGWO LD,X,Y,J,D R,IEN S PS GWITMC=PSG WITMC+1 G ITEM | |
| 522 | END ; | |
| 523 | G :'PRTFLG B OT | |
| 524 | N PSGWTEMP S PSGWTEMP =$$GET1^DI Q(3.5,$P(P SGWSITE,"^ ",32),.01) | |
| 525 | I PSGWTEMP' ="" D AUTO Q K PSGWTE MP,PSGWITM C | |
| 526 | R !!,"Do yo u wish to print a co py of this on-demand request ? N//",ANS: DTIME S:'$ T ANS="^" S:ANS="" A NS="^" G:A NS="^" BOT | |
| 527 | I "YyNn"'[$ E(ANS) W ! !,"Answer ""Y"" or " "N"". If y ou answer yes, the p rogram wil l print a ""pick lis t"" or",!, "hard copy of this o n-demand r equest. Th e report l ists the d ate, AOU, items,",!, "quantitie s, and per son nterin g request. " G END | |
| 528 | I "Yy"[$E(A NS) S ALL= 0,(BDT,EDT )=ODT G DE V^PSGWODP | |
| 529 | BOT K %,BCFLG,P SGBON,PSGB OT,PSGDR,D R,AOU,ODT, ANS,PSGWAD T,PSGWCAT, PSGWDN,PSG WOLD,PSGWQ D,PSGWAOU, AMISFL,KEY ,PSGWV,DA, D,DIE,%DT, %W,D0,D1,D 2,DI,DLAYG O,DQ,ITEM, PRTFLG,DRG DA,PSGWTEM P,PSGWITMC K:$D(PSGW FLG) PSGWS ITE,PSGWFL G Q | |
| 530 | AUTOQ ; Patch to A uto queue Ward Stock Request t o pharmacy printer ( PSGW*2.3*1 9) | |
| 531 | S ALL=0,(BD T,EDT)=ODT | |
| 532 | S ZTIO=$$GE T1^DIQ(3.5 ,$P(PSGWSI TE,"^",32) ,.01) | |
| 533 | S ZTDESC="A UTO-PRINT WARD STOCK REQUEST" S ZTRTN="E NQ^PSGWODP " S:$D(AOU LP) ZTSAVE ("AOULP*") ="" F G="B DT","EDT" S:$D(@G) Z TSAVE(G)=" " | |
| 534 | D ^%ZTLOAD | |
| 535 | K ZTRTN,ZTD EC,ZTIO,ZT SAVE | |
| 536 | Q | |
| 537 | ; |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.