2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 10/17/2017 10:40:43 AM 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.

2.1 Files compared

# Location File Last Modified
1 FH_5.5_43.zip\FH_5.5_43\docs EPIP_Remediation_Plan_(FH_5.5_43).doc Tue Oct 17 14:46:34 2017 UTC
2 FH_5.5_43.zip\FH_5.5_43\docs EPIP_Remediation_Plan_(FH_5.5_43).doc Tue Oct 17 15:35:46 2017 UTC

2.2 Comparison summary

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

2.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

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

  1   EPIP_Remed iation_Pla n_(PatchNu m)Existing  Product I ntake Prog ram (EPIP)
  2   Patch FH*5 .5*43
  3   Remediatio n Plan
  4  
  5   Department  of Vetera ns Affairs
  6   September  2017
  7   Version 3. 0
  8   Revision H istory
  9   DateVersio nDescripti onAuthor09 /01/20173. 0Updated P atch Descr iption, Do cumentatio n Remediat ion, and A ppendices;  changed N eeds and R equirement s to Busin ess Epics  and Sub-Ep ics. EPIP  Project Te am06/23/20 172.0Updat ed Patch D escription , Code Rem ediation s ection, an d Appendic es to add  informatio n about tw o new NSRs EPIP Proje ct Team04/ 03/20171.0 Initial (d raft) vers ionEPIP Pr oject Team Table of C ontents
  10   1.
  11   Introducti on
  12   1
  13   2.
  14   Purpose
  15   1
  16   3.
  17   Patch Desc ription
  18   1
  19   3.1.
  20   Business E pics and S ub-Epics
  21   3
  22   4.
  23   Points of  Contact
  24   5
  25   5.
  26   Code Remed iation
  27   5
  28   5.1.
  29   Standards  and Conven tions
  30   5
  31   5.2.
  32   Review and  Analysis
  33   5
  34   5.3.
  35   Coding Cha nges
  36   5
  37   6.
  38   Testing
  39   6
  40   6.1.
  41   Test Plan
  42   6
  43   6.2.
  44   Test Envir onment
  45   6
  46   6.3.
  47   Test Readi ness Revie w
  48   6
  49   6.4.
  50   Testing Ph ases
  51   7
  52   6.4.1.
  53   Unit Testi ng
  54   7
  55   6.4.2.
  56   Component  Integratio n and Syst ems Testin g (CI/ST)
  57   7
  58   6.4.3.
  59   Functional  Testing
  60   7
  61   6.4.4.
  62   Regression  Testing
  63   7
  64   6.4.5.
  65   Section 50 8 Complian ce Testing
  66   7
  67   7.
  68   Documentat ion Remedi ation
  69   7
  70   7.1.
  71   User Guide s
  72   8
  73   7.2.
  74   Installati on Guides
  75   8
  76   7.3.
  77   Technical  Manuals
  78   8
  79   7.4.
  80   Operations  Manuals
  81   8
  82   8.
  83   Project Re porting
  84   8
  85   9.
  86   Project Sc hedule
  87   8
  88   10.
  89   Deployment
  90   8
  91   11.
  92   Sustainmen t Requirem ents
  93   8
  94   12.
  95   Maintenanc e and Know ledge Tran sfer
  96   9
  97   Appendix A :
  98   XINDEX Lis ting for M UMPS Code  Changes
  99   10
  100   Appendix B :
  101   Source Cod e Changes
  102   11
  103   Introducti on
  104   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.
  105   Purpose
  106   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 FH*5.5 *43. This  patch addr esses the  following  NSRs:
  107   NSR2014120 7 Dietetic s Report f or Queuing  Software
  108   This NSR h as been im plemented  locally at  the VA Me dical Cent er in Port land, OR.
  109   NSR2017051 0 Print Fl ag on Bott om of Tray  Ticket
  110   This NSR h as been im plemented  locally at  the VA Me dical Cent er in San  Francisco,  CA.
  111   NSR2017051 9 Add Diet  Order to  the Patien t Suppleme ntal Feedi ng List
  112   This NSR h as been im plemented  locally at  the VA Me dical Cent er in San  Francisco,  CA.
  113   This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation,  and delive ry of this  remediati on effort.
  114   Patch Desc ription
  115   FH*5.5*43  provides t he followi ng enhance ments to V istA:
  116   Modifies t he VistA D ietetics R eport Queu ing softwa re to auto matically  queue Nutr ition and  Food Servi ce (NFS) r eports and  labels to  run daily , or as of ten as nec essary, wi thout requ iring Diet etics staf f to manua lly queue  them each  day. With  many stand ard report s and labe ls current ly availab le to NFS  staff, it  is ineffic ient and t ime consum ing for us ers to man ually set  up and run  reports d aily.
  117   This enhan cement ena bles a Cli nical Appl ication Co ordinator  (CAC) or A utomated D ata Proces sing Appli cation Coo rdinator ( ADPAC) to  set pre-de fined opti ons for pr inting NFS  reports a nd labels  automatica lly, inclu ding the r outine nam e and the  setup of v ariables r equired fo r the repo rts to run  unattende d.
  118   Three new  options en abling thi s function ality are  added to t he existin g Tray Tic kets [FHMT KM TRAY TI CKETS] men u. Queued  Options Ed it [FHQUE  OPTION EDI T] display s a list o f availabl e reports.  From this  list, a r eport can  be selecte d and conf igured to  run at a s pecified f requency a nd to send  the job t o a specif ied printe r. Queue D iet Report s [FHQUE Q UEUE DIET  REPORTS] p asses the  configured  reports a nd labels  to TaskMan  to be exe cuted and  printed at  the sched uled time.  Typically , Queue Di et Reports  is schedu led to run  once per  day, soon  after midn ight. The  Manager/AD PAC must b e assigned  the Nutri tion and F ood Servic e security  key FHMGR  to access  these opt ions. Test  an Indivi dual Queue d Option [ FHQUE TEST ] is only  accessible  to users  with progr ammer acce ss and is  used to im mediately  run a test  report to  validate  selected o ptions.
  119  
  120   New VistA  Options fo r Queuing  Dietetics  Reports
  121   Note: The  new option s can alte rnatively  be accesse d by typin g “FHQUE”  at the “Se lect OPTIO N NAME:” p rompt.
  122    
  123   Queuing Di etetics Re ports Opti ons Displa yed from t he FHQUE O ption 
  124   Three new  files stor e the valu es require d for prin ting NFS r eports and  labels au tomaticall y. The FHQ UE AVAILAB LE OPTIONS  (#117.024 3) file st ores value s such as  the time t he report  is schedul ed to run  and the pr inter to w hich it wi ll be sent . The FHQU E QUEUED R EPORTS/LAB ELS (#117. 024) file  stores a m eaningful  descriptio n for each  of the av ailable re ports that  display w hen Queued  Options E dit is sel ected. The  FHQUE REP ORT DAYS ( #117.0241)  file stor es the day s of the w eek to ena ble a user  to select  the day t o run the  report.
  125   Enhances t he Patient  Supplemen tal Feedin g List to  display th e most rec ent patien t Diet Ord er. Diet o rders can  change fre quently ba sed on a p atient’s m edical nee ds; someti mes diet o rders are  changed in  VistA aft er a suppl emental fe eding is p repared by  a food se rvice work er. Curren tly, there  is no eas y way to c heck suppl emental fe eding orde rs against  the patie nt’s most  recent die t order be fore deliv ering the  supplement al nutriti on. This e nhancement  reduces t he risk of  improper  feeding by  retrievin g current  diet order  informati on from Vi stA and us ing that d ata to pre pare the P atient Sup plemental  Feeding Li st, so tha t both the  current d iet order  and the su pplemental  feeding o rder are i ncluded.
  126  
  127   Patient Su pplemental  Feeding L ist
  128   Adds three  new field s to the N UTRITION P ERSON (#11 5) file th at the sta ff in a Co mmunity Li ving Cente r (CLC) ca n use to e nter meal  instructio ns for mor ning, midd ay, and ev ening meal s. The new  free-text  fields in clude the  BREAKFAST  FLAG (#662 910.01) fi eld, the N OON FLAG ( #662910.02 ) field, a nd the EVE NING FLAG  (#662910.0 3) field.
  129   The existi ng Tray Ti ckets opti on is furt her modifi ed to incl ude the ne w option T ray Ticket  Flag Edit  [FHMTK1D  TRAY TICKE T EDIT], w hich enabl es CLC sta ff to ente r flag tex t in the n ew fields.  The exist ing Print  Tray Ticke ts [FHMTK1 P TRAY TIC KET PRINT]  option is  modified  to print f lag text o n the bott om of the  tray ticke t where it  can be ea sily seen  by clinica l staff at  mealtime.
  130  
  131   Tray Ticke t Flag Edi t and Prin t Tray Tic kets Optio ns
  132   This enhan cement pro vides a si mple and c onsistent  way to ens ure that e ach patien t’s mealti me instruc tions and  needs are  communicat ed between  team memb ers to ens ure patien t safety a nd quality  of care.
  133   Business E pics and S ub-Epics
  134   The Busine ss Epics a nd Sub-Epi cs for the  NSR(s) ad dressed in  this reme diation ar e:
  135   NSR2014120 7 Dietetic s Report f or Queuing  Software
  136   BUSINESS E PIC 889733 : Configur e and Queu e Dietetic  Reports –  For Nutri tion and F ood Servic e Staff Wh o configur e and gene rate Diete tic report s A proces s is neede d that exp edites rep ort creati on That ma kes more e fficient u se of staf f resource s by allow ing config uring and  generating  and savin g print an y dietetic  package r eport such  as Additi onal Order s, Early L ate Tray r eports, Ju st-In-Time  diet orde rs, etc.,  at a given  time, or  repeated t imes, to o ne or mult iple print ers saving  staff tim e as well  as ensurin g that ord ers are no t missed i f someone  forgets to  print the m. This ha s also sho rtened the  response  time to ge t late tra ys out Unl ike the cu rrent proc ess which  is time in tensive an d error pr one requir ing users  to manuall y configur e and gene rate repor ts minimal ly on a da ily basis  our proces s utilizes  best prac tices free ing up sta ff time to  improve t he deliver y of NFS t o our vete ran patien ts.
  137   BUSINESS E PIC 889730 : Automati c Queuing  of Dieteti c Reports  – As an au thorized N utrition a nd Food Se rvice user , I need t o manage N FS reports  and label s at vario us system  levels, so  that I ca n take adv antage of  the time s avings gai ned by eli minating m anual meth ods curren tly utiliz ed.
  138   NSR2017051 9 Print Di et Order t o the Pati ent Supple mental Fee ding List
  139   BUSINESS E PIC 903973 : Print Di et Order N ext to Sup plemental  Feeding Or der – For  Nutrition  and Food S ervices ki tchen and  diet offic e staff Wh o deliver  supplement al feeding s directly  to patien ts on the  wards A mo dification  to the Pa tient Supp lemental F eeding Lis t That pri nts the pa tient’s di et order n ext to the  supplemen tal feedin g order wh en the lis t is print ed on stan dard paper  Unlike th e current  output whi ch does no t display  the patien t’s diet o rder, our  process al lows for a  final che ck for acc uracy prio r to deliv ering pati ent supple mental fee dings.
  140   NSR2017051 0 Print Fl ag on Bott om of Tray  Ticket
  141   BUSINESS E PIC 903974 : Print Fl ag on Bott om of Tray  Ticket –  For nurses , dietitia ns, recrea tion thera pists, occ upational  therapists , speech t herapists  and food s ervice wor kers Who a re part of  an interd isciplinar y team car ing for pa tients A p rocess to  convey mea l instruct ions That  displays t hose instr uctions on  the botto m of the t ray ticket  for each  meal Unlik e the curr ent proces s in which  meal inst ructions m ust be com municated  manually O ur process  allows st aff to com municate m eal to mea l instruct ions to su pport safe  and accur ate meal s ervice.
  142   BUSINESS S UB-EPIC 90 3982: Prin t Meal Ins tructions  on Tray Ti ckets – Fo r nurses,  dietitians , recreati on therapi sts, occup ational th erapists,  speech the rapists an d food ser vice worke rs Who are  part of a n interdis ciplinary  team carin g for pati ents A cha nge to the  Print Tra y Tickets  option Tha t displays  a special  flag cont aining mea l instruct ions on th e bottom o f the tray  ticket fo r each mea l. Unlike  the curren t process  in which t here is no  flag indi cated our  process al lows staff  to commun icate meal  to meal i nstruction s to suppo rt safe an d accurate  meal serv ice.
  143   BUSINESS S UB-EPIC 90 3976: Ente r Meal Ins tructions  – For nurs es, dietit ians, recr eation the rapists, o ccupationa l therapis ts, speech  therapist s and food  service w orkers who  are part  of an inte rdisciplin ary team c aring for  patients a  change to  the Print  Tray Tick ets option  that disp lays a spe cial flag  containing  meal inst ructions o n the bott om of the  tray ticke t for each  meal. Unl ike the cu rrent proc ess in whi ch there i s no flag  indicated  our proces s allows s taff to co mmunicate  meal to me al instruc tions to s upport saf e and accu rate meal  service.
  144   Points of  Contact
  145   The VA Poi nt of Cont act (POC)  for NSR201 41207 Diet etics Repo rt for Que uing Softw are is Kri sta J. Ame son  EM A IL                     ),  PHONE .
  146   The  D A N P S C f   r NSR20170 510 Print  Flag on Bo ttom of Tr ay Ticket  is Don Don ati  PII                  ),  PHONE .
  147   The  D A N P S C f   r NSR20170 519 Print  Diet Order  to the Pa tient Supp lemental F eeding Lis t is Karen  Arnold  EM A IL                   ),  PHONE .
  148   Code Remed iation
  149   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.
  150   Standards  and Conven tions
  151   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).
  152   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.
  153   Review and  Analysis
  154   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. 
  155   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. 
  156   Coding Cha nges
  157   The coding  changes r equired fo r NSR20141 207 Dietet ics Report  for Queui ng Softwar e are in t he followi ng routine s: 
  158   Modified M UMPS routi nes: None
  159   New MUMPS  routines:  FHQUE
  160   The coding  changes r equired fo r NSR20170 519 Add Di et Order t o the Pati ent Supple mental Fee ding List  are in the  following  routines:  
  161   Modified M UMPS routi nes: FHNO2 1
  162   New MUMPS  routines:  None 
  163   The coding  changes r equired fo r NSR20170 510 Print  Flag on Bo ttom of Tr ay Ticket  are in the  following  routines:  
  164   Modified M UMPS routi nes: FHMTK 1C
  165   New MUMPS  routines:  FHMTK1D
  166   A detailed  analysis  of the cod ing change s is provi ded in App endix B.
  167   Testing
  168   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.
  169   Test Plan
  170   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.
  171   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.
  172   Test Envir onment
  173   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.
  174   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.
  175   Test Readi ness Revie w
  176   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 ).
  177   Testing Ph ases
  178   Leidos wil l perform  developmen t and SQA  testing ac tivities i n phases,  and will p rovide all  required  testing do cumentatio n.
  179   Unit Testi ng
  180   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. 
  181   Component  Integratio n and Syst ems Testin g (CI/ST)
  182   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.
  183   Functional  Testing
  184   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. 
  185   Regression  Testing
  186   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.  
  187   Section 50 8 Complian ce Testing
  188   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.
  189   Documentat ion Remedi ation
  190   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.
  191   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.
  192   The follow ing sectio ns outline  the VDL d ocuments t o be revis ed for thi s remediat ion.
  193   User Guide s
  194   The follow ing User G uide will  be updated  in the VD L:
  195   Updates to  the VistA  Nutrition  and Food  Service (N FS) User M anual for  Patch FH*5 .5*43 Chan ge Pages ( fh_5.5_p43 _um_cp.doc )
  196   Installati on Guides
  197   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 
  198   Pre-Produc tion envir onments. T herefore,  no Install ation Guid es will be  updated.
  199   Technical  Manuals
  200   The follow ing Techni cal Manual  will be u pdated in  the VDL:
  201   Updates to  the VistA  Nutrition  and Food  Service (N FS) Manage r/ADPAC Gu ide for Pa tch FH*5.5 *43 Change  Pages (fh _5.5_p43_a g_cp.doc)
  202   Operations  Manuals
  203   No Operati ons Manual s require  revision a s a result  of this m odificatio n.
  204   Project Re porting
  205   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. 
  206   Project Sc hedule
  207   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.
  208   Deployment
  209   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.
  210   Sustainmen t Requirem ents
  211   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 .
  212   Maintenanc e and Know ledge Tran sfer
  213   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.
  214   XINDEX Lis ting for M UMPS Code  Changes
  215   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.
  216                      V.  A.  C R O  S S  R E  F E R E N  C E R  7.3
  217                            [2008 V A Standard s & Conven tions]
  218                      UC I: VISTA C PU: ROU     Jun 22, 2 017@14:53: 27
  219   Routines:  4  Faux Ro utines: 0
  220   FHMTK1C    FHMTK1D    FHNO21     FHQUE     
  221   Loading th e ROUTINE  file now.
  222      FHMTK1C    FHMTK1D     FHNO21      FHQUE
  223   --- CROSS  REFERENCIN G ---
  224   Compiled l ist of Err ors and Wa rnings              J un 22, 201 7@14:53:27  page 1
  225   No errors  or warning s to repor t
  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 were a ffected:
  228   Modified M UMPS routi nes: FHNO2 1, FHMTK1C
  229   New MUMPS  routines:  FHQUE, FHM TK1D
  230   FHNO21
  231   Before:
  232   FHNO21   ;  HISC/REL/ NCA - Prin t Feeding  Labels ;8/ 26/94  12: 01 
  233            ; ;5.5;DIETE TICS;**5,8 **;Jan 28,  2005;Buil d 28
  234            S  DTP=DT\1  D DTP^FH S  DTE=DTP_"  "_TIM_$S( TIM=10:"AM ",1:"PM")
  235            S  S1=$S(LAB =1:6,1:9), S2=LAB=2*5 +33
  236            K  N F L=0:0  S L=$O(^F H(118,L))  Q:L<1  S Y =^(L,0),N1 =$P(Y,"^", 1),^TMP($J
  237   ,"I",$E(N1 ,1,26)_"," _L)=L I '$ D(^FH(118, L,"I")) S  N(L)=$P(Y, "^",1,2)
  238            S  LNOD="" F   S LNOD=$ O(^TMP($J, "L",LNOD))  Q:LNOD=""   D P2
  239            Q
  240   P2       S  PNOD="",N 1=0 K C F   S PNOD=$O (^TMP($J," L",LNOD,PN OD)) Q:PNO D=""  S Y2
  241   =^(PNOD) D  P3
  242            ; I LAB<3 D  P5 Q
  243            Q
  244   P3       S  N1=N1+1
  245            S  FHDFN=$P( PNOD,"~",3 ),WRD=$P(Y 2,"^",10)
  246            D  PATNAME^F HOMUTL I F HPTNM="" Q
  247            S  ALG="" D  ALG^FHCLN
  248            S  NAM=FHPTN M,IS=$P(Y2 ,"^",9)
  249            ; S NAM=$P(^ DPT(DFN,0) ,"^",1),IS =$P(Y2,"^" ,9) D PID^ FHDPA
  250            I  LAB>2 D L L Q
  251            I  $P(FHPAR, "^",4)="Y"  G P4
  252            W  !,$E(NAM, 1,S2-$L(WR D)),?(S2+2 -$L(WRD)), $E(WRD,3,9 9),!?$S(LA B=1:3,1:0)
  253   ,FHBID,$S( ALG="":"", 1:" *ALG")  W:IS'=""  ?(S2-22)," *NURSE" W  ?(S2-15),D TE S LN=2 
  254   I LAB=2 W  !! S LN=4
  255            F  L=1:2:7 S  Z=$P(Y2," ^",L) I Z' ="" D
  256            . S Q=$P(Y2, "^",L+1) S :'Q Q=1
  257            . W !,$J(Q,2 )," "
  258            . W $S($D(N( Z)):$P(N(Z ),"^",1),$ D(^FH(118, +Z,0)):$P( ^(0),"^",1 ),1:"")
  259            . S LN=LN+1  S:'$D(C(Z) ) C(Z)=0 S  C(Z)=C(Z) +Q
  260            . Q
  261            I  LN<S1 F L =LN+1:1:S1  W !
  262            Q
  263   P4       S  ALG="" D  ALG^FHCLN
  264            F  L=1:2:7 S  Z=$P(Y2," ^",L) I Z' ="",$S($D( N(Z)):$P(N (Z),"^",2) ,$D(^FH(11
  265   8,+Z,0)):$ P(^(0),"^" ,2),1:"")' ="N" D
  266            . S Q=$P(Y2, "^",L+1) S :'Q Q=1
  267            . W !,$E(NAM ,1,S2-$L(W RD)),?(S2+ 2-$L(WRD)) ,$E(WRD,3, 99),!,FHBI D,$S(ALG="
  268   ":"",1:" * ALG")
  269            . W:IS'="" ? 11,"*NURSE "
  270            . W ?(S2-15) ,DTE,!!,$J (Q,2)," "
  271            . W $S($D(N( Z)):$P(N(Z ),"^",1),$ D(^FH(118, +Z,0)):$P( ^(0),"^",1 ),1:""),!!
  272            . W:LAB=2 !! !
  273            . S:'$D(C(Z) ) C(Z)=0 S  C(Z)=C(Z) +Q
  274            . Q
  275            Q
  276   P5       S  Y=$S(XX=" S":$P($G(^ FH(119.74, D1,0)),"^" ,1),1:$P($ G(^FH(119. 6,W1,0)),"
  277   ^",1))
  278            W  !?3,"****  INGREDIEN TS LIST ** **",!!?(33 -$L(Y)\2), Y,!?9,DTE, !! S LN=6
  279            S  A1="" F K =0:0 S A1= $O(^TMP($J ,"I",A1))  Q:A1=""  S  L=^(A1) I  $D(C(L)),
  280   C(L) W !,$ S($D(N(L)) :$P(N(L)," ^",1),$D(^ FH(118,+L, 0)):$P(^(0 ),"^",1),1 :""),?28,$
  281   J(C(L),5,0 ) S LN=LN+ 1
  282   P6       W  !!?4,"*** * PATIENTS  = ",N1,"  ****",! S  LN=LN+3
  283            S  LN=LN#S1  I LN F L=L N+1:1:S1 W  !
  284            Q
  285   LL       ;
  286            D  ALG^FHCLN
  287            S  FHCOL=$S( LAB=3:3,1: 2)
  288            I  LABSTART> 1 F FHLABS T=1:1:(LAB START-1)*F HCOL D  S  LABSTART=1
  289            . I LAB=3 S  (PCL1,PCL2 ,PCL3,PCL4 ,PCL5,PCL6 )="" D LL3 ^FHLABEL
  290            . I LAB=4 S  (PCL1,PCL2 ,PCL3,PCL4 ,PCL5,PCL6 ,PCL7,PCL8 )="" D LL4 ^FHLABEL
  291            . Q
  292            S  FHTAB=$S( LAB=3:24,1 :37)
  293            S  WRD1=$E(W RD,3,99)
  294            S  NAM=$E(NA M,1,FHTAB- $L(WRD1)), BIDIS=BID_ $S(ALG="": "",1:" *AL G")
  295            I  IS="N" S  BIDIS=BIDI S_" *NURSE "
  296            S  LNA=NAM_$ J(WRD1,FHT AB+1-$L(NA M)),LNB=BI DIS_$J(DTE ,FHTAB+1-$ L(BIDIS))
  297            I  $P(FHPAR, "^",4)="Y"  D LL2 Q
  298            S  NUM=0 F X SF=1:2:7 I  $P(Y2,U,X SF)'="" S  NUM=NUM+1
  299            S  INDX=0 F  XSF=1:2:7  D
  300            . S SFPTR=$P (Y2,U,XSF)  I SFPTR=" " Q
  301            . S QTY=$P(Y 2,U,XSF+1) ,SFNM=$P($ G(^FH(118, SFPTR,0)), U,1)
  302            . S INDX=IND X+1,ZF(IND X)=$J(QTY, 2)_" "_SFN M
  303            . Q
  304            I  LAB=3 D
  305            . I NUM=1 S  (PCL1,PCL2 ,PCL6)="", PCL3=LNA,P CL4=LNB,PC L5=ZF(1)
  306            . I NUM=2 S  (PCL1,PCL6 )="",PCL2= LNA,PCL3=L NB,PCL4=ZF (1),PCL5=Z F(2)
  307            . I NUM=3 S  PCL1="",PC L2=LNA,PCL 3=LNB,PCL4 =ZF(1),PCL 5=ZF(2),PC L6=ZF(3)
  308            . I NUM=4 S  PCL1=LNA,P CL2=LNB,PC L3=ZF(1),P CL4=ZF(2), PCL5=ZF(3) ,PCL6=ZF(4
  309   )
  310            . D LL3^FHLA BEL
  311            I  LAB=4 D
  312            . I NUM=1 S  (PCL1,PCL2 ,PCL3,PCL7 ,PCL8)="", PCL4=LNA,P CL5=LNB,PC L6=ZF(1)
  313            . I NUM=2 S  (PCL1,PCL2 ,PCL7,PCL8 )="",PCL3= LNA,PCL4=L NB,PCL5=ZF (1),PCL6=Z
  314   F(2)
  315            . I NUM=3 S  (PCL1,PCL2 ,PCL8)="", PCL3=LNA,P CL4=LNB,PC L5=ZF(1),P CL6=ZF(2),
  316   PCL7=ZF(3)
  317            . I NUM=4 S  (PCL1,PCL8 )="",PCL2= LNA,PCL3=L NB,PCL4=ZF (1),PCL5=Z F(2),PCL6=
  318   ZF(3),PCL7 =ZF(4)
  319            . D LL4^FHLA BEL
  320            Q
  321   LL2      ;
  322            F  XSF=1:2:7  D
  323            . S SFPTR=$P (Y2,U,XSF)  I SFPTR=" " Q
  324            . S QTY=$P(Y 2,U,XSF+1) ,SFNM=$P($ G(^FH(118, SFPTR,0)), U,1)
  325            . S LNC=$J(Q TY,2)_" "_ SFNM
  326            . I LAB=3 S  (PCL1,PCL4 ,PCL6)="", PCL2=LNA,P CL3=LNB,PC L5=LNC D L L3^FHLABEL
  327            . I LAB=4 S  (PCL1,PCL2 ,PCL5,PCL7 ,PCL8)="", PCL3=LNA,P CL4=LNB,PC L6=LNC D L
  328   L4^FHLABEL
  329            Q
  330   After:
  331   FHNO21   ;  HISC/REL/ NCA - Prin t Feeding  Labels ; 6 /21/2017   12:01 
  332            ; ;5.5;DIETE TICS;**5,8 ,43**;Jan  28, 2005;B uild 28
  333            ; ;
  334            ; ICR#   Typ e  Descrip tion
  335            ; -----  --- -  ------- ---------- ---------- ---------- -
  336            ; 10061  Sup    IN5^VAD PT
  337            ;
  338            S  DTP=DT\1  D DTP^FH S  DTE=DTP_"  "_TIM_$S( TIM=10:"AM ",1:"PM")
  339            S  S1=$S(LAB =1:6,1:9), S2=LAB=2*5 +33
  340            K  N F L=0:0  S L=$O(^F H(118,L))  Q:L<1  S Y =^(L,0),N1 =$P(Y,"^", 1),^TMP($J
  341   ,"I",$E(N1 ,1,26)_"," _L)=L I '$ D(^FH(118, L,"I")) S  N(L)=$P(Y, "^",1,2)
  342            S  LNOD="" F   S LNOD=$ O(^TMP($J, "L",LNOD))  Q:LNOD=""   D P2
  343            Q
  344   P2       S  PNOD="",N 1=0 K C F   S PNOD=$O (^TMP($J," L",LNOD,PN OD)) Q:PNO D=""  S Y2
  345   =^(PNOD) D  P3
  346            Q
  347   P3       S  N1=N1+1
  348            S  FHDFN=$P( PNOD,"~",3 ),WRD=$P(Y 2,"^",10)
  349            D  PATNAME^F HOMUTL I F HPTNM="" Q
  350            S  ALG="" D  ALG^FHCLN
  351            S  NAM=FHPTN M,IS=$P(Y2 ,"^",9)
  352            I  LAB>2 D L L Q
  353            I  $P(FHPAR, "^",4)="Y"  G P4
  354            W  !,$E(NAM, 1,S2-$L(WR D)),?(S2+2 -$L(WRD)), $E(WRD,3,9 9),!?$S(LA B=1:3,1:0)
  355   ,FHBID,$S( ALG="":"", 1:" *ALG")  W:IS'=""  ?(S2-22)," *NURSE" W  ?(S2-15),D TE S LN=2 
  356   I LAB=2 W  !! S LN=4
  357            ;  FH*5.5*43  BEGIN Add  patient's  diet orde rs 
  358            W  !,$E(NAM, 1,S2-$L(WR D)),?(S2+2 -$L(WRD)), $E(WRD,3,9 9)
  359            ;  *** Print  Diet 1, 2 , 3 
  360            D  DIETORD(D FN,FHDFN," ^1^2^3^")
  361            W  !?$S(LAB= 1:3,1:0),F HBID  W:IS '="" ?(S2- 22),"*NURS E" W ?(S2- 15),DTE
  362            ;  *** Print  Diet 4, 5
  363            D  DIETORD(D FN,FHDFN," ^4^5^")
  364            S  LN=2 I LA B=2 W !! S  LN=4
  365            ;  FH*5.5*43  END Add p atient's d iet orders  
  366            F  L=1:2:7 S  Z=$P(Y2," ^",L) I Z' ="" D
  367            . S Q=$P(Y2, "^",L+1) S :'Q Q=1
  368            . W !,$J(Q,2 )," "
  369            . W $S($D(N( Z)):$P(N(Z ),"^",1),$ D(^FH(118, +Z,0)):$P( ^(0),"^",1 ),1:"")
  370            . S LN=LN+1  S:'$D(C(Z) ) C(Z)=0 S  C(Z)=C(Z) +Q
  371            . Q
  372            I  LN<S1 F L =LN+1:1:S1  W !
  373            Q
  374   P4       S  ALG="" D  ALG^FHCLN
  375            F  L=1:2:7 S  Z=$P(Y2," ^",L) I Z' ="",$S($D( N(Z)):$P(N (Z),"^",2) ,$D(^FH(11
  376   8,+Z,0)):$ P(^(0),"^" ,2),1:"")' ="N" D
  377            . S Q=$P(Y2, "^",L+1) S :'Q Q=1
  378            . W !,$E(NAM ,1,S2-$L(W RD)),?(S2+ 2-$L(WRD)) ,$E(WRD,3, 99),!,FHBI D,$S(ALG=" ":"",1:" * ALG")
  379            . W:IS'="" ? 11,"*NURSE "
  380            . W ?(S2-15) ,DTE,!!,$J (Q,2)," "
  381            . W $S($D(N( Z)):$P(N(Z ),"^",1),$ D(^FH(118, +Z,0)):$P( ^(0),"^",1 ),1:""),!!
  382            . W:LAB=2 !! !
  383            . S:'$D(C(Z) ) C(Z)=0 S  C(Z)=C(Z) +Q
  384            . Q
  385            Q
  386   P5       S  Y=$S(XX=" S":$P($G(^ FH(119.74, D1,0)),"^" ,1),1:$P($ G(^FH(119. 6,W1,0)),"
  387   ^",1))
  388            W  !?3,"****  INGREDIEN TS LIST ** **",!!?(33 -$L(Y)\2), Y,!?9,DTE, !! S LN=6
  389            S  A1="" F K =0:0 S A1= $O(^TMP($J ,"I",A1))  Q:A1=""  S  L=^(A1) I  $D(C(L)), C(L) W !,$ S($D(N(L)) :$P(N(L)," ^",1),$D(^ FH(118,+L, 0)):$P(^(0 ),"^",1),1 :""),?28,$
  390   J(C(L),5,0 ) S LN=LN+ 1
  391   P6       W  !!?4,"*** * PATIENTS  = ",N1,"  ****",! S  LN=LN+3
  392            S  LN=LN#S1  I LN F L=L N+1:1:S1 W  !
  393            Q
  394            ;  FH*5.5*43  BEGIN Add  patient's  diet orde rs 
  395   DIETORD(DF N,FHDFN,DI ETS) ; 
  396            N  DIET,DIET ORD,DIETOR D0,PIECE,V ADMVT,VAER R,VAINDT2
  397            D  IN5^VADPT
  398            S  VADMVT=$G (VAIP(1))
  399            I  $G(VAERR) '>0,$G(VAD MVT) D
  400            . S DIETORD0 =+$P($G(^F HPT(FHDFN, "A",VADMVT ,0)),U,2)
  401            . S DIETORD= $P($G(^FHP T(FHDFN,"A ",VADMVT," DI",DIETOR D0,0)),U,2 ,6)
  402            . F PIECE=1: 1:5 I DIET S[(U_PIECE _U) D
  403            . .N DIERR,D TOUT,DUOUT ,FHERR
  404            . .S DIET=+$ P(DIETORD, U,PIECE)
  405            . .W ?$P("36 ^51^66^36^ 51",U,PIEC E),$$GET1^ DIQ(111,DI ET,6,,,"FH ERR")
  406            . .Q
  407            . Q
  408            ;  FH*5.5*43  END Add p atient's d iet orders
  409   LL       ;
  410            D  ALG^FHCLN
  411            S  FHCOL=$S( LAB=3:3,1: 2)
  412            I  LABSTART> 1 F FHLABS T=1:1:(LAB START-1)*F HCOL D  S  LABSTART=1
  413            . I LAB=3 S  (PCL1,PCL2 ,PCL3,PCL4 ,PCL5,PCL6 )="" D LL3 ^FHLABEL
  414            . I LAB=4 S  (PCL1,PCL2 ,PCL3,PCL4 ,PCL5,PCL6 ,PCL7,PCL8 )="" D LL4 ^FHLABEL
  415            . Q
  416            S  FHTAB=$S( LAB=3:24,1 :37)
  417            S  WRD1=$E(W RD,3,99)
  418            S  NAM=$E(NA M,1,FHTAB- $L(WRD1)), BIDIS=BID_ $S(ALG="": "",1:" *AL G")
  419            I  IS="N" S  BIDIS=BIDI S_" *NURSE "
  420            S  LNA=NAM_$ J(WRD1,FHT AB+1-$L(NA M)),LNB=BI DIS_$J(DTE ,FHTAB+1-$ L(BIDIS))
  421            I  $P(FHPAR, "^",4)="Y"  D LL2 Q
  422            S  NUM=0 F X SF=1:2:7 I  $P(Y2,U,X SF)'="" S  NUM=NUM+1
  423            S  INDX=0 F  XSF=1:2:7  D
  424            . S SFPTR=$P (Y2,U,XSF)  I SFPTR=" " Q
  425            . S QTY=$P(Y 2,U,XSF+1) ,SFNM=$P($ G(^FH(118, SFPTR,0)), U,1)
  426            . S INDX=IND X+1,ZF(IND X)=$J(QTY, 2)_" "_SFN M
  427            . Q
  428            I  LAB=3 D
  429            . I NUM=1 S  (PCL1,PCL2 ,PCL6)="", PCL3=LNA,P CL4=LNB,PC L5=ZF(1)
  430            . I NUM=2 S  (PCL1,PCL6 )="",PCL2= LNA,PCL3=L NB,PCL4=ZF (1),PCL5=Z F(2)
  431            . I NUM=3 S  PCL1="",PC L2=LNA,PCL 3=LNB,PCL4 =ZF(1),PCL 5=ZF(2),PC L6=ZF(3)
  432            . I NUM=4 S  PCL1=LNA,P CL2=LNB,PC L3=ZF(1),P CL4=ZF(2), PCL5=ZF(3) ,PCL6=ZF(4 )
  433            . D LL3^FHLA BEL
  434            I  LAB=4 D
  435            . I NUM=1 S  (PCL1,PCL2 ,PCL3,PCL7 ,PCL8)="", PCL4=LNA,P CL5=LNB,PC L6=ZF(1)
  436            . I NUM=2 S  (PCL1,PCL2 ,PCL7,PCL8 )="",PCL3= LNA,PCL4=L NB,PCL5=ZF (1),PCL6=Z
  437   F(2)
  438            . I NUM=3 S  (PCL1,PCL2 ,PCL8)="", PCL3=LNA,P CL4=LNB,PC L5=ZF(1),P CL6=ZF(2),
  439   PCL7=ZF(3)
  440            . I NUM=4 S  (PCL1,PCL8 )="",PCL2= LNA,PCL3=L NB,PCL4=ZF (1),PCL5=Z F(2),PCL6=
  441   ZF(3),PCL7 =ZF(4)
  442            . D LL4^FHLA BEL
  443            Q
  444   LL2      ;
  445            F  XSF=1:2:7  D
  446            . S SFPTR=$P (Y2,U,XSF)  I SFPTR=" " Q
  447            . S QTY=$P(Y 2,U,XSF+1) ,SFNM=$P($ G(^FH(118, SFPTR,0)), U,1)
  448            . S LNC=$J(Q TY,2)_" "_ SFNM
  449            . I LAB=3 S  (PCL1,PCL4 ,PCL6)="", PCL2=LNA,P CL3=LNB,PC L5=LNC D L L3^FHLABEL
  450            . I LAB=4 S  (PCL1,PCL2 ,PCL5,PCL7 ,PCL8)="", PCL3=LNA,P CL4=LNB,PC L6=LNC D L L4^FHLABEL
  451            Q
  452   FHMTK1C
  453   Before:
  454   FHMTK1C  ;  HISC/NCA/ RVD - Prin t Tray Tic kets ;4/13 /95  13:45
  455            ; ;5.5;DIETE TICS;;Jan  28, 2005
  456   PRT      ;  Print 3 p erson per  page
  457   START    I  $G(TABREC )="YES" QU IT
  458            S  TL=0 D CH KH
  459            W  !! S TL=T L+2 F N1=1 :1:3 D
  460            . I 'MFLG S  MEALDT=$S( MEAL="B":" Breakfast" ,MEAL="N": "Noon",1:" Evening")_
  461   " "_MDT
  462            . E  S MEALD T=$S(N1=1: "Breakfast ",N1=2:"No on",1:"Eve ning")_" " _MDT
  463            . I '$D(MM(0 ,N1)) Q
  464            . S MMMDT=$P (MM(0,N1), U,7) I MMM DT'="" S M EALDT=$S(M MMDT="B":" Breakfast"
  465   ,MMMDT="N" :"Noon",1: "Evening") _" "_MDT
  466            . S MEALDT=$ J("",40-$L (MEALDT)\2 )_MEALDT
  467            . I $D(MM(0, N1)) W ?$S (N1=1:2,N1 =2:45,1:88 ),MEALDT
  468            . Q
  469            W  ! S TL=TL +1 F N1=1: 1 Q:'$D(PP (N1))  W !  S TL=TL+1  F NBR=1:1 :3 I $D(PP
  470   (N1,NBR))  W ?$S(NBR= 1:2,NBR=2: 45,1:88),P P(N1,NBR)
  471            ; W ! S TL=T L+1 F N1=1 :1 Q:'$D(P P(N1))  W  ! S TL=TL+ 1
  472            W  ! S TL=TL +1
  473            F  N1=1:1 Q: '$D(MM(N1) )  D:(TL+2 )'<($S(FHB OT="Y":LN- 5,1:LN-3))  NXT W !! 
  474   S TL=TL+2  F NBR=1:1: 3 I $D(MM( N1,NBR)) W  ?$S(NBR=1 :2,NBR=2:4 5,1:88),MM (N1,NBR)
  475            I  TL<LN F L 1=TL:1:$S( FHBOT="Y": LN-2,1:LN)  W !
  476            I  FHBOT="Y"  D HEAD W  @IOF Q
  477            E   D FOOT
  478            W  @IOF Q
  479   NXT      ;  Print Nex t Page
  480            W  !! S TL=T L+2 F NM=1 :1:3 I $D( MM(0,NM))  W ?$S(NM=1 :12,NM=2:5 7,1:100),"
  481   (More Item s Next Pg) "
  482            I  TL<LN F L 1=TL:1:$S( FHBOT="Y": LN-2,1:LN)  W !
  483            I  FHBOT="Y"  D HEAD W  @IOF G N1
  484            E   D FOOT
  485   N1       W  @IOF S TL =0 D CHKH
  486            W  !! S TL=T L+2 F XX=1 :1:3 D
  487            . I 'MFLG S  MEALDT=$S( MEAL="B":" Breakfast" ,MEAL="N": "Noon",1:" Evening")_
  488   " "_MDT
  489            . E  S MEALD T=$S(XX=1: "Breakfast ",XX=2:"No on",1:"Eve ning")_" " _MDT
  490            . I '$D(MM(0 ,XX)) Q
  491            . S MMMDT=$P (MM(0,XX), U,7) I MMM DT'="" S M EALDT=$S(M MMDT="B":" Breakfast"
  492   ,MMMDT="N" :"Noon",1: "Evening") _" "_MDT
  493            . S MEALDT=$ J("",40-$L (MEALDT)\2 )_MEALDT
  494            . I $D(MM(0, XX)) W ?$S (XX=1:2,XX =2:45,1:88 ),MEALDT,"   (Cont.)"
  495            . W ! S TL=T L+1 Q
  496            Q
  497   CHKH     ;  Check whe ther name  header sho uld be on  bottom
  498            I  FHBOT="Y"  W ! S TL= TL+1 D FOO T W ! S TL =TL+1 Q
  499            E   D HEAD
  500            Q
  501   HEAD     F  NM=1:1:3  W ! S TL=T L+1 F NBR= 1:1:3 S X= $P($G(MM(0 ,NBR)),"^" ,NM) I X'=
  502   "" D
  503            . S S1=$S(NB R=1:2,NBR= 2:45,1:88)  I NM=1 W  ?S1,X Q
  504            . W ?(S1+38- $L(X)),X Q
  505            Q
  506   FOOT     W  ! S TL=TL +1 F NBR=1 :1:3 S S1= $S(NBR=1:2 ,NBR=2:45, 1:88) W:$D (MM(0,NBR)
  507   ) ?S1,HD
  508            Q
  509   LIST     ;  Print Tab ulated Rec ipe List f or Service  Points
  510            S  PG=0 I 'M FLG D L1 Q
  511            F  MEAL="B", "N","E" D  L1
  512            D :SUM SUM Q
  513            Q
  514   L1       S :LS(MEAL)< 80 LS(MEAL )=80 S MEA LDT=$S(MEA L="B":"Bre akfast",ME AL="N":"No
  515   on",1:"Eve ning")_" " _MDT,PG=PG +1
  516            W :$E(IOST,1 ,2)="C-" @ IOF W !,HD ,!!!?(LS(M EAL)-42\2) ,"T A B U  L A T E D 
  517     R E C I  P E   L I  S T",?(LS( MEAL)-8)," Page ",PG
  518            W  !!?(LS(ME AL)-$L(MEA LDT)\2),ME ALDT,!!,$S (ALL:"ALL" ,FHP:$P($G (^FH(119.7
  519   3,FHP,0)), "^",1),1:$ P($G(^FH(1 19.6,+W1,0 )),"^",1)) ,!
  520            W  !!,"R E C  I P E S", ?29
  521            S  X="" F  S  X=$O(DP(M EAL,X)) Q: X=""  F K= 0:0 S K=$O (DP(MEAL,X ,K)) Q:K="
  522   "  W $P(DP (MEAL,X,K) ,"^",1)
  523            W  "      To tal",!
  524            S  X8="" F   S X8=$O(^T MP($J,"CTR ",MEAL,X8) ) Q:X8=""   W !!,$P(X 8,"~",3),?
  525   31 D PRO
  526            S  TOT=0 W ! !!,"TOTAL  RECIPES",? 31 S X=""  F  S X=$O( DP(MEAL,X) ) Q:X=""  
  527   D
  528            . F K=0:0 S  K=$O(DP(ME AL,X,K)) Q :K<1  D
  529            . .S Z=$G(P( MEAL,X,K)) ,TOT=TOT+Z
  530            . .I 'Z W $J ("",8)_"   " Q
  531            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  532            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  533            . Q
  534            ; W $S(TOT#1 >0:$J(TOT, 9,1),1:$J( TOT,7)) W: MFLG @IOF  Q
  535            W  $S(TOT#1> 0:$J(TOT,9 ,2),1:$J(T OT,9)) W:M FLG @IOF Q
  536   PRO      S  FTOT=0,X= "" F  S X= $O(DP(MEAL ,X)) Q:X=" "  D
  537            . F K=0:0 S  K=$O(DP(ME AL,X,K)) Q :K<1  D
  538            . .S Z=$G(^T MP($J,"CTR ",MEAL,X8, K)),FTOT=F TOT+Z,P(ME AL,X,K)=P( MEAL,X,K)+
  539   Z
  540            . .I 'Z W $J ("",8)_"   " Q
  541            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  542            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  543            . Q
  544            ; W $S(FTOT# 1>0:$J(FTO T,9,1),1:$ J(FTOT,7)_ "  ")
  545            W  $S(FTOT#1 >0:$J(FTOT ,9,2),1:$J (FTOT,9)_"   ")
  546            Q
  547   SUM      S :SL<80 SL= 80 S MEALD T="All Mea ls "_MDT S  PG=0 D HD R
  548            S  X8="" F   S X8=$O(^T MP($J,"TOT ",X8)) Q:X 8=""  D
  549            . I $Y>LN W  @IOF D HDR
  550            . W !!,$P(X8 ,"~",3),?3 1 D PR1 Q
  551            S  TOT=0 W ! !!,"TOTAL  RECIPES",? 31 S X=""  F  S X=$O( TP(X)) Q:X =""  D
  552            . F K=0:0 S  K=$O(TP(X, K)) Q:K<1   D
  553            . .S Z=$G(T1 (X,K)),TOT =TOT+Z
  554            . .I 'Z W $J ("",8)_"   " Q
  555            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  556            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  557            . Q
  558            ; W $S(TOT#1 >0:$J(TOT, 9,1),1:$J( TOT,7)) Q
  559            W  $S(TOT#1> 0:$J(TOT,9 ,2),1:$J(T OT,9)) Q
  560   PR1      S  FTOT=0,X= "" F  S X= $O(TP(X))  Q:X=""  D
  561            . F K=0:0 S  K=$O(TP(X, K)) Q:K<1   D
  562            . .S Z=$G(^T MP($J,"TOT ",X8,K)),F TOT=FTOT+Z ,T1(X,K)=T 1(X,K)+Z
  563            . .I 'Z W $J ("",8)_"   " Q
  564            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  565            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  566            . Q
  567            ; W $S(FTOT# 1>0:$J(FTO T,9,1),1:$ J(FTOT,7)_ "  ")
  568            W  $S(FTOT#1 >0:$J(FTOT ,9,2),1:$J (FTOT,9)_"   ")
  569            Q
  570   HDR      ;  Consolida ted Recipe  List Head ing
  571            S  PG=PG+1 W  !,HD,!!!? (SL-48\2), "C O N S O  L I D A T  E D   R E  C I P E  
  572    L I S T", ?(SL-8),"P age ",PG
  573            W  !!?(SL-$L (MEALDT)\2 ),MEALDT,! !,$S(ALL:" ALL",FHP:$ P($G(^FH(1 19.73,FHP,
  574   0)),"^",1) ,1:$P($G(^ FH(119.6,+ W1,0)),"^" ,1)),!
  575            W  !!,"R E C  I P E S", ?29
  576            S  X="" F  S  X=$O(TP(X )) Q:X=""   F K=0:0 S  K=$O(TP(X ,K)) Q:K=" "  W $P(TP
  577   (X,K),"^", 1)
  578            W  "      To tal",! Q
  579   After:
  580   FHMTK1C  ;  HISC/NCA/ RVD - Prin t Tray Tic kets ;6/21 /2017  13: 45
  581         ;;5. 5;DIETETIC S;**43**;J an 28, 200 5
  582   PRT      ;  Print 3 p erson per  page
  583   START    I  $G(TABREC )="YES" QU IT
  584            S  TL=0 D CH KH
  585            W  !! S TL=T L+2 F N1=1 :1:3 D
  586            . I 'MFLG S  MEALDT=$S( MEAL="B":" Breakfast" ,MEAL="N": "Noon",1:" Evening")_
  587   " "_MDT
  588            . E  S MEALD T=$S(N1=1: "Breakfast ",N1=2:"No on",1:"Eve ning")_" " _MDT
  589            . I '$D(MM(0 ,N1)) Q
  590            . S MMMDT=$P (MM(0,N1), U,7) I MMM DT'="" S M EALDT=$S(M MMDT="B":" Breakfast"
  591   ,MMMDT="N" :"Noon",1: "Evening") _" "_MDT
  592            . S MEALDT=$ J("",40-$L (MEALDT)\2 )_MEALDT
  593            . I $D(MM(0, N1)) W ?$S (N1=1:2,N1 =2:45,1:88 ),MEALDT
  594            . Q
  595            W  ! S TL=TL +1 F N1=1: 1 Q:'$D(PP (N1))  W !  S TL=TL+1  F NBR=1:1 :3 I $D(PP
  596   (N1,NBR))  W ?$S(NBR= 1:2,NBR=2: 45,1:88),P P(N1,NBR)
  597            ; W ! S TL=T L+1 F N1=1 :1 Q:'$D(P P(N1))  W  ! S TL=TL+ 1
  598            W  ! S TL=TL +1
  599            F  N1=1:1 Q: '$D(MM(N1) )  D:(TL+2 )'<($S(FHB OT="Y":LN- 5,1:LN-3))  NXT W !! 
  600   S TL=TL+2  F NBR=1:1: 3 I $D(MM( N1,NBR)) W  ?$S(NBR=1 :2,NBR=2:4 5,1:88),MM (N1,NBR)
  601            I  TL<LN F L 1=TL:1:$S( FHBOT="Y": LN-2,1:LN)  W !
  602            I  FHBOT="Y"  D HEAD W  @IOF Q
  603            E   D FOOT
  604            W  @IOF Q
  605   NXT      ;  Print Nex t Page
  606            W  !! S TL=T L+2 F NM=1 :1:3 I $D( MM(0,NM))  W ?$S(NM=1 :12,NM=2:5 7,1:100),"
  607   (More Item s Next Pg) "
  608            I  TL<LN F L 1=TL:1:$S( FHBOT="Y": LN-2,1:LN)  W !
  609            I  FHBOT="Y"  D HEAD W  @IOF G N1
  610            E   D FOOT
  611   N1       W  @IOF S TL =0 D CHKH
  612            W  !! S TL=T L+2 F XX=1 :1:3 D
  613            . I 'MFLG S  MEALDT=$S( MEAL="B":" Breakfast" ,MEAL="N": "Noon",1:" Evening")_
  614   " "_MDT
  615            . E  S MEALD T=$S(XX=1: "Breakfast ",XX=2:"No on",1:"Eve ning")_" " _MDT
  616            . I '$D(MM(0 ,XX)) Q
  617            . S MMMDT=$P (MM(0,XX), U,7) I MMM DT'="" S M EALDT=$S(M MMDT="B":" Breakfast"
  618   ,MMMDT="N" :"Noon",1: "Evening") _" "_MDT
  619            . S MEALDT=$ J("",40-$L (MEALDT)\2 )_MEALDT
  620            . I $D(MM(0, XX)) W ?$S (XX=1:2,XX =2:45,1:88 ),MEALDT,"   (Cont.)"
  621            . W ! S TL=T L+1 Q
  622            Q
  623   CHKH     ;  Check whe ther name  header sho uld be on  bottom
  624            I  FHBOT="Y"  W ! S TL= TL+1 D FOO T W ! S TL =TL+1 Q
  625            E   D HEAD
  626            Q
  627   HEAD     F  NM=1:1:3  W ! S TL=T L+1 F NBR= 1:1:3 S X= $P($G(MM(0 ,NBR)),"^" ,NM) I X'=
  628   "" D
  629            . S S1=$S(NB R=1:2,NBR= 2:45,1:88)  I NM=1 W  ?S1,X Q
  630            . ; Print sp ecial flag
  631            . I NM=3 W ? S1,$$NOTE^ FHMTK1D(MM (0,NBR),NB R,MFLG,MEA L) 
  632            . W ?(S1+38- $L(X)),X Q
  633            Q
  634   FOOT     W  ! S TL=TL +1 F NBR=1 :1:3 S S1= $S(NBR=1:2 ,NBR=2:45, 1:88) W:$D (MM(0,NBR)
  635   ) ?S1,HD
  636            Q
  637   LIST     ;  Print Tab ulated Rec ipe List f or Service  Points
  638            S  PG=0 I 'M FLG D L1 Q
  639            F  MEAL="B", "N","E" D  L1
  640            D :SUM SUM Q
  641            Q
  642   L1       S :LS(MEAL)< 80 LS(MEAL )=80 S MEA LDT=$S(MEA L="B":"Bre akfast",ME AL="N":"No
  643   on",1:"Eve ning")_" " _MDT,PG=PG +1
  644            W :$E(IOST,1 ,2)="C-" @ IOF W !,HD ,!!!?(LS(M EAL)-42\2) ,"T A B U  L A T E D 
  645     R E C I  P E   L I  S T",?(LS( MEAL)-8)," Page ",PG
  646            W  !!?(LS(ME AL)-$L(MEA LDT)\2),ME ALDT,!!,$S (ALL:"ALL" ,FHP:$P($G (^FH(119.7
  647   3,FHP,0)), "^",1),1:$ P($G(^FH(1 19.6,+W1,0 )),"^",1)) ,!
  648            W  !!,"R E C  I P E S", ?29
  649            S  X="" F  S  X=$O(DP(M EAL,X)) Q: X=""  F K= 0:0 S K=$O (DP(MEAL,X ,K)) Q:K="
  650   "  W $P(DP (MEAL,X,K) ,"^",1)
  651            W  "      To tal",!
  652            S  X8="" F   S X8=$O(^T MP($J,"CTR ",MEAL,X8) ) Q:X8=""   W !!,$P(X 8,"~",3),?
  653   31 D PRO
  654            S  TOT=0 W ! !!,"TOTAL  RECIPES",? 31 S X=""  F  S X=$O( DP(MEAL,X) ) Q:X=""  
  655   D
  656            . F K=0:0 S  K=$O(DP(ME AL,X,K)) Q :K<1  D
  657            . .S Z=$G(P( MEAL,X,K)) ,TOT=TOT+Z
  658            . .I 'Z W $J ("",8)_"   " Q
  659            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  660            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  661            . Q
  662            ; W $S(TOT#1 >0:$J(TOT, 9,1),1:$J( TOT,7)) W: MFLG @IOF  Q
  663            W  $S(TOT#1> 0:$J(TOT,9 ,2),1:$J(T OT,9)) W:M FLG @IOF Q
  664   PRO      S  FTOT=0,X= "" F  S X= $O(DP(MEAL ,X)) Q:X=" "  D
  665            . F K=0:0 S  K=$O(DP(ME AL,X,K)) Q :K<1  D
  666            . .S Z=$G(^T MP($J,"CTR ",MEAL,X8, K)),FTOT=F TOT+Z,P(ME AL,X,K)=P( MEAL,X,K)+
  667   Z
  668            . .I 'Z W $J ("",8)_"   " Q
  669            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  670            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  671            . Q
  672            ; W $S(FTOT# 1>0:$J(FTO T,9,1),1:$ J(FTOT,7)_ "  ")
  673            W  $S(FTOT#1 >0:$J(FTOT ,9,2),1:$J (FTOT,9)_"   ")
  674            Q
  675   SUM      S :SL<80 SL= 80 S MEALD T="All Mea ls "_MDT S  PG=0 D HD R
  676            S  X8="" F   S X8=$O(^T MP($J,"TOT ",X8)) Q:X 8=""  D
  677            . I $Y>LN W  @IOF D HDR
  678            . W !!,$P(X8 ,"~",3),?3 1 D PR1 Q
  679            S  TOT=0 W ! !!,"TOTAL  RECIPES",? 31 S X=""  F  S X=$O( TP(X)) Q:X =""  D
  680            . F K=0:0 S  K=$O(TP(X, K)) Q:K<1   D
  681            . .S Z=$G(T1 (X,K)),TOT =TOT+Z
  682            . .I 'Z W $J ("",8)_"   " Q
  683            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  684            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  685            . Q
  686            ; W $S(TOT#1 >0:$J(TOT, 9,1),1:$J( TOT,7)) Q
  687            W  $S(TOT#1> 0:$J(TOT,9 ,2),1:$J(T OT,9)) Q
  688   PR1      S  FTOT=0,X= "" F  S X= $O(TP(X))  Q:X=""  D
  689            . F K=0:0 S  K=$O(TP(X, K)) Q:K<1   D
  690            . .S Z=$G(^T MP($J,"TOT ",X8,K)),F TOT=FTOT+Z ,T1(X,K)=T 1(X,K)+Z
  691            . .I 'Z W $J ("",8)_"   " Q
  692            . .;W $S(Z#1 >0:$J(Z,8, 1),1:$J(Z, 6)_"  ")_"   " Q
  693            . .W $S(Z#1> 0:$J(Z,8,2 ),1:$J(Z,8 ))_"  " Q
  694            . Q
  695            ; W $S(FTOT# 1>0:$J(FTO T,9,1),1:$ J(FTOT,7)_ "  ")
  696            W  $S(FTOT#1 >0:$J(FTOT ,9,2),1:$J (FTOT,9)_"   ")
  697            Q
  698   HDR      ;  Consolida ted Recipe  List Head ing
  699            S  PG=PG+1 W  !,HD,!!!? (SL-48\2), "C O N S O  L I D A T  E D   R E  C I P E  
  700    L I S T", ?(SL-8),"P age ",PG
  701            W  !!?(SL-$L (MEALDT)\2 ),MEALDT,! !,$S(ALL:" ALL",FHP:$ P($G(^FH(1 19.73,FHP,
  702   0)),"^",1) ,1:$P($G(^ FH(119.6,+ W1,0)),"^" ,1)),!
  703            W  !!,"R E C  I P E S", ?29
  704            S  X="" F  S  X=$O(TP(X )) Q:X=""   F K=0:0 S  K=$O(TP(X ,K)) Q:K=" "  W $P(TP
  705   (X,K),"^", 1)
  706            W  "      To tal",! Q
  707   FHQUE (New )
  708   FHQUE    ; REGION 1/K LD; 5/17/1 3; AUTO-QU EUE DIETET ICS REPORT S & LABELS ; 11/7/14   3:31 PM
  709            ; ;5.5;DIETE TICS;**43* *;Jan 28,  2005
  710            ; Run shortl y after mi dnight
  711            ; Original v ersion Jun e 2004
  712   ST       F  FHI=0:0 S  FHI=$O(^F H(117.44,F HI)) Q:'FH I  D:$$GET 1^DIQ(117. 44,FHI,5)= "YES" ML
  713   FHK      K  %,DA,DIC, DIE,DIK,DR ,FH,FHI,FH II,FHIII,X ,Y,ZTDESC, ZTDTH,ZTIO ,ZTRTN,ZTS AVE,ZTSK,^ TMP("FHQUE ",$J) Q
  714            ;
  715   ML       ; Main loop
  716            S  FH("FLAG" )=0
  717            I  $O(^FH(11 7.44,FHI,2 ,0)) D  Q: 'FH("FLAG" )  ;Only r un certain  days of t he week
  718            . S X=DT D D W^%DTC S Y =Y+1,FH("F LAG")=$D(^ FH(117.44, FHI,2,"B", Y))
  719            S  FH("TIME" )=$$GET1^D IQ(117.44, FHI,1)
  720            S :FH("TIME" )<600 FH(" TIME")=0_F H("TIME")
  721            S  %DT="R",X ="T@"_FH(" TIME") D ^ %DT S ZTDT H=$S($D(FH ("TEST")): $H,1:Y)
  722            S  ZTDESC=$$ GET1^DIQ(1 17.44,FHI, .01)_" Aut o Queue"
  723            S  ZTIO=$$GE T1^DIQ(117 .44,FHI,2)
  724            S  ZTRTN=$$G ET1^DIQ(11 7.44,FHI,3 )_U_$$GET1 ^DIQ(117.4 4,FHI,4)
  725            F  FHII=0:0  S FHII=$O( ^FH(117.44 ,FHI,1,FHI I)) Q:'FHI I  D  ;Get  necessary  variables
  726            . S FH("VAR" )=$$GET1^D IQ(117.441 ,FHII_","_ FHI,.01)
  727            . S @FH("VAR ")=$TR($$G ET1^DIQ(11 7.441,FHII _","_FHI,1 ),"|",U)
  728            . D:$$GET1^D IQ(117.441 ,FHII_","_ FHI,2)="YE S"  ;Date  variable
  729            . .S X=$TR($ $GET1^DIQ( 117.441,FH II_","_FHI ,1),"|",U) ,%DT=$S(X[ "@":"R",1: "")
  730            . .D ^%DT S  @FH("VAR") =Y
  731            . S X=$TR($$ GET1^DIQ(1 17.441,FHI I_","_FHI, 3),"|",U)  X:X]"" X ; Xecutable  code to se t the vari able
  732            . S ZTSAVE(F H("VAR"))= @FH("VAR")
  733            D  ^%ZTLOAD  W !!,"ZTSK =",$G(ZTSK ) Q
  734            ;
  735   TEST     ; Test one p articular  option
  736            R  !!,"IEN:  ",FHI:DTIM E Q:U[FHI   S FH("TES T")=""
  737            I  '$D(^FH(1 17.44,FHI) ) W !,"Inv alid IEN!"  G TEST
  738            W  ! S DIC=" ^%ZIS(1,", DIC(0)="QE AM",DIC("A ")="Select  printer:  " D ^DIC
  739            G  TEST:Y<1  S ZTIO=$P( Y,U,2) D M L,FHK Q
  740            ;
  741   SRCH     ; Search fil e 19 for a  synonym
  742            S :'$D(FH("S TR")) FH(" STR")="FH"
  743            N  FHFND S F HFND=""
  744            R  !!,"Searc h for: ",F H("SRCH"): DTIME Q:U[ FH("SRCH")
  745            S  FHI=FH("S TR") F  S  FHI=$O(^DI C(19,"B",F HI)) Q:$E( FHI,1,2)'= FH("STR")! (FHI="")   D
  746            . F FHII=0:0  S FHII=$O (^DIC(19," B",FHI,FHI I)) Q:'FHI I  D
  747            . .F FHIII=0 :0 S FHIII =$O(^DIC(1 9,FHII,FHI II)) Q:'FH III  D
  748            . ..S X=$$GE T1^DIQ(19, FHII,.01)
  749            . ..W:X[FH(" SRCH") !!, FHII,!?3,X ,?17,$$GET 1^DIQ(19,F HII,25,2,. 01)
  750            D  FHK Q
  751            ;
  752   UEDIT    ; User edit  of options
  753            K  ^TMP("FHQ UE",$J) S  FH("CNT")= 0,FHI=""
  754            F   S FHI=$O (^FH(117.4 43,"B",FHI )) Q:FHI=" "  D
  755            . F FHII=0:0  S FHII=$O (^FH(117.4 43,"B",FHI ,FHII)) Q: 'FHII  D
  756            . .S X=$$GET 1^DIQ(117. 443,FHII,. 01) Q:X=""
  757            . .S X(1)=$$ GET1^DIQ(1 17.443,FHI I,1) S:X(1 )="" X(1)= "NULL"
  758            . .S ^TMP("F HQUE",$J,X ,X(1))=$$G ET1^DIQ(19 ,FHI,1)_U_ FHII
  759            S  (FHI,FHII )="" W !!, "Available  options a re:"
  760            F   S FHI=$O (^TMP("FHQ UE",$J,FHI )) Q:FHI=" "  D
  761            . F  S FHII= $O(^TMP("F HQUE",$J,F HI,FHII))  Q:FHII=""   D
  762            . .S FH("CNT ")=FH("CNT ")+1,FH("S EL",FH("CN T"))=FHI_U _$P(^TMP(" FHQUE",$J, FHI,FHII), U,2)
  763            . .W !?3,$J( FH("CNT"), 2),". ",FH I W:FHII'= "NULL" ?20 ,FHII
  764            . .W ?35,$P( ^TMP("FHQU E",$J,FHI, FHII),U)
  765   UEDIT1   R  !,"Your c hoice: ",F H("OPT"):D TIME I U[F H("OPT") D  FHK Q
  766            I  FH("OPT") '?1.2N!('$ D(FH("SEL" ,FH("OPT") ))) W "  ? ?" G UEDIT 1
  767   UEDIT2   R  !!,"Time  to run the  option (u se 4 digit  military  time): ",F H("TIME"): DTIME I U[ FH("TIME")  D FHK Q
  768            I  FH("TIME" )'?4N!(FH( "TIME")>23 59)!($E(FH ("TIME"),3 )>5) W "   ??" G UEDI T2
  769            S  FH("NAME" )=$P(FH("S EL",FH("OP T")),U)_"  "_FH("TIME ")
  770            S  FH("DA")= $P(FH("SEL ",FH("OPT" )),U,2)
  771            S  (DIC,DIE) ="^FH(117. 44,",DIC(0 )="M",X=FH ("NAME") D  ^DIC S DA =+Y
  772            I  Y=-1 D  G  UEDIT:%'= 1
  773            . W !!,"Add  entry ",$C (34),FH("N AME"),$C(3 4) S %=1 D  YN^DICN Q :%'=1
  774            . S DIC(0)=" L" K DD,DO  D FILE^DI CN
  775            . S DA=+Y,DR ="1///"_$P (FH("NAME" )," ",2),F H("ADDED") =""
  776            . D ^DIE W ! ,"Entry ad ded."
  777            W  !!,"Now a dd/change  the printe r and whet her it's a ctive.",!
  778            S  DR="3///" _$$GET1^DI Q(117.443, FH("DA"),3 )_";4///"_ $$GET1^DIQ (117.443,F H("DA"),4) _";2R;5R// YES;20"
  779            D  ^DIE S ^F H(117.44,D A,1,0)="^1 17.441^",X =DA
  780            K  DA,DIC,DI E,DR S DIC ="^FH(117. 44,"_X_",1 ,",DIC(0)= "L",DA(1)= X,FH("BAD" )=0
  781            F  FHI=0:0 S  FHI=$O(^F H(117.443, FH("DA"),1 ,FHI)) Q:' FHI!(FH("B AD"))  D
  782            . S X=$$GET1 ^DIQ(117.4 4302,FHI_" ,"_FH("DA" ),.01),DIC ("DR")=""
  783            . D:$$GET1^D IQ(117.443 02,FHI_"," _FH("DA"), 1)="YES" A SK Q:FH("B AD")
  784            . K DIC("DR" ),DD,DO D  FILE^DICN  S DA=+Y
  785            . S DR="",DI E=DIC D DR ,^DIE K FH ("QUES")
  786            . S:DR["3//"  ^FH(117.4 4,DA(1),1, DA,1)=$TR( ^FH(117.44 ,DA(1),1,D A,1),"|",U )
  787            I  'FH("BAD" ) W !!,"Op tion ",$S( $D(FH("ADD ED")):"add ",1:"chang "),"ed!" H  3
  788            I  FH("BAD")  S DIK="^F H(117.44,"  D ^DIK W  !!,"Invali d entry -  deleted!"
  789            K  FH("ADDED ") G UEDIT
  790            ;
  791   ASK      N  %DT,FHII, FHWP,X,Y S  FHWP=$$GE T1^DIQ(117 .44302,FHI _","_FH("D A"),5,""," FHWP")
  792            W  !!,"Now a nswer this  question: "
  793            F  FHII=0:0  S FHII=$O( FHWP(FHII) ) Q:'FHII   W !?3,FHW P(FHII)
  794            R  !,"Your a nswer: ",X :DTIME I U [X S FH("B AD")=1 Q
  795            I  $$GET1^DI Q(117.4430 2,FHI_","_ FH("DA"),3 )="YES" S  %DT="ET" D  ^%DT I Y< 1 W !,"Inv alid date/ time!" G A SK
  796            S  FH("QUES" )=X Q
  797            ;
  798   DR       N  X S DR=""
  799            F  FHFD=1,2, 3 D
  800            . I $G(FH("Q UES"))]"", FHFD=1 S X =FH("QUES" )
  801            . E  S X=$$G ET1^DIQ(11 7.44302,FH I_","_FH(" DA"),FHFD+ 1) Q:X=""
  802            . S DR=DR_FH FD_"///"_X _";"
  803            Q
  804   FHMTK1D (N ew)
  805   FHMTK1D  ; SFVAMC/APC  - MEAL TI CKET UTILI TIES ; 5/2 9/2017 12: 10
  806            ; ;5.5;DIETE TICS;**43* *;Jan 28,  2005
  807            ;
  808            ; ICR#   Typ e  Descrip tion
  809            ; -----  --- -  ------- ---------- ---------- ---------- -
  810            ; 10006  Sup    ^DIC
  811            ; 10018  Sup    ^DIE
  812            ; 10026  Sup    ^DIR
  813            ;  2051  Sup    FIND^DI C  
  814            ;  2051  Sup    FIND1^D IC  
  815            ; 10035  Sup    File #2
  816            ;         
  817   DRV(DATA,P ART,MFLG,M EAL)  ;
  818            S  MESS=$$NO TE(DATA,PA RT,$G(MFLG ),$G(MEAL) )
  819            W  !,MESS
  820            Q
  821            ;
  822   NOTE(MTID, PART,MFLG, MEAL) ;Cal led from H EAD^FHMTK1 C
  823            N  FHWARD,PA TNM,ARHCDF N,BID,FOUN D,MSG,X
  824            S  MSG=""
  825            S  FHWARD=$P (MTID,U,2) ,X=$P(MTID ,"("),X=$E (X,1,$L(X) -1)
  826            I  FHWARD="G A(L)" D NO TE2(X,FHWA RD) S:MSG= "" MSG="PP APER ISOL/ PLASTW"
  827            I  $E(FHWARD ,1,3)="CLC " D NOTE2( X,FHWARD)
  828            Q  MSG
  829            ;
  830   NOTE2(X,FH WARD)  ;
  831            N  FHNODE,FH P,FHIENP,F HTMP,FHIEN ,FLDS,FLG, FHERR,DIER R
  832            S  FLDS="@;. 1"
  833            S  FLG="PQ"
  834            D  FIND^DIC( 2,,FLDS,FL G,X,,"B"," I $E($G(^( .1)),1,3)= ""CLC""",, "FHTMP","F
  835   HERR")
  836            S  FHIENP=0  F  S FHIEN P=$O(FHTMP ("DILIST", FHIENP)) Q :FHIENP=""   D
  837            . S FHIEN=$P ($G(FHTMP( "DILIST",F HIENP,0)), U)
  838            . S FHNODE=$ G(^FHPT(FH IEN,662910 ))
  839            . I 'MFLG S  MSG=$S(MEA L="B":$P(F HNODE,U,1) ,MEAL="N": $P(FHNODE, U,2),1:$P(
  840   FHNODE,U,3 )) Q
  841            . S MSG=$S(P ART=1:$P(F HNODE,U,1) ,PART=2:$P (FHNODE,U, 2),1:$P(FH NODE,U,3))
  842            Q
  843            ;
  844   TTFLAG   ; Edit tray  ticket fla g
  845            N  DIR,DIROU T,DIRUT,DT OUT,DUOUT
  846            K  DIR S DIR (0)="S^P:P ATIENT;W:W ARD",DIR(" A")="Selec t by (P)at ient or (W
  847   )ard",DIR( "B")="P" D  ^DIR
  848            Q :$D(DIRUT)
  849            I  Y="P" D T TFP Q
  850            I  Y="W" D T TFW Q
  851            Q
  852            ;
  853   TTFP        ;Edit tra y ticket f lag by pat ient
  854            N  FHCDFN,FH CFDFN,DIE, DA,DIC,DR, DTOUT,DUOU T
  855            F   K DIC S  DIC="^DPT( ",DIC(0)=" AZEMQ" D ^ DIC Q:Y'>0   D
  856            . S FHCDFN=+ Y
  857            . S FHCFDFN= $$IEN(FHCD FN)
  858            . I $$GET1^D IQ(2,FHCFD FN,.1)'="C LC" W !!,? 7,"Patient  is not a  CLC patien
  859   t" Q
  860            . I '$D(^FHP T(FHCFDFN, 0)) W !!,* 7,$$GET1^D IQ(2,FHCFD FN,.01),"  is not in 
  861   the Dietet ics Patien t file." Q
  862            . S DIE="^FH PT(",DA=FH CFDFN,DR=" 662910.01; 662910.02; 662910.03"  D ^DIE
  863            . W !
  864            Q
  865            ;
  866   TTFW        ;Edit tra y ticket f lag by war d
  867            N  FHCDFN,FH CFDFN,FHWA RD,EXIT,FH TMP,FHERR, FLDS,FLG,F HIEN,DIE,D TOUT,DUOUT
  868            S  FHCDFN=0, EXIT=0
  869            S  FLDS="@;. 01"
  870            S  FLG="PQ"
  871            D  FIND^DIC( 2,,FLDS,FL G,"CLC",," CN",,,"FHT MP","FHERR ")
  872            F   S FHCDFN =$O(FHTMP( "DILIST",F HCDFN)) Q: 'FHCDFN  D   Q:EXIT
  873            . N DA,DIE,D R,DTOUT,DU OUT 
  874            . S FHCFDFN= FHTMP("DIL IST",FHCDF N,0),FHIEN =+FHCFDFN
  875            . I '$D(^FHP T(FHIEN))  W !,*7,$P( FHTMP("DIL IST",FHCDF N,0),U,2), " is not i
  876   n the Diet etics Pati ent file."  Q
  877            . W !!,?5,$$ GET1^DIQ(2 ,FHIEN,.01 ),"   ",$$ GET1^DIQ(2 ,FHIEN,.1) ,"   ",$$G
  878   ET1^DIQ(2, FHIEN,.101 )
  879            . S DIE="^FH PT(",DA=FH IEN,DR="66 2910.01;66 2910.02;66 2910.03" D  ^DIE
  880            . I $D(DTOUT )!$D(Y) S  EXIT=1
  881            Q
  882            ;
  883   IEN(FHD0,F HDFILE) ;
  884            ;             ;
  885            ;  Get point er to NUTR ITION PERS ON (#115)  given
  886            ;  the PATIE NT (#2) or  NEW PERSO N (#200) p ointer
  887            ;  Input
  888            ;   FHD0 = P ATIENT (#2 ) or NEW P ERSON (#20 0) pointer  (Req)
  889            ;   FHDFILE  = PATIENT  (#2) or NE W PERSON ( #200) file  # (Opt, D flt=2)
  890            ;  Output
  891            ;   $$IEN()  = Pointer  to NUTRITI ON PERSON  (#115)
  892            N  DFN,FOUND ,LN,MFLG,M M,MSG,N1,N BR,NM,PART ,PG,S1,SL, TL,X,Y,Z,D IERR,FHERR
  893            Q  +$$FIND1^ DIC(115,"" ,"X",$S($G (FHDFILE,2 )=200:"N", 1:"P")_FHD 0,"B")