3. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 3/31/2017 1:06:29 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.

3.1 Files compared

# Location File Last Modified
1 EPIP_submissions.zip\EPIP_submissions\docs\LR_5.2_476 EPIP_Remediation_Plan_(LR_5.2_476).docx Fri Mar 31 16:50:42 2017 UTC
2 EPIP_submissions.zip\EPIP_submissions\docs\LR_5.2_476 EPIP_Remediation_Plan_(LR_5.2_476).docx Fri Mar 31 17:49:09 2017 UTC

3.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 4 1450
Changed 3 10
Inserted 0 0
Removed 0 0

3.3 Comparison options

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

3.4 Active regular expressions

No regular expressions were active.

3.5 Comparison detail

  1   Existing P roduct Int ake Progra m (EPIP)
  2   Patch LR*5 .2*476
  3   Remediatio n Plan
  4  
  5  
  6   Department  of Vetera ns Affairs
  7   March 2017
  8   Version 3. 0
  9  
  10  
  11  
  12   Revision H istory
  13   Date
  14   Version
  15   Descriptio n
  16   Author
  17   03/03/2017
  18   3.0
  19   Minor chan ges throug hout. Upda ted Sectio n 3 (Patch  Descripti on) to des cribe use  of EXECUTE  CODE file  (#62.07).  
  20   EPIP Proje ct Team
  21   12/22/2016
  22   2.0
  23   Updated en tire docum ent
  24   EPIP Proje ct Team
  25   11/28/2016
  26   1.0
  27   Initial (d raft) vers ion
  28   EPIP Proje ct Team
  29  
  30  
  31  
  32  
  33   Table of C ontents
  34   1.Introduc tion1
  35   2.Purpose1
  36   3.Patch De scription1
  37   3.1.Needs  and Requir ements3
  38   4.Points o f Contact3
  39   5.Code Rem ediation3
  40   5.1.Standa rds and Co nventions4
  41   5.2.Review  and Analy sis4
  42   5.3.Coding  Changes4
  43   6.Testing4
  44   6.1.Test P lan5
  45   6.2.Test E nvironment 5
  46   6.3.Test R eadiness R eview5
  47   6.4.Testin g Phases5
  48   6.4.1.Unit  Testing5
  49   6.4.2.Comp onent Inte gration an d Systems  Testing (C I/ST)6
  50   6.4.3.Func tional Tes ting6
  51   6.4.4.Regr ession Tes ting6
  52   6.4.5.Sect ion 508 Co mpliance T esting6
  53   7.Document ation Reme diation6
  54   7.1.User G uides6
  55   7.2.Instal lation Gui des7
  56   7.3.Techni cal Manual s7
  57   7.4.Operat ions Manua ls7
  58   8.Project  Reporting7
  59   9.Project  Schedule7
  60   10.Deploym ent7
  61   11.Sustain ment Requi rements7
  62   12.Mainten ance and K nowledge T ransfer7
  63   Appendix A :XINDEX Li sting for  MUMPS Code  Changes8
  64   Appendix B :Source Co de Changes 10
  65  
  66  
  67  
  68   Introducti on
  69   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. 
  70   Purpose
  71   The purpos e of this  document i s to fully  describe  the remedi ation plan  to be use d for the  successful  remediati on and tes ting of th e intake p roduct cod e to be de ployed as  patch LR*5 .2*476. Th is patch a ddresses t he followi ng NSRs:
  72   NSR2015080 1 Print Us er Name -  ID Number  for Qualit y Review
  73   This NSR h as been im plemented  locally at  the VA Me dical Cent er in Clev eland OH.
  74   NSR2009030 5 LAB RESU LT REPORT  FUNCTION F ileman
  75   This NSR h as been im plemented  locally at  the follo wing VA Me dical Cent ers: Richm ond VA (an d other VI SN 6 locat ions), Ind ianapolis  IN, Tuscal oosa AL, M inneapolis  MN, and O klahoma Ci ty OK. 
  76   NSR2016100 9 Batch En try of Mic robiology  Preliminar y Comments
  77   This NSR h as been im plemented  locally at  the follo wing VA Me dical Cent ers: Los A ngeles CA,  Albuquerq ue NM, Ash eville NC,  and San D iego CA.
  78   This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation,  and delive ry of this  remediati on effort.
  79   Patch Desc ription
  80   LR*5.2*476  provides  the follow ing enhanc ements to  VistA:
  81   Enables tr acking of  users who  reprint La boratory a ccession l abels. Whe n a user r eprints an  accession  label for  a specime n, this en hancement  adds the u ser’s inte rnal numbe r to the l abel for q uality con trol purpo ses. This  internal n umber is t he Designa ted User ( DUZ) from  the NEW PE RSON file  (#200). Th e lab rout ines LRLAB XOL and LR LABXT have  been modi fied to su pport this  enhanceme nt.
  82   Printing o f the user ’s DUZ on  the label  applies on ly to exis ting acces sions; tha t is, thos e reprinte d after th e original  accession  was creat ed. 
  83  
  84   Reprinted  Accession  Label
  85   Enables re porting on  historica l lab resu lts throug h FileMan.  This Lab  Result Rep ort Functi on (LRRF)  enhancemen t consists  of a File Man report  used by P harmacy Au tomated Da ta Process ing Applic ation Coor dinators ( ADPACs) an d lab info rmaticists . The repo rt shows l ab results  for a spe cified pat ient, lab  test, and  specimen t ype, looki ng back ov er a speci fied numbe r of days.  This enha ncement ap plies only  to lab te sts with v erified re sults. 
  86   Users must  be famili ar with Fi leMan file  structure  and comma nds to run  the repor t. Input p arameters  are: a) th e Internal  Entry Num ber (IEN)  of the pat ient; b) t he IEN of  the lab te st in the  LABORATORY  TEST file  (#60); c)  the speci men type I EN from th e TOPOGRAP HY FIELD f ile (#61);  and d) th e look-bac k number o f days. Th e new File Man functi on LRRESUL T and the  new lab ro utine LRFR SLT are ex ported to  support th is enhance ment.
  87   Enables ba tch entry  of prelimi nary comme nts for de signated a ccession n umbers. Wh en a Micro biology Te chnician e nters prel iminary co mments for  accession s with neg ative cult ures, this  enhanceme nt enables  the techn ician to e nter the s ame commen t for mult iple acces sion numbe rs. For ex ample, a s ite might  process hu ndreds of  urine cult ures daily . Currentl y, the tec hnician mu st enter a  “No growt h after 24  hours” pr eliminary  result ind ividually  for each a pplicable  accession.  With this  modificat ion, techn icians can  enter the  same prel iminary re sult for a ll applica ble access ions at on ce, reduci ng the tim e and effo rt require d to make  preliminar y results  available  for clinic al use. 
  88   This modif ication ad ds the fol lowing sub -fields fr om the LAB  DATA file  (#63), MI CROBIOLOGY  field (#5 ), sub-fil e #63.05,  to the RB  Results En try (Batch ) [LRMISTU F] menu op tion in Vi stA: PRELI MINARY BAC T COMMENT  (#1) for B acteriolog y accessio ns; PRELIM INARY MYCO LOGY COMME NT (#20.5)  for Mycol ogy access ions; and  PRELIMINAR Y TB COMME NT (#26.5)  for Mycob acteriolog y accessio ns. For ea ch sub-fie ld selecte d, the tec hnician en ters the p reliminary  comment a nd then en ters the a ccession n umbers to  be updated  with that  comment. 
  89   If the tec hnician en ters a pre liminary c omment in  one of the  new sub-f ields, rou tine LRMIS TF updates  the corre sponding B ACTERIOLOG Y, TB BACT ERIOLOGY,  or MYCOLOG Y data rec ord in the  EXECUTE C ODE file ( #62.07), E XECUTE COD E field (# 1). 
  90   Needs and  Requiremen ts
  91   The Needs  and Requir ements for  the NSRs  addressed  in this re mediation  are:
  92   NSR2015080 1 Print Us er Name -  ID Number  for Qualit y Review:
  93   NEED 61973 6: Identif ication Ad ded To A R eprinted L ab Accessi on Label –  As a labo ratory tec hnician/te chnologist /administr ator I nee d the user  name and  tech ident ifier numb er added t o a reprin ted a lab  accession  label so t hat I can  use this i nformation  for quali ty control  purposes  in identif ying who r eprinted t he label.
  94   NSR2009030 5 LAB RESU LT REPORT  FUNCTION F ileman:
  95   NEED 38592 0: LRRF Di splay Lab  Results wi th Test Sp ecimen – T he ability  to displa y lab resu lts for a  given test  and speci men for a  given date  range.
  96   REQUIREMEN T 392844:  Display La b Results  Medication /Lab Resul t Pair – P rovide the  ability t o view lab  results f or a medic ation and  lab result  pair for  a patient  or group o f patients .
  97   NSR2016100 9 Batch En try of Mic robiology  Preliminar y Comments :
  98   NEED 84879 7: For Mic robiology  Technician s who ente r prelimin ary commen ts during  processing  of Microb iology tes ts, a proc ess is nee ded that p rovides th e ability  to enter s imilar pre liminary c omments in  batch tha t improves  the effic iency in w hich Micro biology te sts can be  processed .
  99   Points of  Contact
  100   The VA Poi nt of Cont act (POC)  for NSR201 50801 Prin t User Nam e - ID Num ber for Qu ality Revi ew is 
  101   The VA POC  for NSR20 090305 LAB  RESULT RE PORT FUNCT ION Filema n is 
  102   The VA POC  for NSR20 161009 Bat ch Entry o f Microbio logy Preli minary Com ments
.
  103   Code Remed iation
  104   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.
  105   Standards  and Conven tions
  106   Leidos wil l referenc e the 
website fo r applicab le documen ts and wil l adhere t o VA stand ards to co mplete the  analysis  of this in take produ ct. The ou tput of th e VA XINDE X utility  will be us ed to anal yze the MU MPS source  code and  document t he affecte d routines  (see Appe ndix A).
  107   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.
  108   Review and  Analysis
  109   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. 
  110   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. 
  111   Coding Cha nges
  112   The coding  changes r equired fo r NSR20150 801 Print  User Name  - ID Numbe r for Qual ity Review  are in th e followin g MUMPS ro utines:
  113   Modified r outines: L RLABXOL, L RLABXT
  114   New routin es: None
  115   The coding  changes r equired fo r NSR20090 305 LAB RE SULT REPOR T FUNCTION  Fileman a re in the  following  MUMPS rout ines:
  116   Modified r outines: N one
  117   New routin es: LRFRSL T
  118   New FileMa n function : LRRESULT  (calls ro utine LRFR SLT)
  119   The coding  changes r equired fo r NSR20161 009 Batch  Entry of M icrobiolog y Prelimin ary Commen ts are in  the follow ing MUMPS  routines:
  120   Modified r outines: L RMISTF
  121   New routin es: None
  122   A detailed  analysis  of the cod ing change s is provi ded in App endix B.
  123   Testing
  124   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.
  125   Test Plan
  126   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.
  127   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.
  128   Test Envir onment
  129   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.
  130   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. 
  131   Test Readi ness Revie w
  132   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 ).
  133   Testing Ph ases
  134   Leidos wil l perform  developmen t and SQA  testing ac tivities i n phases,  and will p rovide all  required  testing do cumentatio n.
  135   Unit Testi ng
  136   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. 
  137   Component  Integratio n and Syst ems Testin g (CI/ST)
  138   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.
  139   Functional  Testing
  140   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. 
  141   Regression  Testing
  142   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.  
  143   Section 50 8 Complian ce Testing
  144   508 testin g will be  performed  on VistA a nd CPRS co de when ne w CPRS GUI  changes a re introdu ced by the  developer . The VA-r ecommended  Assistive  Technolog y tool, JA WS, will b e used to  conduct th e 508 test ing. Test  results an d related  documentat ion will b e submitte d to the V A Section  508 team i n accordan ce with th e VA 508 t esting req uirements.  Defects f ound durin g testing  will be as sessed and  remediate d by the d eveloper.
  145   Documentat ion Remedi ation
  146   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.
  147   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
. Keyword  searches u sing terms  relevant  to this re mediation  effort wil l be used  to identif y document s that mig ht be impa cted; thos e document s were wil l then be  reviewed i n their en tirety for  any neede d revision s.
  148   The follow ing sectio ns outline  the VDL d ocuments t o be revis ed for thi s remediat ion.
  149   User Guide s
  150   The follow ing User G uide will  be updated  in the VD L:
  151   Laboratory  User Manu al
  152   Installati on Guides
  153   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.
  154   Technical  Manuals
  155   The follow ing Techni cal Manual  will be u pdated in  the VDL:
  156   Laboratory  Technical  Manual
  157   Operations  Manuals
  158   No Operati ons Manual s require  revision a s a result  of this m odificatio n.
  159   Project Re porting
  160   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. 
  161   Project Sc hedule
  162   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.  
  163   Deployment
  164   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.
  165   Sustainmen t Requirem ents
  166   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 .  
  167   Maintenanc e and Know ledge Tran sfer
  168   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.
  169   XINDEX Lis ting for M UMPS Code  Changes
  170   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.
  171   VISTAS1:VI STA>D ^XIN DEX
  172  
  173  
  174                       V . A.  C R  O S S  R E  F E R E N  C E R  7. 3
  175                            [2008 V A Standard s & Conven tions]
  176                      UC I: VISTA C PU: ROU     Dec 14, 2 016@08:15: 49
  177  
  178   All Routin es? No =>  No
  179  
  180   Routine: 
  181   0 routines
  182  
  183   Select BUI LD NAME: L R*5.2*476     
  184  
  185   Include th e compiled  template  routines:  N//
  186  
  187   Print more  than comp iled error s and warn ings? YES/ /
  188  
  189   Print summ ary only?  NO//
  190  
  191   Print rout ines? YES/ /N
  192  
  193   Print the  DDs, Funct ions, and  Options? Y ES//
  194  
  195   Print erro rs and war nings with  each rout ine? YES//
  196  
  197   Save param eters in R OUTINE fil e? NO//
  198  
  199   Index all  called rou tines? NO/ /
  200   DEVICE: ;8 0;9999  HO ME  (CRT)
  201  
  202  
  203                       V . A.  C R  O S S  R E  F E R E N  C E R  7. 3
  204                            [2008 V A Standard s & Conven tions]
  205                      UC I: VISTA C PU: ROU     Dec 14, 2 016@08:15: 49
  206  
  207   The BUILD  file Data  Dictionari es are bei ng process ed.
  208  
  209   The option  and funct ion files  are being  processed.
  210  
  211  
  212   Routines a re being p rocessed.
  213   Routines:  4  Faux Ro utines: 1
  214  
  215   LRFRSLT    LRLABXOL   LRLABXT    LRMISTF   
  216  
  217              Data Dicti onaries
  218   |func           
  219  
  220   --- CROSS  REFERENCIN G ---
  221  
  222  
  223   Compiled l ist of Err ors and Wa rnings                Dec 14, 20 16@08:15:4 9 page 1
  224   No errors  or warning s to repor t
  225  
  226   Source Cod e Changes
  227   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 and Fi leMan func tion were  affected:
  228   Modified r outines: L RLABXOL, L RLABXT, LR MISTF 
  229   New routin es: LRFRSL T
  230   New FileMa n function : LRRESULT  (calls ro utine LRFR SLT)
  231   LRLABXOL
  232   Before:  
  233   LRLABXOL *  *  57 LIN ES,  (tota l 1830, co mments 276 ) BYTES    Page 1
  234           RS UM: old 27 94683, new  5111104
  235           UC I: VISTA,R OU    Site : TEST.CHE YENNE.MED. VA.GOVNOV  18,2016@14 :13
  236  
  237     1 LRLABX OL --
  238                ;RVAMC/P LS/DALISC/ FHS - REPR INT ACCESS ION LABELS  FOR ENTIR E ORDER ;  5/19/93  0 7:40
  239     2         ;;5.2;LAB  SERVICE;* *11,121,16 1**;Sep 27 , 1994
  240     3         ; Will pr int all th e required  labels fo r a entire  order.
  241     4 EN      K ZTSK
  242     5         D IOCHK^L RLABXT G E ND:'$D(LRL ABLIO)
  243     6         D PSET^LR LABLD
  244     7         S LRHDR=" Select Ord er Number:  "
  245     8 1       U IO(0)
  246     9         W !!,LRHD R R LRORD: DTIME G:'$ T END G:(L RORD="")!( LRORD="^")  END I LRO RD?.AP!(LR ORD<1) W ! ,"Enter a  whole numb er for the  
  247                order nu mber." G 1
  248    10         S LRORD=+ LRORD
  249    11         S LRODT=$ O(^LRO(69, "C",LRORD, 0))
  250    12         I +LRODT< 1 W "  ORD ER NUMBER  NOT FOUND"  G 1
  251    13         I '$$GOT^ LROE(LRORD ,LRODT) W  !!,"All te sts for th is order h ave been c anceled."  H 1 G 1
  252    14         I $D(LRLA BLIO("Q"))  D  G END
  253    15         . S ZTIO= LRLABLIO,Z TRTN="QUE^ LRLABXOL", ZTDESC="LA B ORDER LA BELS",ZTSA VE("LR*")= ""
  254    16         . D ^%ZTL OAD
  255    17         . W !,"La bels have  been taske d to print  ",!
  256    18         D QUE
  257    19         K LRORD
  258    20         U IO(0) W  !?10,"Lab el(s) Prin ted",! S L RHDR="Anot her Order  Number: "
  259    21         G 1
  260    22         ;
  261    23 QUE     ;
  262    24         S LRODT=0
  263    25         F  S LROD T=$O(^LRO( 69,"C",LRO RD,LRODT))  Q:LRODT<1   D 2,PRIN T
  264    26         I $D(ZTQU EUED) S ZT REQ="@"
  265    27         Q
  266    28         ;
  267    29 2       ;
  268    30         S LRSN=0
  269    31         F  S LRSN =+$O(^LRO( 69,"C",LRO RD,LRODT,L RSN)) Q:LR SN<1  D SQ
  270    32         Q
  271    33         ;
  272    34 SQ      ; Search  for access ion number s and buil d LRORD ar ray 'ORD # (SEQ #,ACC  AREA,ACC  DATE, ACC  #)=""'
  273    35         Q:'$D(^LR O(69,LRODT ,1,LRSN,2, 0))
  274    36         S SEQ=0
  275    37         F  S SEQ= +$O(^LRO(6 9,LRODT,1, LRSN,2,SEQ )) Q:SEQ<1   D
  276    38         . S X=$G( ^LRO(69,LR ODT,1,LRSN ,2,SEQ,0)) ,LRAD=$P(X ,U,3),LRAA =$P(X,U,4) ,LRAN=$P(X ,U,5)
  277    39         . I LRAA, LRAD,LRAN  S LRORD(LR SN,LRAA,LR AD,LRAN)=" "
  278    40         Q
  279    41         ;
  280    42 PRINT   ; Loop th ru array a nd print l abels.
  281    43         U IO
  282    44         S LRAA=""
  283    45         F  S LRX= $Q(LRORD)  Q:LRX=""   Q:$QS(LRX, 0)'="LRORD "  D
  284    46         . S LRSN= $QS(LRX,1)
  285    47         . I LRAA' =$QS(LRX,2 ) S LRAA=$ QS(LRX,2)  D LBLTYP^L RLABLD
  286    48         . S LRAD= $QS(LRX,3) ,LRAN=$QS( LRX,4)
  287    49         . K LRORD (LRSN,LRAA ,LRAD,LRAN )
  288    50         . N LRORD ,LRX
  289    51         . D PRINT ^LRLABXT
  290    52         Q
  291    53         ;
  292    54 END     ;
  293    55         K LRHDR,L RORD,SEQ,Z TSK
  294    56         D K^LRLAB XT
  295    57         Q
  296  
  297   ========== ========== ========== ========== ========== ========== ==========  
  298  
  299   After: 
  300   LRLABXOL *  *  60 LIN ES,  (tota l 1961, co mments 369 ) BYTES    Page 1
  301           RS UM: old 28 21279, new  5338976
  302           UC I: VISTA,R OU    Site : TEST.CHE YENNE.MED. VA.GOVNOV  18,2016@13 :49
  303  
  304     1 LRLABX OL --
  305                ;RVAMC/P LS/DALISC/ FHS - REPR INT ACCESS ION LABELS  FOR ENTIR E ORDER ;  10/24/16 3 :40pm
  306     2         ;;5.2;LAB  SERVICE;* *11,121,16 1,476**;Se p 27, 1994
  307     3         ; Will pr int all th e required  labels fo r a entire  order.
  308     4 EN      K ZTSK
  309     5         D IOCHK^L RLABXT G E ND:'$D(LRL ABLIO)
  310     6         D PSET^LR LABLD
  311     7         S LRHDR=" Select Ord er Number:  "
  312     8 1       U IO(0)
  313     9         W !!,LRHD R R LRORD: DTIME G:'$ T END G:(L RORD="")!( LRORD="^")  END I LRO RD?.AP!(LR ORD<1) W ! ,"Enter a  whole numb er for the  
  314                order nu mber." G 1
  315    10         S LRORD=+ LRORD
  316    11         S LRODT=$ O(^LRO(69, "C",LRORD, 0))
  317    12         I +LRODT< 1 W "  ORD ER NUMBER  NOT FOUND"  G 1
  318    13         I '$$GOT^ LROE(LRORD ,LRODT) W  !!,"All te sts for th is order h ave been c anceled."  H 1 G 1
  319    14         ; LR*5.2* 476/CR - 1 0/24/16, c apture who  is reprin ting a lab el
  320    15         N LRPRTDU Z S LRPRTD UZ=DUZ
  321    16         I $D(LRLA BLIO("Q"))  D  G END
  322    17         . S ZTIO= LRLABLIO,Z TRTN="QUE^ LRLABXOL", ZTDESC="LA B ORDER LA BELS",ZTSA VE("LR*")= ""
  323    18         . D ^%ZTL OAD
  324    19         . W !,"La bels have  been taske d to print  ",!
  325    20         ; end cha nges for l abel repri nt
  326    21         D QUE
  327    22         K LRORD
  328    23         U IO(0) W  !?10,"Lab el(s) Prin ted",! S L RHDR="Anot her Order  Number: "
  329    24         G 1
  330    25         ;
  331    26 QUE     ;
  332    27         S LRODT=0
  333    28         F  S LROD T=$O(^LRO( 69,"C",LRO RD,LRODT))  Q:LRODT<1   D 2,PRIN T
  334    29         I $D(ZTQU EUED) S ZT REQ="@"
  335    30         Q
  336    31         ;
  337    32 2       ;
  338    33         S LRSN=0
  339    34         F  S LRSN =+$O(^LRO( 69,"C",LRO RD,LRODT,L RSN)) Q:LR SN<1  D SQ
  340    35         Q
  341    36         ;
  342    37 SQ      ; Search  for access ion number s and buil d LRORD ar ray 'ORD # (SEQ #,ACC  AREA,ACC  DATE, ACC  #)=""'
  343    38         Q:'$D(^LR O(69,LRODT ,1,LRSN,2, 0))
  344    39         S SEQ=0
  345    40         F  S SEQ= +$O(^LRO(6 9,LRODT,1, LRSN,2,SEQ )) Q:SEQ<1   D
  346    41         . S X=$G( ^LRO(69,LR ODT,1,LRSN ,2,SEQ,0)) ,LRAD=$P(X ,U,3),LRAA =$P(X,U,4) ,LRAN=$P(X ,U,5)
  347    42         . I LRAA, LRAD,LRAN  S LRORD(LR SN,LRAA,LR AD,LRAN)=" "
  348    43         Q
  349    44         ;
  350    45 PRINT   ; Loop th ru array a nd print l abels.
  351    46         U IO
  352    47         S LRAA=""
  353    48         F  S LRX= $Q(LRORD)  Q:LRX=""   Q:$QS(LRX, 0)'="LRORD "  D
  354    49         . S LRSN= $QS(LRX,1)
  355    50         . I LRAA' =$QS(LRX,2 ) S LRAA=$ QS(LRX,2)  D LBLTYP^L RLABLD
  356    51         . S LRAD= $QS(LRX,3) ,LRAN=$QS( LRX,4)
  357    52         . K LRORD (LRSN,LRAA ,LRAD,LRAN )
  358    53         . N LRORD ,LRX
  359    54         . D PRINT ^LRLABXT
  360    55         Q
  361    56         ;
  362    57 END     ;
  363    58         K LRHDR,L RORD,SEQ,Z TSK
  364    59         D K^LRLAB XT
  365    60         Q
  366   ========== ========== ========== ========== ========== ========== ========
  367   LRLABXT
  368   Before:  
  369   LRLABXT *  *  100 LIN ES,  (tota l 3454, co mments 322 ) BYTES    Page 1
  370           RS UM: old 60 60326, new  16292452
  371           UC I: VISTA,R OU    Site : TEST.CHE YENNE.MED. VA.GOVNOV  18,2016@14 :13
  372  
  373     1 LRLABX T ;SLC/TGA  - REPRINT S DEMAND L ABELS ; 12 /8/15 6:11 pm
  374     2         ;;5.2;LAB  SERVICE;* *80,161**; Sep 27, 19 94
  375     3         ;
  376     4 EN      ; Reprint  labels
  377     5         D IOCHK
  378     6         I '$D(LRL ABLIO) D K  Q
  379     7         D OPEN^%Z ISUTL("LRH OME","HOME ") ; Setup  handle fo r user's " HOME" devi ce.
  380     8         D USE^%ZI SUTL("LRHO ME")
  381     9         K DIR,DIR UT,DTOUT,D UOUT,X,Y
  382    10         S DIR(0)= "SO^1:Rang e of Acces sions;2:Se lected Acc essions",D IR("A")="S election M ethod",DIR ("B")=1
  383    11         D ^DIR
  384    12         I $D(DIRU T) D K Q
  385    13         S LRTYPE= +Y
  386    14 ASK     ;
  387    15         D USE^%ZI SUTL("LRHO ME")
  388    16         S (LRACC, LREXMPT)=1 ,(LRCNT,LR QUIT)=0
  389    17         K ^TMP("L RLABXT",$J )
  390    18         I LRTYPE= 1 D
  391    19         . D ^LRWU 4
  392    20         . I LRAN< 1 S LRQUIT =1 Q  ; Us er aborted  selection .
  393    21         . S FIRST =LRAN,X=$O (^LRO(68,L RAA,1,LRAD ,1,":"),-1 )
  394    22         . W !
  395    23         . S DIR(0 )="NO^"_LR AN_":"_X_" :0",DIR("A ")="Reprin t from "_L RAN_" to", DIR("B")=L RAN
  396    24         . D ^DIR  K DIR
  397    25         . I $D(DI RUT) S LRQ UIT=1 Q
  398    26         . W !
  399    27         . S LRAN= FIRST-1,LA ST=Y
  400    28         . F  S LR AN=$O(^LRO (68,LRAA,1 ,LRAD,1,LR AN)) Q:'LR AN!(LRAN>L AST)  D
  401    29         . . W:$X> (IOM-1) !  W "." ; Le t user kno w we're lo oking.
  402    30         . . D SET TMP
  403    31         I LRTYPE= 2 F  D  Q: LRQUIT!(LR AN<1)
  404    32         . D ^LRWU 4
  405    33         . I $D(DT OUT)!($D(D UOUT)) S L RQUIT=1 Q
  406    34         . I LRAN< 1 S:'$D(^T MP("LRLABX T",$J)) LR QUIT=1 Q
  407    35         . D SETTM P
  408    36         I 'LRQUIT ,LRCNT>10  D
  409    37         . N DIR,D IRUT,DTOUT ,DUOUT,X,Y
  410    38         . S DIR(0 )="YO",DIR ("A",1)="R eprinting  labels for  "_LRCNT_"  accession s!",DIR("A ")="Are yo u sure",DI R("B")="NO "
  411    39         . D ^DIR
  412    40         . I Y<1!( $D(DIRUT))  S LRQUIT= 1 Q
  413    41         I LRQUIT  D K Q
  414    42         I $D(LRLA BLIO("Q"))  D  G ASK
  415    43         . S ZTIO= LRLABLIO,Z TRTN="LOAD ^LRLABXT", ZTDESC="Re print Lab  Accession  Labels"
  416    44         . S ZTSAV E("^TMP("" LRLABXT"", $J,")=""
  417    45         . D ^%ZTL OAD
  418    46         . W !,"La bels ",$S( $G(ZTSK):" queued to  "_$P(LRLAB LIO,";")_"  Task #"_Z TSK,1:"NOT  queued"), !
  419    47         . K ZTSK, ZTRTN,ZTIO ,ZTDESC,ZT SAVE
  420    48         W !!,"Pri nting labe ls on ",$P (LRLABLIO, ";"),!
  421    49         D USE^%ZI SUTL("LRLA BEL")
  422    50 LOAD    ; Tasked  entry poin t and from  above.
  423    51         D PSET^LR LABLD
  424    52         F  S LRLA BX=$Q(^TMP ("LRLABXT" ,$J)) Q:LR LABX=""  Q :$QS(LRLAB X,1)'="LRL ABXT"!($QS (LRLABX,2) '=$J)  D
  425    53         . S LRAA= $QS(LRLABX ,3),LRAD=$ QS(LRLABX, 4),LRAN=$Q S(LRLABX,5 )
  426    54         . D LBLTY P^LRLABLD
  427    55         . D PRINT
  428    56         . K @LRLA BX
  429    57         I $D(ZTQU EUED) D K  Q
  430    58         G ASK
  431    59         ;
  432    60 PRINT   ;
  433    61         ; Called  by above,  LRLABXOL
  434    62         Q:'$D(^LR O(68,LRAA, 1,LRAD,1,L RAN,0))
  435    63         S X=^LRO( 68,LRAA,1, LRAD,1,LRA N,0),LRSN= +$P(X,U,5) ,LRODT=+$P (X,U,4),LR LLOC=$P(X, U,7)
  436    64         S LRCE=$P ($G(^LRO(6 8,LRAA,1,L RAD,1,LRAN ,.1)),"^")
  437    65         S LRACC=$ P($G(^LRO( 68,LRAA,1, LRAD,1,LRA N,.2)),"^" )
  438    66         S LRRB=0
  439    67         D LRBAR^L RLABLD
  440    68         D GO^LRLA BLD
  441    69         Q
  442    70         ;
  443    71 IOCHK   ; Select  and check  label prin ter.
  444    72         ; Called  from above , LRLABXOL
  445    73         I '$D(LRL ABLIO) D
  446    74         . D ^LRLA BLIO
  447    75         . ; Time  delay - al low port t o be reope ned if clo sed in cal l to LRLAB LIO
  448    76         . I $D(LR LABLIO),'$ D(IO("Q"))  H 2
  449    77         I '$D(LRL ABLIO) Q
  450    78         I '$D(LRL ABLIO("Q") ) D
  451    79         . N %ZIS, IOP
  452    80         . S %ZIS= "",IOP=LRL ABLIO
  453    81         . D OPEN^ %ZISUTL("L RLABEL",IO P,.%ZIS) ;  Setup han dle for us er's LABEL  device.
  454    82         . I POP D
  455    83         . . W !,$ C(7),"Unab le to open  device"
  456    84         . . K LRL ABLIO
  457    85         Q
  458    86         ;
  459    87 SETTMP  ; Setup T MP global  with acces sion to re print.
  460    88         S LRCNT=L RCNT+1,^TM P("LRLABXT ",$J,LRAA, LRAD,LRAN) =""
  461    89         Q
  462    90         ;
  463    91 K       ; Cleanup
  464    92         I $D(ZTQU EUED) S ZT REQ="@"
  465    93         E  D CLOS E^%ZISUTL( "LRLABEL") ,CLOSE^%ZI SUTL("LRHO ME"),PKILL ^%ZISP
  466    94         D KVAR^LR X
  467    95         K %,IO("Q "),A,B,DIC ,I,I1,IOP, J,K,L,LAST ,N,POP,R,S 1,S2,T,X,Y ,Z
  468    96         K LRAA,LR ACC,LRAD,L RAN,LRCE,L RCNT,LRDAT ,LRDPF,LRE XMPT,LRINF W,LRLABEL, LRLF,LRDFN ,LRODT,LRP REF,LRSSP
  469    97         K LRNOLAB L,LRPRAC,L RTJ,LRTJDA TA,LRLABX, LRQUIT,LRT OP,LRTS,LR TYPE,LRTV, LRTVOL,LRT XT,LRVOL,L RLABLIO,LR FN,LRAD,LR LLOC,LRNN, L
  470                RRB,LRSN
  471    98         K LRX,LRX L,LRBAR,LR BAR1,LRBAR 0,LRBARID, LRUID,LRUR G,LRURG0,L RURGA
  472    99         K ^TMP("L RLABXT",$J )
  473   100         Q
  474   ========== ========== ========== ========== ========== ========== ========
  475   After: 
  476   LRLABXT *  *  102 LIN ES,  (tota l 3568, co mments 384 ) BYTES    Page 1
  477           RS UM: old 61 32861, new  16727986
  478           UC I: VISTA,R OU    Site : TEST.CHE YENNE.MED. VA.GOVNOV  18,2016@13 :50
  479  
  480     1 LRLABX T ;SLC/TGA  - REPRINT S DEMAND L ABELS ; 10 /24/16 3:4 6pm
  481     2         ;;5.2;LAB  SERVICE;* *80,161,47 6**;Sep 27 , 1994
  482     3         ;
  483     4 EN      ; Reprint  labels
  484     5         D IOCHK
  485     6         I '$D(LRL ABLIO) D K  Q
  486     7         D OPEN^%Z ISUTL("LRH OME","HOME ") ; Setup  handle fo r user's " HOME" devi ce.
  487     8         D USE^%ZI SUTL("LRHO ME")
  488     9         K DIR,DIR UT,DTOUT,D UOUT,X,Y
  489    10         S DIR(0)= "SO^1:Rang e of Acces sions;2:Se lected Acc essions",D IR("A")="S election M ethod",DIR ("B")=1
  490    11         D ^DIR
  491    12         I $D(DIRU T) D K Q
  492    13         S LRTYPE= +Y
  493    14 ASK     ;
  494    15         D USE^%ZI SUTL("LRHO ME")
  495    16         S (LRACC, LREXMPT)=1 ,(LRCNT,LR QUIT)=0
  496    17         K ^TMP("L RLABXT",$J )
  497    18         I LRTYPE= 1 D
  498    19         . D ^LRWU 4
  499    20         . I LRAN< 1 S LRQUIT =1 Q  ; Us er aborted  selection .
  500    21         . S FIRST =LRAN,X=$O (^LRO(68,L RAA,1,LRAD ,1,":"),-1 )
  501    22         . W !
  502    23         . S DIR(0 )="NO^"_LR AN_":"_X_" :0",DIR("A ")="Reprin t from "_L RAN_" to", DIR("B")=L RAN
  503    24         . D ^DIR  K DIR
  504    25         . I $D(DI RUT) S LRQ UIT=1 Q
  505    26         . W !
  506    27         . S LRAN= FIRST-1,LA ST=Y
  507    28         . F  S LR AN=$O(^LRO (68,LRAA,1 ,LRAD,1,LR AN)) Q:'LR AN!(LRAN>L AST)  D
  508    29         . . W:$X> (IOM-1) !  W "." ; Le t user kno w we're lo oking.
  509    30         . . D SET TMP
  510    31         I LRTYPE= 2 F  D  Q: LRQUIT!(LR AN<1)
  511    32         . D ^LRWU 4
  512    33         . I $D(DT OUT)!($D(D UOUT)) S L RQUIT=1 Q
  513    34         . I LRAN< 1 S:'$D(^T MP("LRLABX T",$J)) LR QUIT=1 Q
  514    35         . D SETTM P
  515    36         I 'LRQUIT ,LRCNT>10  D
  516    37         . N DIR,D IRUT,DTOUT ,DUOUT,X,Y
  517    38         . S DIR(0 )="YO",DIR ("A",1)="R eprinting  labels for  "_LRCNT_"  accession s!",DIR("A ")="Are yo u sure",DI R("B")="NO "
  518    39         . D ^DIR
  519    40         . I Y<1!( $D(DIRUT))  S LRQUIT= 1 Q
  520    41         I LRQUIT  D K Q
  521    42         ; LR*5.2* 476/CR - 1 0/24/16, c apture who  is reprin ting a lab el
  522    43         N LRPRTDU Z S LRPRTD UZ=DUZ
  523    44         I $D(LRLA BLIO("Q"))  D  G ASK
  524    45         . S ZTIO= LRLABLIO,Z TRTN="LOAD ^LRLABXT", ZTDESC="Re print Lab  Accession  Labels"
  525    46         . S ZTSAV E("^TMP("" LRLABXT"", $J,")="",Z TSAVE("LR* ")=""
  526    47         . D ^%ZTL OAD
  527    48         . W !,"La bels ",$S( $G(ZTSK):" queued to  "_$P(LRLAB LIO,";")_"  Task #"_Z TSK,1:"NOT  queued"), !
  528    49         . K ZTSK, ZTRTN,ZTIO ,ZTDESC,ZT SAVE
  529    50         W !!,"Pri nting labe ls on ",$P (LRLABLIO, ";"),!
  530    51         D USE^%ZI SUTL("LRLA BEL")
  531    52 LOAD    ; Tasked  entry poin t and from  above.
  532    53         D PSET^LR LABLD
  533    54         F  S LRLA BX=$Q(^TMP ("LRLABXT" ,$J)) Q:LR LABX=""  Q :$QS(LRLAB X,1)'="LRL ABXT"!($QS (LRLABX,2) '=$J)  D
  534    55         . S LRAA= $QS(LRLABX ,3),LRAD=$ QS(LRLABX, 4),LRAN=$Q S(LRLABX,5 )
  535    56         . D LBLTY P^LRLABLD
  536    57         . D PRINT
  537    58         . K @LRLA BX
  538    59         I $D(ZTQU EUED) D K  Q
  539    60         G ASK
  540    61         ;
  541    62 PRINT   ;
  542    63         ; Called  by above,  LRLABXOL
  543    64         Q:'$D(^LR O(68,LRAA, 1,LRAD,1,L RAN,0))
  544    65         S X=^LRO( 68,LRAA,1, LRAD,1,LRA N,0),LRSN= +$P(X,U,5) ,LRODT=+$P (X,U,4),LR LLOC=$P(X, U,7)
  545    66         S LRCE=$P ($G(^LRO(6 8,LRAA,1,L RAD,1,LRAN ,.1)),"^")
  546    67         S LRACC=$ P($G(^LRO( 68,LRAA,1, LRAD,1,LRA N,.2)),"^" )
  547    68         S LRRB=0
  548    69         D LRBAR^L RLABLD
  549    70         D GO^LRLA BLD
  550    71         Q
  551    72         ;
  552    73 IOCHK   ; Select  and check  label prin ter.
  553    74         ; Called  from above , LRLABXOL
  554    75         I '$D(LRL ABLIO) D
  555    76         . D ^LRLA BLIO
  556    77         . ; Time  delay - al low port t o be reope ned if clo sed in cal l to LRLAB LIO
  557    78         . I $D(LR LABLIO),'$ D(IO("Q"))  H 2
  558    79         I '$D(LRL ABLIO) Q
  559    80         I '$D(LRL ABLIO("Q") ) D
  560    81         . N %ZIS, IOP
  561    82         . S %ZIS= "",IOP=LRL ABLIO
  562    83         . D OPEN^ %ZISUTL("L RLABEL",IO P,.%ZIS) ;  Setup han dle for us er's LABEL  device.
  563    84         . I POP D
  564    85         . . W !,$ C(7),"Unab le to open  device"
  565    86         . . K LRL ABLIO
  566    87         Q
  567    88         ;
  568    89 SETTMP  ; Setup T MP global  with acces sion to re print.
  569    90         S LRCNT=L RCNT+1,^TM P("LRLABXT ",$J,LRAA, LRAD,LRAN) =""
  570    91         Q
  571    92         ;
  572    93 K       ; Cleanup
  573    94         I $D(ZTQU EUED) S ZT REQ="@"
  574    95         E  D CLOS E^%ZISUTL( "LRLABEL") ,CLOSE^%ZI SUTL("LRHO ME"),PKILL ^%ZISP
  575    96         D KVAR^LR X
  576    97         K %,IO("Q "),A,B,DIC ,I,I1,IOP, J,K,L,LAST ,N,POP,R,S 1,S2,T,X,Y ,Z
  577    98         K LRAA,LR ACC,LRAD,L RAN,LRCE,L RCNT,LRDAT ,LRDPF,LRE XMPT,LRINF W,LRLABEL, LRLF,LRDFN ,LRODT,LRP REF,LRSSP
  578    99         K LRNOLAB L,LRPRAC,L RTJ,LRTJDA TA,LRLABX, LRQUIT,LRT OP,LRTS,LR TYPE,LRTV, LRTVOL,LRT XT,LRVOL,L RLABLIO,LR FN,LRAD,LR LLOC,LRNN, L
  579                RRB,LRSN
  580   100         K LRX,LRX L,LRBAR,LR BAR1,LRBAR 0,LRBARID, LRUID,LRUR G,LRURG0,L RURGA
  581   101         K ^TMP("L RLABXT",$J )
  582   102         Q
  583   ========== ========== ========== ========== ========= 
  584  
  585   LRMISTF 
  586   Before: 
  587  
  588   LRMISTF *  *  32 LINE S,  (total  2619, com ments 84)  BYTES      Page 1
  589           RS UM: old 10 961987, ne w 13980655
  590           UC I: VISTA,R OU    Site : TEST.CHE YENNE.MED. VA.GOVDEC  14,2016@09 :23
  591  
  592     1 LRMIST F ;SLC/CJS /BA - MASS  DATA ENTR Y INTO FIL E 63.05 ;4 /24/89  14 :40 ;
  593     2         ;;5.2;LAB  SERVICE;* *153**;Sep  27, 1994
  594     3         ;from opt ion LRMIST UF
  595     4 ACCESS  I '$D(^XU SEC("LRVER IFY",DUZ))  W !,"You' re not cle ared for t his option . You must  have the  LRVERIFY K ey." Q
  596     5 BEGIN   D ^LRPARA M Q:$G(LRE ND)  S LRE ND=0,LRVT= "RE",LRSBS ="13^11.6^ 11.57^11.5 8^17^15.51 ^21^19.6^2 7^24^37",( Z(13),Z(11 .6),Z(11.5 7
  597                ),Z(11.5 8))=1,(Z(1 7),Z(15.51 ))=5,(Z(21 ),Z(19.6)) =8,(Z(27), Z(24))=11, Z(37)=16
  598     6         S LRMIMAS S=1
  599     7         D ASK
  600     8         I $D(LRCS Q),$O(^XTM P("LRCAP", LRCSQ,DUZ, 0)) D STD^ LRCAPV
  601     9 END     D ANN^LRM IEDZ,^LRGV K
  602    10         K %,AGE,D A,D1,DFN,D IC,DIE,DLA YGO,DOB,DQ ,DR,H9,I,J ,K,LRAA,LR AD,LRAN,LR CDT,LRCO,L RDFN,LRDPF ,LRECODE,L REND,LRIDT ,LRLLOC,LR M
  603                F,LRMODE ,LROK,LRNO P,LRPF,LRS B,LRSBCNT, LRSBS,LRSC REEN,LRTES T,LRWRD,LR VT,POP,PNM ,R,SEX,SSN ,X,X1,X2,Y ,Z
  604    11         K LRMIMAS S
  605    12         Q
  606    13 ASK     D LRAA^LR MIUT Q:LRA A<1  S LRS S=$P(^LRO( 68,LRAA,0) ,U,2)
  607    14         I LRSS=""  W !?5,"Ac cession Ar ea LR SUBS CRIPT is m isssing.", ! Q
  608    15         I $P(LRPA RAM,U,14)  D ^LRCAPV  G:LREND AN N^LRMIEDZ
  609    16         S %DT="AE ",%DT("A") ="Micro Ac cession Ye ar: ("_$E( DT,2,3)_") //" D ^%DT  K %DT("A" ) Q:X[U  S :X="" Y=$E (DT,1,3) S  LRAD=$E(Y ,
  610                1,3)_"00 00"
  611    17         S DIC="^L AB(60,",DI C("A")="Se lect MICRO BIOLOGY TE ST: ",DIC( 0)="AEMOQ" ,DIC("S")= "I $P(^(0) ,U,4)=""MI "",$L($P(^ (0),U,14)) "
  612                 D ^DIC  K DIC Q:Y< 1  S LRTES T=+Y
  613    18         S LRECODE =$P(^LAB(6 0,LRTEST,0 ),U,14),LR ECODE=$S($ D(^LAB(62. 07,LRECODE ,.1)):^(.1 ),1:"")
  614    19         K LRSB S  LRSBCNT=0  F LRSB=1:1  S X=$P(LR SBS,U,LRSB ) Q:'X  S  X1=""""_X, X2=";"_X I  LRECODE[X ,LRECODE[X 1!(LRECODE [X2) S LRS B
  615                (X)="",L RSBCNT=LRS BCNT+1
  616    20         I 'LRSBCN T W "Test  does not h ave an app ropriate e ntry in th e EDIT COD E" Q
  617    21         F I=0:0 R  !,"Prelim inary or F inal: ",X: DTIME Q:'$ T!(X[U)!(X ="P")!(X=" F")  W !," Enter ""P" " or ""F"" ."
  618    22         Q:'$T!(X[ U)  S LRPF =X
  619    23         I LRSBCNT =1 S H9=$O (LRSB(0)), LRSB=Z(H9) ,LRMF=$P(^ DD(63.05,H 9,0),U) W  !,LRMF K D IC
  620    24         I LRSBCNT '=1 S DIC( "A")="Ente r the fiel d to edit:  ",DIC(0)= "AE",DIC(" S")="I $D( LRSB(+Y))" ,DIC="^DD( 63.05," D  ^DIC K DIC  
  621                Q:Y<1  S  H9=+Y,LRS B=Z(H9),LR MF=$P(^DD( 63.05,H9,0 ),U)
  622    25         F I=0:0 R  !,"1  Aut omatically  enter you r entry.", !,"2  Prom pt with yo ur entry." ,!,"3  Jus t Prompt." ,!,"Choice : ",X:DTIM E
  623                 Q:X=""! (X[U)!(X<4 &(X>0)&(X? 1N))  D IN FO
  624    26         Q:X=""!(X [U)  S LRM ODE=X
  625    27         S:LRMODE< 3 LRSCREEN =$S(H9=13: "KM",H9=11 .6:"KG",H9 =11.58:"KY ",H9=17:"K P",H9=15.5 1:"KW",H9= 21:"KF",H9 =19.6:"KW" ,H9=27:"KT "
  626                ,H9=24:" KW",H9=37: "KV",1:"")
  627    28         D ^LRMIST F1
  628    29         Q
  629    30 INFO    W !,"Ente r a number  between 1  and 3.",! ,"1. Autom atically e nters the  result you  specify.  You cannot  change th e entries. "
  630    31         W !,"2. A utomatical ly enters  the result  you speci fy, you ca n see and  change ent ries",!,"3 . Prompts  with the f ield name.  
  631                 Does no t automati cally ente r data.",! !
  632    32         Q
  633   ========== ========== ========== ========== ========== ========== ========
  634   After: 
  635  
  636   LRMISTF *  *  33 LINE S,  (total  2727, com ments 152)  BYTES     Page 1
  637           RS UM: old 11 348365, ne w 14531968
  638           UC I: VISTA,R OU    Site : TEST.CHE YENNE.MED. VA.GOVDEC  14,2016@09 :18
  639  
  640     1 LRMIST F ;SLC/CJS /BA - MASS  DATA ENTR Y INTO FIL E 63.05 ;4 /24/89  14 :40 ;
  641     2         ;;5.2;LAB  SERVICE;* *153,476** ;Sep 27, 1 994
  642     3         ;from opt ion LRMIST UF
  643     4 ACCESS  I '$D(^XU SEC("LRVER IFY",DUZ))  W !,"You' re not cle ared for t his option . You must  have the  LRVERIFY K ey." Q
  644     5         ; LR*5.2* 476 - CR;  added code s #1, #20. 5, and #26 .5 per NSR  20161009
  645     6 BEGIN   D ^LRPARA M Q:$G(LRE ND)  S LRE ND=0,LRVT= "RE",LRSBS ="1^13^11. 6^11.57^11 .58^17^15. 51^21^19.6 ^20.5^26.5 ^27^24^37" ,(Z(1),Z(1 3
  646                ),Z(11.6 ),Z(11.57) ,Z(11.58)) =1,(Z(17), Z(15.51))= 5,(Z(21),Z (19.6),Z(2 0.5))=8,(Z (27),Z(24) ,Z(26.5))= 11,Z(37)=1 6
  647     7         S LRMIMAS S=1
  648     8         D ASK
  649     9         I $D(LRCS Q),$O(^XTM P("LRCAP", LRCSQ,DUZ, 0)) D STD^ LRCAPV
  650    10 END     D ANN^LRM IEDZ,^LRGV K
  651    11         K %,AGE,D A,D1,DFN,D IC,DIE,DLA YGO,DOB,DQ ,DR,H9,I,J ,K,LRAA,LR AD,LRAN,LR CDT,LRCO,L RDFN,LRDPF ,LRECODE,L REND,LRIDT ,LRLLOC,LR M
  652                F,LRMODE ,LROK,LRNO P,LRPF,LRS B,LRSBCNT, LRSBS,LRSC REEN,LRTES T,LRWRD,LR VT,POP,PNM ,R,SEX,SSN ,X,X1,X2,Y ,Z
  653    12         K LRMIMAS S
  654    13         Q
  655    14 ASK     D LRAA^LR MIUT Q:LRA A<1  S LRS S=$P(^LRO( 68,LRAA,0) ,U,2)
  656    15         I LRSS=""  W !?5,"Ac cession Ar ea LR SUBS CRIPT is m isssing.", ! Q
  657    16         I $P(LRPA RAM,U,14)  D ^LRCAPV  G:LREND AN N^LRMIEDZ
  658    17         S %DT="AE ",%DT("A") ="Micro Ac cession Ye ar: ("_$E( DT,2,3)_") //" D ^%DT  K %DT("A" ) Q:X[U  S :X="" Y=$E (DT,1,3) S  LRAD=$E(Y ,
  659                1,3)_"00 00"
  660    18         S DIC="^L AB(60,",DI C("A")="Se lect MICRO BIOLOGY TE ST: ",DIC( 0)="AEMOQ" ,DIC("S")= "I $P(^(0) ,U,4)=""MI "",$L($P(^ (0),U,14)) "
  661                 D ^DIC  K DIC Q:Y< 1  S LRTES T=+Y
  662    19         S LRECODE =$P(^LAB(6 0,LRTEST,0 ),U,14),LR ECODE=$S($ D(^LAB(62. 07,LRECODE ,.1)):^(.1 ),1:"")
  663    20         K LRSB S  LRSBCNT=0  F LRSB=1:1  S X=$P(LR SBS,U,LRSB ) Q:'X  S  X1=""""_X, X2=";"_X I  LRECODE[X ,LRECODE[X 1!(LRECODE [X2) S LRS B
  664                (X)="",L RSBCNT=LRS BCNT+1
  665    21         I 'LRSBCN T W "Test  does not h ave an app ropriate e ntry in th e EDIT COD E" Q
  666    22         F I=0:0 R  !,"Prelim inary or F inal: ",X: DTIME Q:'$ T!(X[U)!(X ="P")!(X=" F")  W !," Enter ""P" " or ""F"" ."
  667    23         Q:'$T!(X[ U)  S LRPF =X
  668    24         I LRSBCNT =1 S H9=$O (LRSB(0)), LRSB=Z(H9) ,LRMF=$P(^ DD(63.05,H 9,0),U) W  !,LRMF K D IC
  669    25         I LRSBCNT '=1 S DIC( "A")="Ente r the fiel d to edit:  ",DIC(0)= "AE",DIC(" S")="I $D( LRSB(+Y))" ,DIC="^DD( 63.05," D  ^DIC K DIC  
  670                Q:Y<1  S  H9=+Y,LRS B=Z(H9),LR MF=$P(^DD( 63.05,H9,0 ),U)
  671    26         F I=0:0 R  !,"1  Aut omatically  enter you r entry.", !,"2  Prom pt with yo ur entry." ,!,"3  Jus t Prompt." ,!,"Choice : ",X:DTIM E
  672                 Q:X=""! (X[U)!(X<4 &(X>0)&(X? 1N))  D IN FO
  673    27         Q:X=""!(X [U)  S LRM ODE=X
  674    28         S:LRMODE< 3 LRSCREEN =$S(H9=13: "KM",H9=11 .6:"KG",H9 =11.58:"KY ",H9=17:"K P",H9=15.5 1:"KW",H9= 21:"KF",H9 =19.6:"KW" ,H9=27:"KT "
  675                ,H9=24:" KW",H9=37: "KV",1:"")
  676    29         D ^LRMIST F1
  677    30         Q
  678    31 INFO    W !,"Ente r a number  between 1  and 3.",! ,"1. Autom atically e nters the  result you  specify.  You cannot  change th e entries. "
  679    32         W !,"2. A utomatical ly enters  the result  you speci fy, you ca n see and  change ent ries",!,"3 . Prompts  with the f ield name.  
  680                 Does no t automati cally ente r data.",! !
  681    33         Q
  682   ========== ========== ========== ========== ========== ========== ========
  683   LRFRLST (N ew)
  684   LRFRSLT *  *  32 LINE S,  (total  1164, com ments 426)  BYTES     Page 1
  685           RS UM: old 82 9641, new  1675070
  686           UC I: VISTA,R OU    Site : TEST.CHE YENNE.MED. VA.GOVNOV  18,2016@13 :35
  687  
  688     1 LRFRSL T ;AITC/CR  - LAB DAT A FUNCTION  API WRAPP ER ;11/04/ 16 2:45 PM
  689     2         ;;5.2;LAB  SERVICE;* *476**;Sep  27, 1994
  690     3         ; This ro utine is u sed by the  FileMan f unction LR RESULT to  generate a
  691     4         ; report  of verifie d lab test s for mult iple patie nts over a  given
  692     5         ; date ra nge
  693     6         ;
  694     7 GETLAB (MDAYS,TES T,SPEC,DFN ) --
  695                ; Custom  lab looku p API for  results
  696     8         ; MDAYS =  # of days  to look b ack for ve rified lab  test resu lts
  697     9         ; TEST  =  IEN for a  given lab  test, fil e #60
  698    10         ; SPEC  =  IEN for a  given spe cimen, fil e #61
  699    11         ; DFN   =  IEN for p atient, fi le #2
  700    12         ;
  701    13         N LRBGDT, RESULT,LDA TE,UNITS
  702    14         N X,X1,X2
  703    15         Q:'+$G(TE ST) ""
  704    16         Q:'+$G(DF N) ""
  705    17         S MDAYS=$ G(MDAYS,36 5)
  706    18         S X1=DT,X 2=-$G(MDAY S) D C^%DT C
  707    19         S LRBGDT= $S(X<DT:X, 1:0)
  708    20         D RR^LR7O R1(DFN,,LR BGDT,DT,,T EST,,1,$G( SPEC))
  709    21         D FORMAT
  710    22         I $G(RESU LT)']"" Q  "NONE FOUN D IN LAST  "_+$S(+MDA YS:MDAYS,1 :365)_" DA YS"
  711    23         Q RESULT_ " "_UNITS_ ";"_$$FMTE ^XLFDT(LDA TE,2)
  712    24         ;
  713    25 FORMAT  N IDT,LOC ,NODE
  714    26         S IDT=0 F   S IDT=$O (^TMP("LRR R",$J,DFN, "CH",IDT))  Q:'+IDT   D
  715    27         . S LOC=0  F  S LOC= $O(^TMP("L RRR",$J,DF N,"CH",IDT ,LOC)) Q:' +LOC  D
  716    28         .. S NODE =$G(^TMP(" LRRR",$J,D FN,"CH",ID T,LOC))
  717    29         .. S RESU LT=$P(NODE ,U,2)
  718    30         .. S UNIT S=$P(NODE, U,4)
  719    31         .. S LDAT E=9999999- IDT
  720    32         Q
  721   ========== ========== ========== ========== ========== ========== ========
  722   LRRESULT –  New FileM an Functio n that cal ls the rou tine LRFRS LT
  723  
  724   NUMBER: 24 7                                NAME: LRRE SULT
  725     MUMPS CO DE: S X=$$ GETLAB^LRF RSLT(X,X1, X2,X3)
  726     NUMBER O F ARGUMENT S: 4
  727     EXPLANAT ION: Lab r esult retr iever -- u sed with t he format  of LRFRSLT (a,b,c,d) 
  728   where a is  reference d as INTER NAL(PATIEN T), b is t he lab fil e 60 test  IEN, c is 
  729   the specim en file 61  IEN and d  is the nu mber of da ys to sear ch back
  730