7. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 2/19/2019 12:20:53 PM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

7.1 Files compared

# Location File Last Modified
1 C:\AraxisMergeCompare\Pri_un\EPIP combined\GMTS_2.7_124 EPIP_Remediation_Plan_(GMTS_2.7_124).doc Tue Feb 12 17:11:01 2019 UTC
2 C:\AraxisMergeCompare\Pri_re\EPIP combined\GMTS_2.7_124 EPIP_Remediation_Plan_(GMTS_2.7_124).doc Tue Feb 19 13:23:08 2019 UTC

7.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 12 2402
Changed 11 26
Inserted 0 0
Removed 0 0

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

7.4 Active regular expressions

No regular expressions were active.

7.5 Comparison detail

  1   EPIP_Remed iation_Pla nExisting  Product In take Progr am (EPIP)
  2   Patch GMTS *2.7*124
  3   Remediatio n Plan
  4  
  5   Department  of Vetera ns Affairs
  6   January 20 19
  7   Version 3. 0
  8   Revision H istory
  9   DateVersio nDescripti onAuthor01 /22/20193. 0Updates t hroughoutE PIP Projec t Team04/1 2/20182.0U pdated dra ft version  to includ e new NSR  20180306EP IP Project  Team04/03 /20181.0In itial (dra ft) versio n EPIP Pro ject TeamT able of Co ntents
  10   11.
  11   Introducti on
  12  
  13  
  14   12.
  15   Purpose
  16  
  17  
  18   13.
  19   Patch Desc ription
  20  
  21  
  22   43.1.
  23   Business E pics and S ub-Epics
  24  
  25  
  26   64.
  27   Points of  Contact
  28  
  29  
  30   65.
  31   Code Remed iation
  32  
  33  
  34   65.1.
  35   Standards  and Conven tions
  36  
  37  
  38   65.2.
  39   Review and  Analysis
  40  
  41  
  42   65.3.
  43   Coding Cha nges
  44  
  45  
  46   76.
  47   Testing
  48  
  49  
  50   76.1.
  51   Test Plan
  52  
  53  
  54   76.2.
  55   Test Envir onment
  56  
  57  
  58   86.3.
  59   Test Readi ness Revie w
  60  
  61  
  62   86.4.
  63   Testing Ph ases
  64  
  65  
  66   86.4.1.
  67   Unit Testi ng
  68  
  69  
  70   86.4.2.
  71   Component  Integratio n and Syst ems Testin g (CI/ST)
  72  
  73  
  74   86.4.3.
  75   Functional  Testing
  76  
  77  
  78   86.4.4.
  79   Regression  Testing
  80  
  81  
  82   96.4.5.
  83   Section 50 8 Complian ce Testing
  84  
  85  
  86   97.
  87   Documentat ion Remedi ation
  88  
  89  
  90   97.1.
  91   User Guide s
  92  
  93  
  94   97.2.
  95   Installati on Guides
  96  
  97  
  98   97.3.
  99   Technical  Manuals
  100  
  101  
  102   97.4.
  103   Operations  Manuals
  104  
  105  
  106   98.
  107   Project Re porting
  108  
  109  
  110   109.
  111   Project Sc hedule
  112  
  113  
  114   1010.
  115   Deployment
  116  
  117  
  118   1011.
  119   Sustainmen t Requirem ents
  120  
  121  
  122   1012.
  123   Maintenanc e and Know ledge Tran sfer
  124  
  125  
  126   11Appendix  A:
  127   XINDEX Lis ting for M UMPS Code  Changes
  128  
  129  
  130   13Appendix  B:
  131   Source Cod e Changes
  132  
  133  
  134  
  135  
  136   Introducti on
  137   The Depart ment of Ve terans Aff airs (VA)  currently  utilizes t he Veteran s Health I nformation  Systems a nd Technol ogy Archit ecture (Vi stA) suite  of applic ations to  provide cl inical, fi nancial, i nfrastruct ure, and m anagement  tools. The  process o f advancin g “Class 3 ” field-de veloped Vi stA softwa re to “Cla ss 1” nati onally-dis tributed s tatus is r eferred to  as the Ex isting Pro duct Intak e Program  (EPIP). Th e VA’s goa l is to su pplement o ngoing act ivities as sociated w ith evalua ting and a dvancing f ield-devel oped softw are to a s tate that  meets nati onal stand ards and f acilitates  release f or Veteran s Health A dministrat ion (VHA)- wide use.
  138   Purpose
  139   The purpos e of this  document i s to fully  describe  the remedi ation plan  to be use d for the  successful  remediati on of the  intake pro duct code  to be depl oyed as pa tch GMTS*2 .7*124. Th is patch a ddresses t he followi ng NSRs:
  140   NSR2017120 4 Display  Provider a nd Attendi ng Provide r on MAS A dmission-D ischarge C omponents
  141   This NSR h as been im plemented  locally at  the VA Me dical Cent er in San  Francisco  CA.
  142   NSR2017120 6 Progress  Note Titl e Componen t
  143   This NSR h as been im plemented  locally at  the VA Me dical Cent er in San  Francisco  CA.
  144   NSR2017120 7 Reports  Tab Displa y Appointm ent Room N umber
  145   This NSR h as been im plemented  locally at  the VA Me dical Cent er in Milw aukee WI.
  146   NSR2018030 6 Future C linic Visi ts Display s RECALL A ppointment  Requests
  147   This NSR h as been im plemented  locally at  the VA Me dical Cent er in Milw aukee WI.
  148   NSR2018010 9 Display  Users Titl e on Inter disciplina ry Records
  149   This NSR h as been im plemented  locally at  the VA Me dical Cent er in Milw aukee WI.
  150   This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation,  and delive ry of this  remediati on effort.
  151   Patch Desc ription
  152   GMTS*2.7*1 24 provide s the foll owing enha ncements t o VistA:
  153   Retrieves  informatio n for the  provider a nd attendi ng provide r associat ed with pr evious inp atient adm issions an d displays  it in the  Admission /Discharge  Component  (ADC), ac cessed thr ough eithe r the Vist A Ad Hoc H ealth Summ ary [GMTS  HS ADHOC]  option or  the Health  Summary o ption on t he CPRS Re ports tab.  The previ ous provid er names,  specialtie s, and pag er numbers  can then  be reviewe d by clini cians, qua lity manag ers, and a uditors. T he enhance ment modif ies routin e GMTSDGA1  to call n ew routine  GMTSDGA3,  which ret urns the p rovider da ta from th e Health S ummary Com ponent fil e (#142.1) .
  154   Adds a new  output co mponent to  the Selec ted Progre ss Notes H ealth Summ ary, acces sed throug h either t he VistA A d Hoc Heal th Summary  [GMTS HS  ADHOC] opt ion or the  Health Su mmary opti on on the  CPRS Repor ts tab. Th e new comp onent allo ws the use r to displ ay selecte d progress  note titl es without  the assoc iated note  text. Cur rently, th ere are th ree Health  Summary c omponents  for viewin g progress  notes: 1)  All Progr ess Notes  (PN): all  titles wit h associat ed note te xt; 2) Bri ef Progres s Notes (B PN): all t itles with out associ ated note  text; and  3) Selecte d Progress  Notes (SP N): select ed titles  with assoc iated note  text. Thi s patch ad ds a fourt h componen t, Selecte d Progress  Note Titl es (SPNT),  which ena bles users  to displa y selected  titles wi thout asso ciated not e text. Th is new com ponent wil l allow us ers to rev iew and au dit select ed titles  without sc rolling th rough doze ns of asso ciated not e pages. T his is acc omplished  by new rou tines GMTS PNST and G MTSP124, a nd by modi fications  to routine s GMTSPN1  and GMTSPN .
  155   The new ou tput compo nent appea rs in the  CPRS Ad Ho c Health S ummary opt ion as sho wn below:
  156   ========== ========== ========== ========== ========== ========== ========== ========== ====
  157   Select NEW  set of CO MPONENT(S) : SPNT   S elected PN  Titles 
  158                           Default  Limits and  Selection  Items
  159        Compo nent               Oc c    Time    Hosp  IC D  Prov  C PT  Select ion
  160                                 Li mit  Limit   Loc   Tx t  Narr  M od  Item(s )
  161   SPNT Selec ted PN Tit les     10      1Y                        
  162   Select COM PONENT(S)  to EDIT or  other COM PONENT(S)  to ADD:
  163   Output fro m Adhoc Re port under  Health Su mmary in C PRS:
  164                                                                        11/06/2 018 13:30
  165   ********** **********   CONFIDEN TIAL AD HO C SUMMARY    pg. 1 ** ********** *********
  166   AASUUUUD,A AAA K    X XX-XX-XXXX       CLC  118-1                     DOB: X X/XX/XXXX
  167   ----------  SPNT - Se lected Pn  Titles (ma x 10 occur rences or  1 year) -- --------
  168   11/05/2018  08:37  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  169                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  170   11/05/2018  08:32  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  171                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  172   10/25/2018  11:16  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  173                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  174   06/20/2018  12:43  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  175                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  176   04/10/2018  14:37  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  177                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  178   03/08/2018  12:44  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  179                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  180   03/05/2018  13:57  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  181                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  182   12/19/2017  11:19  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  183                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  184   12/08/2017  08:06  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  185                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  186   12/07/2017  10:44  Lo cal Title:  RESTRAINT  PROGRESS  NOTE AND E VERY TWO H OUR FLOW S HEET
  187                   Stand ard Title:  SECLUSION  RESTRAINT  NOTE
  188   *** END ** **********   CONFIDEN TIAL AD HO C SUMMARY    pg. 1 ** ********** ********
  189   Adds the c linic loca tion to th e Future C linic Visi ts compone nt of the  Health Sum mary optio n on the C PRS Report s tab. Dep ending on  how clinic s are orga nized at a  site, the  clinic lo cation cou ld be a ro om number,  a buildin g name/roo m number,  or other i nformation  that spec ifies the  physical l ocation fo r a patien t visit. C urrently,  the Future  Clinic Vi sits compo nent displ ays a repo rt showing  the clini c name onl y. This mo dification  enables s upport sta ff to quic kly and ea sily direc t a patien t to the p roper clin ic locatio n when ask ed for ass istance.
  190   This enhan cement add itionally  retains al l appointm ents for t he current  day on th e Future C linic Visi ts report,  including  those for  which the  start tim e has alre ady passed , so that  the room i nformation  is still  visible if  a patient  is a few  minutes la te and ask s for dire ctions to  the clinic  location.  Currently , the Futu re Clinic  Visits rep ort does n ot display  appointme nt times s cheduled e arlier tha n the curr ent time d uring a gi ven day.
  191   This patch  modifies  routine GM TSDA to di splay the  clinic loc ation foun d in the P HYSICAL LO CATION fie ld (#10) i n the HOSP ITAL LOCAT ION file ( #44). The  routine wi ll also di splay all  appointmen ts for the  current d ay, includ ing those  that have  already oc curred.
  192   Adds recal l reminder s to the F uture Clin ic Visits  component  of the Hea lth Summar y option o n the CPRS  Reports t ab. Recall  reminders  are used  to schedul e or discu ss follow- up appoint ments plan ned for th e future.  For exampl e, a patie nt might n eed to ret urn for a  follow-up  appointmen t in one y ear. Inste ad of sche duling the  appointme nt a year  in advance , a recall  reminder  is entered  for the p atient so  the appoin tment can  be schedul ed later o r discusse d further  with the p atient. Cu rrently, r ecall remi nders are  displayed  only on th e CPRS Cov er Sheet,  and are no t shown on  the Futur e Clinic V isits repo rt. This p atch modif ies routin e GMTSDA t o call exi sting rout ine SDRROR  at entry  point COVE R. The SDR ROR routin e then ext racts reca ll reminde rs from th e RECALL R EMINDERS f ile (#403. 5) for dis play in th e Future C linic Visi ts report.  The remin der includ es the dat e on which  the follo w-up appoi ntment sho uld be sch eduled, fo llowed by  a descript ion of the  appointme nt. This m odificatio n enables  non-schedu ling staff  to more e asily coor dinate fut ure appoin tment need s for the  patient. 
  193   To display  recall re minders on  the Futur e Clinic V isits repo rt, the ne w GMTS SHO W FUTURE R ECALL DATE  parameter  must be s et to ON a fter this  patch is i nstalled.  To set the  parameter  to ON:
  194   1. 
  195   In VistA,  navigate t o the Heal th Summary  Maintenan ce Menu [G MTS IRM/AD PAC MAINT  MENU] opti on.
  196   2. 
  197   Select the  Display F uture Clin ic Visit R ecall Date  [GMTS HS  DISPLAY RE CALL DATE]  option an d then pre ss Enter.
  198   3. 
  199   At the “Se e Future C linic Visi t Recall A ppt Date:”  prompt, t ype YES an d then pre ss Enter.
  200   Adds infor mation to  the Educat ion compon ent of the  Health Su mmary opti on on the  CPRS Repor ts tab. Cu rrently, t he Educati on compone nt display s a report  showing t he encount er date, f acility, a nd topic d iscussed w ith the pa tient, but  does not  display th e educator  name or r ole. This  patch modi fies routi ne GMTSPXE P to read  the NEW PE RSON file  (#200) and  find the  name and t itle of th e educator  for each  topic. Wit h this inf ormation,  providers  can verify  that the  educator h ad the app ropriate b ackground  for the to pic discus sed. In ad dition, pr oviders ca n verify t hat an int erdiscipli nary appro ach was us ed for pat ient educa tion, base d on the r oles of th e educator s involved
  201   To display  names and  titles on  the Educa tion repor t, the new  GMTS SHOW  EDUCATION  USER/TITL E paramete r must be  set to ON  after this  patch is  installed.  To set th e paramete r to ON:
  202   1. 
  203   In VistA,  navigate t o the Heal th Summary  Maintenan ce Menu [G MTS IRM/AD PAC MAINT  MENU] opti on.
  204   2. 
  205   Select the  Show User /Title on  Interdisci plinary Ed  Record [G MTS HS USE R/TITLE ED  RECORD] o ption and  then press  Enter.
  206   3. 
  207   At the “Sh ow User/Ti tle on Int erdisc Rec ords:” pro mpt, type  YES and th en press E nter.
  208   At the end  of the pa tch instal lation pro cess, post -installat ion routin e GMTSP124  performs  the follow ing tasks:
  209   1. 
  210   Installs n ew Health  Summary co mponent SP NT (Select ed PN Titl es).
  211   2.
  212   Rebuilds t he Ad Hoc  Health Sum mary [GMTS  HS ADHOC]  option to  include n ew compone nt SPNT. N ote: This  option is  not delive red with t he patch,  as it is m odified on ly by the  rebuilding  process.
  213   3.
  214   Attaches t he followi ng new opt ions to th e Health S ummary Mai ntenance M enu [GMTS  IRM/ADPAC  MAINT MENU ] option: 
  215   - Display  Future Cli nic Visit  Recall Dat e [GMTS HS  DISPLAY R ECALL DATE
  216   - Show Use r/Title on  Interdisc iplinary E d Record [ GMTS HS US ER/TITLE E D RECORD]
  217   Business E pics and S ub-Epics
  218   The Busine ss Epics a nd Sub-Epi cs for the  NSR(s) ad dressed in  this reme diation ar e:
  219   NSR2017120 4 Display  Provider a nd Attendi ng Provide r on MAS A dmission-D ischarge C omponents
  220   BUSINESS E PIC 966140 : For prov iders or h ealth reco rd review  staff memb ers who re view vario us episode s of care,  a modific ation to t he Health  Summary ap plication  is needed  for the MA S Admissio ns/Dischar ges Compon ent that l ists the p revious at tendings a nd provide rs and the ir pager i nformation . Unlike t he current  solution  which only  lists the  current a ttending a nd provide r informat ion, our p rocess all ows all fa cilities t o efficien tly view p revious at tendings a nd provide rs along w ith their  respective  contact i nformation , lessenin g delays i n providin g patient  care.
  221   NSR2017120 6 Progress  Note Titl e Componen t
  222   BUSINESS E PIC 960907 : For Heal th Informa tion revie w staff wh o need to  review spe cific prog ress notes , an addit ional Heal th Summary  Component  for displ aying prog ress notes  that allo ws the use r to displ ay only th e titles f or selecte d progress  notes. Un like the c urrent Hea lth Summar y Componen ts that di splay: pro gress note s (all tit les with c ontent), s elected pr ogress not es (specif ic titles  with conte nt), and b rief progr ess notes  (all title s but not  content),  our proces s provides  a new com ponent cal led Select ed Brief P rogress No tes that d isplays sp ecific tit les and no  content f or more ef ficient re view.
  223   NSR2017120 7 Reports  Tab Displa y Appointm ent Room N umber
  224   BUSINESS E PIC 962580 : For Prov iders and  Support St aff who ro utinely re ceive phon e calls or  inquiries  from pati ents walki ng in seek ing help i n identify ing the lo cation of  a clinic o r service,  a modific ation to t he Future  Clinic Vis it Compone nt of the  Health Sum mary that  displays t he current  clinic lo cations/se rvices inc luding phy sical loca tion/room  number for  all clini c visits b eginning w ith the cu rrent day.  Unlike th e current  state wher e the Futu re Clinic  Visit Comp onent only  displays  the Clinic  Name for  future vis its and no t the clin ic’s room  number and  also does  not displ ay the cli nic inform ation once  the visit  becomes a  “past” vi sit e.g. i f the pati ent is a f ew minutes  late for  the appoin tment, our  process a llows effi cient acce ss to the  informatio n that is  necessary  to direct  a patient  who calls  or walks i nto the fa cility ask ing for na vigation a ssistance  around the  facility.
  225   NSR2018030 6 Future C linic Visi ts Display s RECALL A ppointment  Requests
  226   BUSINESS E PIC 712867 : For non- scheduling  staff who  coordinat e future a ppointment  needs, a  modificati on to the  Health Sum mary Packa ge that di splays fut ure RECALL  entries f rom the RE CALL REMIN DERS file  (#403.5) o n the Repo rts Tab, F uture Clin ic Visits  health sum mary. Unli ke the cur rent funct ionality w here Appoi ntment Lis ts that ar e printed  with Healt h Summary  options, o r pulled i nto progre ss notes b y Health S ummary obj ects, do n ot include  Future Re call entri es, making  the lists  given to  patients i ncomplete,  our proce ss support s provider s who do n ot have ac cess to th e scheduli ng softwar e to plan  and place  future tes ts and vis it orders.
  227   NSR2018010 9 Display  Users Titl e on Inter disciplina ry Records
  228   BUSINESS E PIC 973078 : For Clin ical Staff  who need  to determi ne who rev iewed an e ducation t opic with  a patient,  an abilit y to view  the name a nd title o f the last  person to  edit an e ducation t opic that  allows the  clinician  to gain a  sense of  the qualif ications o f the educ ator. Unli ke the cur rent syste m that doe s not iden tify who t he educato r was nor  identify t heir role  in the pat ient’s car e, our pro cess allow s the name  and title  of the ed ucator to  be visible  so the cl inical sta ff knows t he qualifi cations of  the educa tor for a  particular  topic or  know which  departmen t to conta ct for que stions con cerning th e care of  the patien t.
  229   Points of  Contact
  230   The VA POC  for NSR20 171204 Dis play Provi der and At tending Pr ovider on  MAS Admiss ion-Discha rge Compon ents is Be n Davoren  (
  HYPERLINK  "PII                          " PII                   ) .
  231   The VA POC  for NSR20 171206 Pro gress Note  Title Com ponent is  Ben Davore n (  HYPERLINK  "PII                          " PII                   ), 415-221 -4810.
  232   The VA POC  for NSR20 171207 Rep orts Tab D isplay App ointment R oom Number , NSR20180 306 Future  Clinic Vi sits Displ ays RECALL  Appointme nt Request s, and NSR 20180109 D isplay Use rs Title o n Interdis ciplinary  Records is  Jeffrey T ueting (
  HYPERLINK  "PII                              " PII                       ) .
  233   Code Remed iation
  234   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.
  235   Standards  and Conven tions
  236   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).
  237   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.
  238   Review and  Analysis
  239   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. 
  240   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. 
  241   Coding Cha nges
  242   The coding  changes r equired fo r NSR20171 204 Displa y Provider  and Atten ding Provi der on MAS  Admission -Discharge  Component s are in t he followi ng routine s: 
  243   Modified M UMPS routi nes: GMTSD GA1
  244   New MUMPS  routines:  GMTSDGA3
  245   The coding  changes r equired fo r NSR20171 206 Progre ss Note Ti tle Compon ent are in  the follo wing routi nes: 
  246   Modified M UMPS routi nes: GMTSP N, GMTSPN1
  247   New MUMPS  routines:  GMTSPNST,  GMTSP124
  248   The coding  changes r equired fo r NSR20171 207 Report s Tab Disp lay Appoin tment Room  Number ar e in the f ollowing r outines: 
  249   Modified M UMPS routi nes: GMTSD A
  250   New MUMPS  routines:  None
  251   The coding  changes r equired fo r NSR20180 306 Future  Clinic Vi sits Displ ays RECALL  Appointme nt Request s are in t he followi ng routine s: 
  252   Modified M UMPS routi nes: GMTSD A
  253   New MUMPS  routines:  None
  254   The coding  changes r equired fo r NSR20180 109 Displa y Users Ti tle on Int erdiscipli nary Recor ds are in  the follow ing routin es: 
  255   Modified M UMPS routi nes: GMTSP XEP
  256   New MUMPS  routines:  None
  257   Testing
  258   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.
  259   Test Plan
  260   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.
  261   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.
  262   Test Envir onment
  263   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 or ho st file. T he environ ment will  be restore d to its o riginal ba seline sta te by the  VistA syst em adminis trator aft er develop ment testi ng is comp leted, fol lowed by i nstallatio n of the r emediated  software.
  264   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 (QM) “ EPIP” Proj ect. In or der to per form testi ng of this  VistA mod ification,  the follo wing tools  will be l everaged:  Rational Q M, Reflect ions emula tor, CPRS  GUI v31A ( 1.0.31.116 ), and Sna gIt.
  265   Test Readi ness Revie w
  266   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 ).
  267   Testing Ph ases
  268   Leidos wil l perform  developmen t and SQA  testing ac tivities i n phases,  and will p rovide all  required  testing do cumentatio n.
  269   Unit Testi ng
  270   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. 
  271   Component  Integratio n and Syst ems Testin g (CI/ST)
  272   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.
  273   Functional  Testing
  274   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. 
  275   Regression  Testing
  276   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.  
  277   Section 50 8 Complian ce Testing
  278   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.
  279   Documentat ion Remedi ation
  280   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.
  281   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  https://w ww. 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.
  282   The follow ing sectio ns outline  the VDL d ocuments t o be revis ed for thi s remediat ion.
  283   User Guide s
  284   The follow ing User G uide will  be updated  in the VD L:
  285   Health Sum mary User  Manual
  286   Installati on Guides
  287   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 the  KIDS build  or host f ile into t he VA Pre- Production  environme nts. There fore, no I nstallatio n Guides w ill be upd ated.
  288   Technical  Manuals
  289   The follow ing Techni cal Manual  will be u pdated in  the VDL:
  290   Health Sum mary Techn ical Manua l
  291   Operations  Manuals
  292   No Operati ons Manual s require  revision a s a result  of this m odificatio n.
  293   Project Re porting
  294   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. 
  295   Project Sc hedule
  296   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.  
  297   Deployment
  298   Leidos wil l create a  KIDS buil d or host  file conta ining the  software c hanges nec essary to  fulfill th e requirem ents for t his remedi ation effo rt. The ne w build or  host file , along wi th all rel ated docum entation,  will be de livered to  the Contr acting Off ice Repres entative ( COR) for a cceptance.  If accept ed, these  deliverabl es can the n be relea sed for na tional VA  consumptio n; otherwi se, Leidos  will corr ect any de fects foun d and repe at the nec essary rem ediation a ctivities.
  299   Sustainmen t Requirem ents
  300   Leidos wil l provide  maintenanc e support  for 90 day s to the V A to suppo rt the fin al Class 1  product a fter it is  nationall y released
  301   Maintenanc e and Know ledge Tran sfer
  302   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.
  303   XINDEX Lis ting for M UMPS Code  Changes
  304   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.
  305                            V. A.   C R O S S   R E F E R  E N C E R   7.3
  306                            [2008 V A Standard s & Conven tions]
  307                      UC I: VISTA C PU: ROU     Jan 18, 2 019@16:04: 27
  308   All Routin es? No =>  No
  309   Routine: 
  310   0 routines
  311   Select BUI LD NAME: G MTS*2.7*12 4       HE ALTH SUMMA RY
  312   Include th e compiled  template  routines:  N//
  313   Print more  than comp iled error s and warn ings? YES/ /
  314   Print summ ary only?  NO//
  315   Print rout ines? YES/ /N
  316   Print the  DDs, Funct ions, and  Options? Y ES//
  317   Print erro rs and war nings with  each rout ine? YES//
  318   Save param eters in R OUTINE fil e? NO//
  319   Index all  called rou tines? NO/ /
  320   DEVICE:    HOME  (CRT )    Right  Margin: 8 0// 
  321                       V . A.  C R  O S S  R E  F E R E N  C E R  7. 3
  322                            [2008 V A Standard s & Conven tions]
  323                      UC I: VISTA C PU: ROU     Jan 18, 2 019@16:04: 27
  324   The BUILD  file Data  Dictionari es are bei ng process ed.
  325   The option  and funct ion files  are being  processed.
  326   Routines a re being p rocessed.
  327   Routines:  8  Faux Ro utines: 1
  328   GMTSDA     GMTSDGA1   GMTSDGA3   GMTSP124   GMTSPN     GMTSPN1    GMTSPNST   GMTSPXEP  
  329              Data Dicti onaries
  330   |opt            
  331   --- CROSS  REFERENCIN G ---
  332      Press r eturn to c ontinue:
  333   Compiled l ist of Err ors and Wa rnings                Jan 18, 20 19@16:04:2 7 page 1
  334   GMTSDA   *  *  67 Lin es,  3501  Bytes, Che cksum: B12 058652
  335      PAST+16       F -  Reference  to routine  '^A7RHSM' . That isn 't in this  UCI.
  336   --- Routin e Detail - --
  337   *****   ER RORS & WAR NINGS IN G MTSDA   ** ***
  338      PAST+16       F -  Reference  to routine  '^A7RHSM' . That isn 't in this  UCI.
  339   --- END -- -
  340   Source Cod e Changes
  341   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:
  342   Modified M UMPS routi nes: GMTSD GA1, GMTSP N, GMTSPN1 , GMTSDA,  GMTSPXEP
  343   New MUMPS  routines:  GMTSDGA3,  GMTSPNST,  GMTSP124
  344   Key:
  345   Removed
  346   Added/Chan ged
  347   GMTSDGA1
  348   Before:
  349   GMTSDGA1 ;  SLC/MKB,K ER - Admis sions (con t) ; 02/27 /2002 
  350   ;;2.7;Heal th Summary ;**28,49** ;Oct 20, 1 995 
  351   ;  
  352   ; External  Reference
  353   ; DBIA 17  ^DGPM( 
  354   ; DBIA 137 2 ^DGPT( 
  355   ; DBIA 100 15 EN^DIQ1  (file 45)  
  356   ; DBIA 314 5 ^DIC(42. 4, 
  357   ; DBIA 314 7 ^DIC(45. 7, 
  358   ;  
  359   TROUT ; Tr ansfers Ou tput 
  360   S X=ADATE  D MTIM^GMT SU S TI=X, ADT=ADT_"  "_TI 
  361   D CKP^GMTS UP Q:$D(GM TSQIT) W A DT,?21,$P( VAIP(4),U, 2),$S($P(V AIP(4),U,2 )'["TO":"  TO ",1:" " ),$P(VAIP( 5),U,2),! 
  362   S TRFAC=$P (^DGPM(ADA ,0),U,5) I  $L(TRFAC)  D CKP^GMT SUP Q:$D(G MTSQIT) W  ?24,TRFAC, ! K TRFAC 
  363  
  364   DCOUT ; Di scharges O utput 
  365   N BDSC,OPT R,DSPL D C KP^GMTSUP  Q:$D(GMTSQ IT) I VAIP (17)="" S  GMC=-1 Q 
  366   I VAIP(17, 1)'="" S X =+VAIP(17, 1) D REGDT 4^GMTSU W  " Date of  Discharge:  ",X,! 
  367   I (+$P($G( ICD),U,10) >0),($G(IC D(ADM,2,80 ,+$P(ICD,U ,10),3))]" ") D CKP^G MTSUP Q:$D (GMTSQIT)  W ?16,"DXL S: ",ICD(A DM,2,80,+$ P(ICD,U,10 ),3),! 
  368   S PTFLG=$S (PTF="":0, '$D(^DGPT( +PTF,70)): 0,1:1),PTF 70=$S(PTFL G:^DGPT(+P TF,70),1:" ") D BDO 
  369   D CKP^GMTS UP Q:$D(GM TSQIT) W ? 10,"Bedsec tion: ",BD SC,! 
  370   I $G(VAIP( 17,3))'=""  D CKP^GMT SUP Q:$D(G MTSQIT) W  " Disposit ion Type:  ",$P(VAIP( 17,3),U,2) ,! 
  371   D CKP^GMTS UP Q:$D(GM TSQIT) W "  Dispositi on Place:  ",DSPL,! 
  372   D CKP^GMTS UP Q:$D(GM TSQIT) W " Outpatient  Treatment : ",OPTR,!  
  373   I 'GMTSNPG  D CKP^GMT SUP Q:$D(G MTSQIT) W 
  374  
  375   BDO ; Beds ection/Dis position/O utpatient  Treatment 
  376   N DIC,DA,D R,DIQ,PTFA  S PTF=+($ G(PTF)),DI C=45,DA=+P TF,DR="71; 73;75;",DI Q="PTFA("  D EN^DIQ1 
  377   S BDSC=$S( $G(PTFA(45 ,+DA,71))] "":$G(PTFA (45,+DA,71 )),1:"UNKN OWN") 
  378   S OPTR=$S( $G(PTFA(45 ,+DA,73))] "":$G(PTFA (45,+DA,73 )),1:"UNKN OWN") 
  379   S DSPL=$S( $G(PTFA(45 ,+DA,75))] "":$G(PTFA (45,+DA,75 )),1:"UNKN OWN") 
  380  
  381   DXOUT ; PT F Discharg e Diagnosi s Output 
  382   I FLAG>1,' GMTSNPG D  CKP^GMTSUP  Q:$D(GMTS QIT) W ! 
  383   D CKP^GMTS UP Q:$D(GM TSQIT) 
  384   S FLAG=2 
  385   S X=+$G(VA IP(13,1))  D REGDT4^G MTSU S DDT =X 
  386   W DDT," -  ",ADT,?57, "LOS: ",LO S,! 
  387   S NODIAG=1 ,GMI=0 
  388   F S GMI=$O (ICD(ADM,G MI)) Q:'GM I D CKP^GM TSUP Q:$D( GMTSQIT) S  GMX="" F  S GMX=$O(I CD(ADM,GMI ,80,GMX))  Q:'GMX D N XT 
  389   I NODIAG D  CKP^GMTSU P Q:$D(GMT SQIT) W "N o discharg e diagnosi s availabl e for this  admission .",! K NOD IAG 
  390  
  391   ADOUT ; Ad missions O utput 
  392   I FLAG>1,' GMTSNPG D  CKP^GMTSUP  Q:$D(GMTS QIT) W ! 
  393   D CKP^GMTS UP Q:$D(GM TSQIT) 
  394   S FLAG=2 
  395   I $G(VAIP( 17,1))=""  S DDT="Pre sent" 
  396   E S X=$P(V AIP(17,1), U,1) D REG DT4^GMTSU  S DDT=X 
  397   W ADT," -  ",DDT I VA IP(17,1)=" " W ?25,GM TSWARD," " ,GMTSRB 
  398   W ?56,"LOS : ",LOS,! 
  399   S TS=$P($G (^DIC(45.7 ,+$P($G(VA IP(14,6)), U),0)),U,2 ) S SPEC=$ P($G(^DIC( 42.4,+TS,0 )),U) 
  400   D CKP^GMTS UP Q:$D(GM TSQIT) W "  Last Tr S pecialty:  ",$E(SPEC, 1,25),?50, "Last Prov : ",$E($P( $G(VAIP(14 ,5)),U,2), 1,15),! 
  401   I $G(VAIP( 17,1))=""  D CKP^GMTS UP Q:$D(GM TSQIT) W " Admitting  Diagnosis:  ",$G(VAIP (13,7)),! 
  402   I PTF'="", $D(^DGPT(+ PTF,70)) D  CKP^GMTSU P Q:$D(GMT SQIT) W "  Bedsection : ",$S(+($ P(^DGPT(PT F,70),U,2) )>0:$P($G( ^DIC(42.4, +$P(^DGPT( PTF,70),U, 2),0)),U), 1:""),! 
  403   Q:'$D(ICD)  S GMI=0 F  S GMI=$O( ICD(ADM,GM I)) Q:'GMI  D CKP^GMT SUP Q:$D(G MTSQIT) S  GMX="" F S  GMX=$O(IC D(ADM,GMI, 80,GMX)) Q :'GMX D NX
  404  
  405   NXT ; Next  Diagnosis  
  406   S (GMTO,GM TNO)="" S  GMTO=$G(IC D(ADM,GMI, 80,GMX,3)) ,GMTNO=$G( ICD(ADM,GM I,80,GMX,. 01)) 
  407   W:GMI=1 "P rincipal D iagnosis:  " W:GMI=2  ?15,"DXLS:  " 
  408   W:GMI=3 ?1 3,"ICD DX:  " W ?21,G MTO,?62,GM TNO,! 
  409   S NODIAG=0  
  410  
  411   After:
  412   GMTSDGA1 *  *  64 LIN ES,  (tota l 3417, co mments 556 ) BYTES    Page 1
  413           RS UM: old 70 79333, new  13104392
  414             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  NOV 6,2018 @12:54
  415   GMTSDGA1 - -
  416           ;S LC/MKB,KER  - Admissi ons (cont)  ; 10/8/18  3:51pm
  417          ;;2 .7;Health  Summary;** 28,49,124* *;Oct 20,  1995
  418          ;                      
  419          ; E xternal Re ferences
  420          ;    DBIA    1 7  ^DGPM(
  421          ;    DBIA  137 2  ^DGPT(
  422          ;    DBIA 1001 5  EN^DIQ1  (file 45)
  423          ;    DBIA  314 5  ^DIC(42 .4,
  424          ;    DBIA  314 7  ^DIC(45 .7,
  425          ;                      
  426   TROUT  ; T ransfers O utput
  427          S X =ADATE D M TIM^GMTSU  S TI=X,ADT =ADT_" "_T I
  428          D C KP^GMTSUP  Q:$D(GMTSQ IT)  W ADT ,?21,$P(VA IP(4),U,2) ,$S($P(VAI P(4),U,2)' ["TO":" TO  ",1:" "), $P(VAIP(5) ,U,2),!
  429          S T RFAC=$P(^D GPM(ADA,0) ,U,5) I $L (TRFAC) D  CKP^GMTSUP  Q:$D(GMTS QIT)  W ?2 4,TRFAC,!  K TRFAC
  430          Q
  431   DCOUT  ; D ischarges  Output
  432          N B DSC,OPTR,D SPL D CKP^ GMTSUP Q:$ D(GMTSQIT)   I VAIP(1 7)="" S GM C=-1 Q
  433          I V AIP(17,1)' ="" S X=+V AIP(17,1)  D REGDT4^G MTSU W "    Date of D ischarge:  ",X,!
  434          I ( +$P($G(ICD ),U,10)>0) ,($G(ICD(A DM,2,80,+$ P(ICD,U,10 ),3))]"")  D CKP^GMTS UP Q:$D(GM TSQIT)  W  ?16,"DXLS:  ",ICD(ADM ,2,8
  435           0, +$P(ICD,U, 10),3),!
  436          S P TFLG=$S(PT F="":0,'$D (^DGPT(+PT F,70)):0,1 :1),PTF70= $S(PTFLG:^ DGPT(+PTF, 70),1:"")  D BDO
  437          D C KP^GMTSUP  Q:$D(GMTSQ IT)  W ?10 ,"Bedsecti on: ",BDSC ,!
  438          I $ G(VAIP(17, 3))'="" D  CKP^GMTSUP  Q:$D(GMTS QIT)  W "     Disposi tion Type:  ",$P(VAIP (17,3),U,2 ),!
  439          D C KP^GMTSUP  Q:$D(GMTSQ IT)  W "    Dispositi on Place:  ",DSPL,!
  440          D C KP^GMTSUP  Q:$D(GMTSQ IT)  W "Ou tpatient T reatment:  ",OPTR,!
  441          I ' GMTSNPG D  CKP^GMTSUP  Q:$D(GMTS QIT)  W !
  442          Q
  443   BDO    ; B edsection/ Dispositio n/Outpatie nt Treatme nt
  444          N D IC,DA,DR,D IQ,PTFA S  PTF=+($G(P TF)),DIC=4 5,DA=+PTF, DR="71;73; 75;",DIQ=" PTFA(" D E N^DIQ1
  445          S B DSC=$S($G( PTFA(45,+D A,71))]"": $G(PTFA(45 ,+DA,71)), 1:"UNKNOWN ")
  446          S O PTR=$S($G( PTFA(45,+D A,73))]"": $G(PTFA(45 ,+DA,73)), 1:"UNKNOWN ")
  447          S D SPL=$S($G( PTFA(45,+D A,75))]"": $G(PTFA(45 ,+DA,75)), 1:"UNKNOWN ")
  448          Q
  449   DXOUT  ; P TF Dischar ge Diagnos is Output
  450          I F LAG>1,'GMT SNPG D CKP ^GMTSUP Q: $D(GMTSQIT )  W !
  451          D C KP^GMTSUP  Q:$D(GMTSQ IT)
  452          S F LAG=2
  453          S X =+$G(VAIP( 13,1)) D R EGDT4^GMTS U S DDT=X
  454          W D DT," - ",A DT,?57,"LO S: ",LOS,!
  455          S N ODIAG=1,GM I=0
  456          F   S GMI=$O(I CD(ADM,GMI )) Q:'GMI   D CKP^GMT SUP Q:$D(G MTSQIT)  S  GMX="" F   S GMX=$O( ICD(ADM,GM I,80,GMX))  Q:'GMX  D  NXT
  457          I N ODIAG D CK P^GMTSUP Q :$D(GMTSQI T)  W "No  discharge  diagnosis  available  for this a dmission." ,! K NODIA G
  458          Q
  459   ADOUT  ; A dmissions  Output
  460          I F LAG>1,'GMT SNPG D CKP ^GMTSUP Q: $D(GMTSQIT )  W !
  461          D C KP^GMTSUP  Q:$D(GMTSQ IT)
  462          S F LAG=2
  463          I $ G(VAIP(17, 1))="" S D DT="Presen t"
  464          E   S X=$P(VAI P(17,1),U, 1) D REGDT 4^GMTSU S  DDT=X
  465          W A DT," - ",D DT I VAIP( 17,1)="" W  ?25,GMTSW ARD," ",GM TSRB
  466          W ? 56,"LOS: " ,LOS,!
  467          S T S=$P($G(^D IC(45.7,+$ P($G(VAIP( 14,6)),U), 0)),U,2) S  SPEC=$P($ G(^DIC(42. 4,+TS,0)), U)
  468          ; G MTS*2.7*12 4 - begin  changes pe r NSR20171 204
  469          ;D  CKP^GMTSUP  Q:$D(GMTS QIT)  W "   Last Tr S pecialty:  ",$E(SPEC, 1,25),?50, "Last Prov : ",$E($P( $G(VAIP(14 ,5)),U,2), 1,15
  470           ), !
  471          D A DOUT^GMTSD GA3 ; GMTS *2.7*124 -  end chang es per NSR 20171204
  472          I $ G(VAIP(17, 1))="" D C KP^GMTSUP  Q:$D(GMTSQ IT)  W "Ad mitting Di agnosis: " ,$G(VAIP(1 3,7)),!
  473          I P TF'="",$D( ^DGPT(+PTF ,70)) D CK P^GMTSUP Q :$D(GMTSQI T)  W "          Beds ection: ", $S(+($P(^D GPT(PTF,70 ),U,2))>0: $P($
  474           G( ^DIC(42.4, +$P(^DGPT( PTF,70),U, 2),0)),U), 1:""),!
  475          Q:' $D(ICD)  S  GMI=0 F   S GMI=$O(I CD(ADM,GMI )) Q:'GMI   D CKP^GMT SUP Q:$D(G MTSQIT)  S  GMX="" F   S GMX=$O( ICD(ADM,GM I,80
  476           ,G MX)) Q:'GM X  D NXT
  477          Q
  478   NXT    ; N ext Diagno sis
  479          S ( GMTO,GMTNO )="" S GMT O=$G(ICD(A DM,GMI,80, GMX,3)),GM TNO=$G(ICD (ADM,GMI,8 0,GMX,.01) )
  480          W:G MI=1 "Prin cipal Diag nosis: " W :GMI=2 ?15 ,"DXLS: "
  481          W:G MI=3 ?13," ICD DX: "  W ?21,GMTO ,?62,GMTNO ,!
  482          S N ODIAG=0
  483          Q
  484   ========== ========== ========== ========== ========== ========== ========
  485   GMTSPN
  486   Before:
  487   GMTSPN ; S LC/KER - P rogress No te ; 5/17/ 06 2:06pm 
  488   ;;2.7;Heal th Summary ;**12,28,3 3,35,45,47 ,49,55,81* *;Oct 20,  1995;Build  23 
  489   ;  
  490   ; External  Reference
  491   ; DBIA 290 2 VISIT^TI ULAPIC 
  492   ; DBIA 290 2 MAIN^TIU LAPIC 
  493   ; DBIA 100 06 ^DIC 
  494   ;  
  495   PN ; Progr ess Note H ealth Summ ary Compon ent 
  496   N TIUSTAT, TIUTYPE,TI UNAM,DIC,T IUFPRIV,TI UXREF,GMTS TIUC,X,Y,G MTSREF 
  497   S TIUFPRIV =1,TIUSTAT ="ALL",TIU XREF="""AP T""",GMTST IUC="P",(T IUNAM,X)=" PROGRESS N OTES" 
  498   S DIC="^TI U(8925.1," ,DIC(0)="X ",DIC("S") ="I $P($G( ^(0)),U,4) =""CL""" 
  499   D ^DIC K D IC("S") S: Y>0 TIUTYP E=+Y S GMT SREF="" D  MAIN K GMT SREF 
  500  
  501   MAIN ; Con trol branc hing 
  502   N ADATE,AD MIT,ASUB,A TDATE,ATTN DNG,ATTYPE ,ATYPE,AUT HOR,CHILD, CONEED 
  503   N COSAME,C OSGEDBY,CO SIG,CURIEN ,DISCHG,GM TSA,GMTSAI ,GMTSAII,G MTSCNT 
  504   N GMTSD,GM TSDIC,GMTS EXSG,GMTSI ,GMTSIEN,G MTSID,GMTS IDC,GMTSII ,GMTSIQ 
  505   N GMTSJ,GM TSK,GMTSOD IC,GMTSPDI C,GMTSTDIC ,GMTSPR,GM TSREC,GMTS T,GMTSX 
  506   N GMTSXTRA ,I,PARIEN, PDATE,PN,P SUB,PTYPE, REASON,SIG NEDBY,STAT US,TSPEC 
  507   N TYPE,X,Y  
  508   K ^TMP("TI U",$J) S G MTSX=1 D E XTIU Q:'$D (^TMP("TIU ",$J)) D P NOTE 
  509   K ^TMP("TI U",$J),PN 
  510   ;  
  511   ; Progress  Notes 
  512   ;  
  513   ; ^TMP("TI U",$J,IDT, 0) 
  514   ; ^TMP("TI U",$J,IDT, IEN,FLD,"E ") 
  515   ; ^TMP("TI U",$J,IDT, IEN,FLD,"I ") 
  516   ; ^TMP("TI U",$J,IDT, IEN,"TEXT" ,0) 
  517   ; ^TMP("TI U",$J,IDT, IEN,"TEXT" ,#,0) 
  518   ; ^TMP("TI U",$J,IDT, IEN,"ZADD" ,IEN,FLD," E") 
  519   ; ^TMP("TI U",$J,IDT, IEN,"ZADD" ,IEN,FLD," I") 
  520   ; ^TMP("TI U",$J,IDT, IEN,"ZADD" ,IEN,"TEXT ",0) 
  521   ; ^TMP("TI U",$J,IDT, IEN,"ZADD" ,IEN,"TEXT ",#,0) 
  522   ; ^TMP("TI U",$J,IDT, IEN,"ZZAD" ,0) 
  523   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,FLD ,"E") 
  524   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,FLD ,"I") 
  525   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,"TE XT",0) 
  526   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,"TE XT",#,0) 
  527   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,"ZA DD",IEN,FL D,"E") 
  528   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,"ZA DD",IEN,FL D,"I") 
  529   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,"ZA DD",IEN,"T EXT",0) 
  530   ; ^TMP("TI U",$J,IDT, IEN,"ZZID" ,#,IEN,"ZA DD",IEN,"T EXT",#,0) 
  531   ;  
  532   ; Selected  Progress  Notes 
  533   ;  
  534   ; ^TMP("TI U",$J,IDT, #,0) 
  535   ; ^TMP("TI U",$J,IDT, #,IEN,FLD, "E") 
  536   ; ^TMP("TI U",$J,IDT, #,IEN,FLD, "I") 
  537   ; ^TMP("TI U",$J,IDT, #,IEN,"TEX T",0) 
  538   ; ^TMP("TI U",$J,IDT, #,IEN,"TEX T",#,0) 
  539   ; ^TMP("TI U",$J,IDT, #,IEN,"ZAD D",IEN,FLD ,"E") 
  540   ; ^TMP("TI U",$J,IDT, #,IEN,"ZAD D",IEN,FLD ,"I") 
  541   ; ^TMP("TI U",$J,IDT, #,IEN,"ZAD D",IEN,"TE XT",0) 
  542   ; ^TMP("TI U",$J,IDT, #,IEN,"ZAD D",IEN,"TE XT",#,0) 
  543   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",0) 
  544   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN,F LD,"E") 
  545   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN,F LD,"I") 
  546   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN," TEXT",0) 
  547   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN," TEXT",#,0)  
  548   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN," ZADD",IEN, FLD,"E") 
  549   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN," ZADD",IEN, FLD,"I") 
  550   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN," ZADD",IEN, "TEXT",0) 
  551   ; ^TMP("TI U",$J,IDT, #,IEN,"ZZI D",#,IEN," ZADD",IEN, "TEXT",#,0
  552   ;  
  553   PNOTE ; Pr ogress Not es 
  554   D CKP^GMTS UP Q:$D(GM TSQIT) S G MTSD=0 F S  GMTSD=$O( ^TMP("TIU" ,$J,GMTSD) ) Q:+GMTSD =0 D 
  555   . S GMTSOD IC="^TMP(" "TIU"","_$ J_","_GMTS D_"," D NO TE 
  556   Q:$D(GMTSQ IT) D CKP^ GMTSUP Q:$ D(GMTSQIT)  W ! Q 
  557   SNOTE ; Se lected Pro gress Note
  558   D CKP^GMTS UP Q:$D(GM TSQIT) S G MTSD=0 F S  GMTSD=$O( ^TMP("TIU" ,$J,GMTSD) ) Q:+GMTSD =0 D 
  559   . N GMTSS  S GMTSS=0  F S GMTSS= $O(^TMP("T IU",$J,GMT SD,GMTSS))  Q:+GMTSS= 0 D 
  560   . . S GMTS ODIC="^TMP (""TIU""," _$J_","_GM TSD_","_GM TSS_"," D  NOTE 
  561   Q:$D(GMTSQ IT) D CKP^ GMTSUP Q:$ D(GMTSQIT)  W ! Q 
  562   ;  
  563   NOTE ; Pri mary Note 
  564   N GMTSTDIC ,GMTSI,GMT SXTRA S GM TSI=0 
  565   F S GMTSI= $O(@(GMTSO DIC_GMTSI_ ")")) Q:+G MTSI=0 D 
  566   . S (GMTST DIC,GMTSPD IC,GMTSDIC )=GMTSODIC ,(PARIEN,C URIEN)=GMT SI 
  567   . S CHILD= +($G(@(GMT SDIC_CURIE N_",""ZZID "",0)"))), TYPE="",GM TSID=0 
  568   . S:$D(@(G MTSDIC_CUR IEN_",""ZZ ID"")")) T YPE="Paren t Interdis ciplinary  Note",GMTS ID=1 
  569   . K PN S P N("#")=CUR IEN,PN("#" ,0)="NOTE"  
  570   . D FLDS(G MTSDIC,CUR IEN) D:$D( @(GMTSDIC_ CURIEN_"," "ZZID"")") ) ST^GMTSP N1("Begin  Interdisci plinary No te") 
  571   . D WARN1^ GMTSPN2 D: $E($G(GMTS TIUC),1)'[ "D" WH^GMT SPN1 
  572   . D:$G(GMT STIUC)="DC S" WDH^GMT SPN1 
  573   . D:GMTSCN T=1&($G(GM TSTIUC)="D SB") WDBH^ GMTSPN1 
  574   . I $G(GMT STIUC)="DS B" D WDB^G MTSPN1(GMT SDIC,CURIE N) Q 
  575   . D:$D(@(G MTSDIC_CUR IEN_",""PR OBLEM"")") ) WP^GMTSP N1(GMTSDIC ,CURIEN) 
  576   . D WT^GMT SPN1(GMTSD IC,CURIEN) ,WS^GMTSPN 2(GMTSDIC, CURIEN),WA RN2^GMTSPN
  577   . D:+($G(P N("AMENDMN T")))>0 AM ^GMTSPN1(G MTSDIC,CUR IEN) 
  578   . D BL^GMT SPN2 N GMT SODIC S GM TSODIC=GMT STDIC_CURI EN_"," D A NOTE,INOTE  
  579   . I GMTSID  D ST^GMTS PN1("End I nterdiscip linary Not e") S GMTS ID=0 
  580  
  581   .
  582   .
  583   .
  584   After:
  585   GMTSPN * *   193 LINE S,  (total  9750, com ments 2290 ) BYTES    Page 1
  586           RS UM: old 14 562680, ne w 66357011
  587             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  NOV 6,2018 @12:52
  588   GMTSPN ;SL C/KER - Pr ogress Not e ; 10/8/1 8 3:28pm
  589          ;;2 .7;Health  Summary;** 12,28,33,3 5,45,47,49 ,55,81,124 **;Oct 20,  1995;Buil d 23
  590          ;                             
  591          ; E xternal Re ferences
  592          ;     DBIA  29 02  VISIT^ TIULAPIC
  593          ;     DBIA  29 02  MAIN^T IULAPIC
  594          ;     DBIA 100 06  ^DIC
  595          ;                           
  596   PN     ; P rogress No te Health  Summary Co mponent
  597          N T IUSTAT,TIU TYPE,TIUNA M,DIC,TIUF PRIV,TIUXR EF,GMTSTIU C,X,Y,GMTS REF
  598          S T IUFPRIV=1, TIUSTAT="A LL",TIUXRE F="""APT"" ",GMTSTIUC ="P",(TIUN AM,X)="PRO GRESS NOTE S"
  599          S D IC="^TIU(8 925.1,",DI C(0)="X",D IC("S")="I  $P($G(^(0 )),U,4)="" CL"""
  600          D ^ DIC K DIC( "S") S:Y>0  TIUTYPE=+ Y S GMTSRE F="" D MAI N K GMTSRE F
  601          Q
  602   MAIN   ; C ontrol bra nching
  603          N A DATE,ADMIT ,ASUB,ATDA TE,ATTNDNG ,ATTYPE,AT YPE,AUTHOR ,CHILD,CON EED
  604          N C OSAME,COSG EDBY,COSIG ,CURIEN,DI SCHG,GMTSA ,GMTSAI,GM TSAII,GMTS CNT
  605          N G MTSD,GMTSD IC,GMTSEXS G,GMTSI,GM TSIEN,GMTS ID,GMTSIDC ,GMTSII,GM TSIQ
  606          N G MTSJ,GMTSK ,GMTSODIC, GMTSPDIC,G MTSTDIC,GM TSPR,GMTSR EC,GMTST,G MTSX
  607          N G MTSXTRA,I, PARIEN,PDA TE,PN,PSUB ,PTYPE,REA SON,SIGNED BY,STATUS, TSPEC
  608          N T YPE,X,Y
  609          K ^ TMP("TIU", $J) S GMTS X=1 D EXTI U Q:'$D(^T MP("TIU",$ J))  D PNO TE
  610          K ^ TMP("TIU", $J),PN Q
  611          ;                        
  612          ; P rogress No tes
  613          ; 
  614          ; ^ TMP("TIU", $J,IDT,0)
  615          ; ^ TMP("TIU", $J,IDT,IEN ,FLD,"E")
  616          ; ^ TMP("TIU", $J,IDT,IEN ,FLD,"I")
  617          ; ^ TMP("TIU", $J,IDT,IEN ,"TEXT",0)
  618          ; ^ TMP("TIU", $J,IDT,IEN ,"TEXT",#, 0)
  619          ; ^ TMP("TIU", $J,IDT,IEN ,"ZADD",IE N,FLD,"E")
  620          ; ^ TMP("TIU", $J,IDT,IEN ,"ZADD",IE N,FLD,"I")
  621          ; ^ TMP("TIU", $J,IDT,IEN ,"ZADD",IE N,"TEXT",0 )
  622          ; ^ TMP("TIU", $J,IDT,IEN ,"ZADD",IE N,"TEXT",# ,0)
  623          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZAD",0)
  624          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,FLD,"E ")
  625          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,FLD,"I ")
  626          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,"TEXT" ,0)
  627          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,"TEXT" ,#,0)
  628          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,"ZADD" ,IEN,FLD," E")
  629          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,"ZADD" ,IEN,FLD," I")
  630          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,"ZADD" ,IEN,"TEXT ",0)
  631          ; ^ TMP("TIU", $J,IDT,IEN ,"ZZID",#, IEN,"ZADD" ,IEN,"TEXT ",#,0)
  632          ; 
  633          ; S elected Pr ogress Not es
  634          ; 
  635          ; ^ TMP("TIU", $J,IDT,#,0 )
  636          ; ^ TMP("TIU", $J,IDT,#,I EN,FLD,"E" )
  637          ; ^ TMP("TIU", $J,IDT,#,I EN,FLD,"I" )
  638          ; ^ TMP("TIU", $J,IDT,#,I EN,"TEXT", 0)
  639          ; ^ TMP("TIU", $J,IDT,#,I EN,"TEXT", #,0)
  640          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZADD", IEN,FLD,"E ")
  641          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZADD", IEN,FLD,"I ")
  642          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZADD", IEN,"TEXT" ,0)
  643          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZADD", IEN,"TEXT" ,#,0)
  644          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", 0)
  645          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,FLD, "E")
  646          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,FLD, "I")
  647          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,"TEX T",0)
  648          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,"TEX T",#,0)
  649          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,"ZAD D",IEN,FLD ,"E")
  650          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,"ZAD D",IEN,FLD ,"I")
  651          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,"ZAD D",IEN,"TE XT",0)
  652          ; ^ TMP("TIU", $J,IDT,#,I EN,"ZZID", #,IEN,"ZAD D",IEN,"TE XT",#,0)
  653          ;                              
  654   PNOTE  ; P rogress No tes
  655          D C KP^GMTSUP  Q:$D(GMTSQ IT)  S GMT SD=0 F  S  GMTSD=$O(^ TMP("TIU", $J,GMTSD))  Q:+GMTSD= 0  D
  656          . S  GMTSODIC= "^TMP(""TI U"","_$J_" ,"_GMTSD_" ," D NOTE
  657          Q:$ D(GMTSQIT)   D CKP^GM TSUP Q:$D( GMTSQIT)   W ! Q
  658   SNOTE  ; S elected Pr ogress Not es
  659          D C KP^GMTSUP  Q:$D(GMTSQ IT)  S GMT SD=0 F  S  GMTSD=$O(^ TMP("TIU", $J,GMTSD))  Q:+GMTSD= 0  D
  660          . N  GMTSS S G MTSS=0 F   S GMTSS=$O (^TMP("TIU ",$J,GMTSD ,GMTSS)) Q :+GMTSS=0   D
  661          . .  S GMTSODI C="^TMP("" TIU"","_$J _","_GMTSD _","_GMTSS _"," D NOT E
  662          Q:$ D(GMTSQIT)   D CKP^GM TSUP Q:$D( GMTSQIT)   W ! Q
  663          ;                  
  664   NOTE   ;    Primary N ote
  665          N G MTSTDIC,GM TSI,GMTSXT RA S GMTSI =0
  666          F   S GMTSI=$O (@(GMTSODI C_GMTSI_") ")) Q:+GMT SI=0  D
  667          . S  (GMTSTDIC ,GMTSPDIC, GMTSDIC)=G MTSODIC,(P ARIEN,CURI EN)=GMTSI
  668          . S  CHILD=+($ G(@(GMTSDI C_CURIEN_" ,""ZZID"", 0)"))),TYP E="",GMTSI D=0
  669          . S :$D(@(GMTS DIC_CURIEN _",""ZZID" ")")) TYPE ="Parent I nterdiscip linary Not e",GMTSID= 1
  670          . K  PN S PN(" #")=CURIEN ,PN("#",0) ="NOTE"
  671          . D  FLDS(GMTS DIC,CURIEN ) D:$D(@(G MTSDIC_CUR IEN_",""ZZ ID"")")) S T^GMTSPN1( "Begin Int erdiscipli nary Note" )
  672          . D  WARN1^GMT SPN2 D:$E( $G(GMTSTIU C),1)'["D"  WH^GMTSPN 1
  673          . D :$G(GMTSTI UC)="DCS"  WDH^GMTSPN 1
  674          . D :GMTSCNT=1 &($G(GMTST IUC)="DSB" ) WDBH^GMT SPN1
  675          . ;  GMTS*2.7* 124 - begi n changes  for NSR201 71206 (Pro gress Note  Title Com ponent)
  676          . I  $G(GMTSPN ST)="TITLE " Q  ; GMT S*2.7*124  - end of c hanges
  677          . I  $G(GMTSTI UC)="DSB"  D WDB^GMTS PN1(GMTSDI C,CURIEN)  Q
  678          . D :$D(@(GMTS DIC_CURIEN _",""PROBL EM"")")) W P^GMTSPN1( GMTSDIC,CU RIEN)
  679          . D  WT^GMTSPN 1(GMTSDIC, CURIEN),WS ^GMTSPN2(G MTSDIC,CUR IEN),WARN2 ^GMTSPN2
  680          . D :+($G(PN(" AMENDMNT") ))>0 AM^GM TSPN1(GMTS DIC,CURIEN )
  681          . D  BL^GMTSPN 2 N GMTSOD IC S GMTSO DIC=GMTSTD IC_CURIEN_ "," D ANOT E,INOTE
  682          . I  GMTSID D  ST^GMTSPN1 ("End Inte rdisciplin ary Note")  S GMTSID= 0
  683          Q
  684   .
  685   .
  686   .
  687   ========== ========== ========== ========== ========== ========== ========
  688   GMTSPN1
  689   Before:
  690   GMTSPN1 ;  SLC/KER -  Progress N ote Header /Sig/Text/ Prob ; 5/1 7/06 2:03p
  691   ;;2.7;Heal th Summary ;**12,35,4 5,49,81**; Oct 20, 19 95;Build 2
  692  
  693   ;  
  694   ; External  Reference
  695   ; DBIA 101 04 call $$ UP^XLFSTR 
  696   ;  
  697   ; Write He aders 
  698   WH ; Note  Header 
  699   Q:$D(GMTSQ IT) I GMTS CNT>1 D CK P^GMTSUP Q :$D(GMTSQI T) W ! 
  700   W $G(PN("D ATE")),?18 ,"Local Ti tle: ",$$U P^XLFSTR($ G(PN("DOCT YPE"))),! 
  701   I $D(PN("V HATYPE"))  D CKP^GMTS UP Q:$D(GM TSQIT) W ? 15,"Standa rd Title:  ",PN("VHAT YPE"),! 
  702   S (ADATE,P DATE)=$G(P N("DATE")) ,(ATYPE,PT YPE)=$G(PN ("DOCTYPE" )),(ASUB,P SUB)=$G(PN ("SUBJ")) 
  703   ;SFVAMC/AP C 8/30/01  Title only . QI. next  line 
  704   I $G(ARHPN SL)="TITLE " Q 
  705   I $D(PN("A UTH")) D C KP^GMTSUP  Q:$D(GMTSQ IT) W ?20, PN("AUTH") ,! 
  706   I PN("SUBJ ")'="" D C KP^GMTSUP  Q:$D(GMTSQ IT) W ?19, "Subject:  ",PN("SUBJ "),! 
  707  
  708   .
  709   .
  710   .
  711   After:
  712   GMTSPN1 *  *  106 LIN ES,  (tota l 6500, co mments 578 ) BYTES    Page 1
  713           RS UM: old 14 234907, ne w 34258632
  714             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  NOV 6,2018 @12:49
  715   GMTSPN1 ;S LC/KER - P rogress No te Header/ Sig/Text/P rob ; 10/8 /18 3:31pm
  716          ;;2 .7;Health  Summary;** 12,35,45,4 9,81,124** ;Oct 20, 1 995;Build  23
  717          Q
  718          ;                             
  719          ; E xternal Re ferences
  720          ;     DBIA 101 04 call $$ UP^XLFSTR
  721          ;                       
  722          ; W rite Heade rs
  723   WH     ;    Note Head er
  724          Q:$ D(GMTSQIT)   I GMTSCN T>1 D CKP^ GMTSUP Q:$ D(GMTSQIT)   W !
  725          W $ G(PN("DATE ")),?18,"L ocal Title : ",$$UP^X LFSTR($G(P N("DOCTYPE "))),!
  726          I $ D(PN("VHAT YPE")) D C KP^GMTSUP  Q:$D(GMTSQ IT)  W ?15 ,"Standard  Title: ", PN("VHATYP E"),!
  727          S ( ADATE,PDAT E)=$G(PN(" DATE")),(A TYPE,PTYPE )=$G(PN("D OCTYPE")), (ASUB,PSUB )=$G(PN("S UBJ"))
  728          ; G MTS*2.7*12 4 - begin  changes fo r NSR20171 206 (Progr ess Note T itle Compo nent)
  729          I $ G(GMTSPNST )="TITLE"  Q  ; GMTS* 2.7*124 -  end of cha nges
  730          I $ D(PN("AUTH ")) D CKP^ GMTSUP Q:$ D(GMTSQIT)   W ?20,PN ("AUTH"),!
  731          I P N("SUBJ")' ="" D CKP^ GMTSUP Q:$ D(GMTSQIT)   W ?19,"S ubject:  " ,PN("SUBJ" ),!
  732          Q
  733   .
  734   .
  735   .
  736   ========== ========== ========== ========== ========== ========== ========
  737   GMTSDA
  738   Before:
  739   GMTSDA ; S LC/DLT,KER /NDBI - Ap pointments  ; 5/21/07  11:12am 
  740   ;;2.7;Heal th Summary ;**5,19,28 ,49,70,80* *;Oct 20,  1995;Build  9 
  741   ;  
  742   ; External  Reference  
  743   ; DBIA 102 4 ^DIC(40.
  744   ; DBIA 100 40 ^SC( 
  745   ; DBIA 206 5 ^SCE( 
  746   ; DBIA 206 5 ^SCE("AD FN" 
  747   ; DBIA 292 9 CVP^A7RH SM 
  748   ; DBIA 100 61 SDA^VAD PT 
  749   ;  
  750   PAST ; Get s Patient' s Past App ointments  for date r ange 
  751   N GMDT,GMI DT,MAX S X =1 
  752   S VASD("F" )=$S(GMTSB EG=1:25601 01,1:GMTSB EG),VASD(" T")=$S(GMT S1=6666666 :DT,1:9999 999-GMTS1)  
  753   S MAX=$S(+ ($G(GMTSND M))>0:+($G (GMTSNDM)) ,1:99999) 
  754   S VASD("W" )=12345678 9 D SDA^VA DPT 
  755   I VAERR=1  D CKP^GMTS UP W "RSA  ERROR",! D  END Q 
  756   I VAERR=2  D CKP^GMTS UP W "DATA BASE NOT A VAILABLE", ! D END Q 
  757   S (YCNT,Y) =0 F S Y=$ O(^UTILITY ("VASD",$J ,Y)) Q:'Y  S YCNT=YCN T+1,ADATE= $P(^(Y,"I" ),U,1),^UT ILITY("GMT SVASD",$J, 9999999-AD ATE)=ADATE _U_$P(^UTI LITY("VASD ",$J,Y,"E" ),U,2,99) 
  758   S GMDT=VAS D("F") 
  759   F S GMDT=$ O(^SCE("AD FN",DFN,GM DT)) Q:GMD T'>0!(GMDT >VASD("T") ) D 
  760   . S GMI=0  F S GMI=$O (^SCE("ADF N",DFN,GMD T,GMI)) Q: GMI'>0 D 
  761   . . S GMID T=9999999- GMDT 
  762   . . I '$D( ^UTILITY(" GMTSVASD", $J,GMIDT))  D 
  763   . . . Q:$P ($G(^SCE(G MI,0)),U,6 )'="" 
  764   . . . I $P ($G(^SCE(G MI,0)),U,4 ) Q:$P($G( ^SC($P(^SC E(GMI,0),U ,4),"OOS") ),U) 
  765   . . . S ^U TILITY("GM TSVASD",$J ,GMIDT)=GM DT_U_$S(+$ P(^SCE(GMI ,0),U,4):$ P($G(^SC(+ $P(^(0),U, 4),0)),U), 1:$P($G(^D IC(40.7,$P (^SCE(GMI, 0),U,3),0) ),U))_U_"U NSCHEDULED
  766   D:$$ROK^GM TSU("A7RHS M")&($$NDB I^GMTSU) C VP^A7RHSM 
  767   I '$D(^UTI LITY("GMTS VASD",$J))  D END Q 
  768   S IDATE="" ,YCNT=0 
  769   F S IDATE= $O(^UTILIT Y("GMTSVAS D",$J,IDAT E)) Q:+IDA TE'>0!(YCN T=MAX) D 
  770   . S ADATE= +^(IDATE), ADATE(0)=^ (IDATE) D  PRINT S YC NT=YCNT+1 
  771   D END Q 
  772   FUTURE ; G ets Patien t's Future  Appointme nts  
  773   D SDA^VADP T N MAX S  MAX=$S(+($ G(GMTSNDM) )>0:+($G(G MTSNDM)),1 :99999) 
  774   I VAERR=2  D CKP^GMTS UP W "DATA BASE NOT A VAILABLE", ! D END Q 
  775   S (YCNT,Y) =0 F S Y=$ O(^UTILITY ("VASD",$J ,Y)) Q:'Y  S YCNT=YCN T+1,ADATE= $P(^(Y,"I" ),U,1),ADA TE(0)=^UTI LITY("VASD ",$J,Y,"E" ) D PRINT  Q:YCNT=MAX  
  776   D END Q 
  777   PRINT ; Ou tput 
  778   D CKP^GMTS UP Q:$D(GM TSQIT) S X =ADATE D R EGDTM4^GMT SU,CKP^GMT SUP 
  779   W X,?18,$E ($P(ADATE( 0),"^",2), 1,25),?58, $E($P(ADAT E(0),"^",3 ),1,21) 
  780   W ! Q 
  781   END ; Clea n-up and Q uit 
  782   K %I,IDATE ,IDATES,AD ATE,VASD,X ,Y,YCNT,Z, ^UTILITY(" VASD",$J), ^UTILITY(" GMTSVASD", $J) Q 
  783   After:
  784   GMTSDA * *   67 LINES ,  (total  3501, comm ents 919)  BYTES      Page 1
  785           RS UM: old 67 17788, new  12058652
  786             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  JAN 18,201 9@15:49
  787   GMTSDA ;SL C/DLT,KER/ NDBI - App ointments  ; 10/8/18  3:51pm
  788          ;;2 .7;Health  Summary;** 5,19,28,49 ,70,80,124 **;Oct 20,  1995;Buil d 9
  789          ;                 
  790          ; E xternal Re ference
  791          ;    DBIA  102 4  ^DIC(40 .7
  792          ;    DBIA 1004 0  ^SC(
  793          ;    DBIA  206 5  ^SCE(
  794          ;    DBIA  206 5  ^SCE("A DFN"
  795          ;    DBIA  292 9  CVP^A7R HSM
  796          ;    DBIA 1006 1  SDA^VAD PT
  797          ;    DBIA  519 5  COVER^S DRROR
  798          ;
  799   PAST   ; G ets Patien t's Past A ppointment s for date  range
  800          N G MDT,GMIDT, MAX S X=1
  801          S V ASD("F")=$ S(GMTSBEG= 1:2560101, 1:GMTSBEG) ,VASD("T") =$S(GMTS1= 6666666:DT ,1:9999999 -GMTS1)
  802          S M AX=$S(+($G (GMTSNDM)) >0:+($G(GM TSNDM)),1: 99999)
  803          S V ASD("W")=1 23456789 D  SDA^VADPT
  804          I V AERR=1 D C KP^GMTSUP  W "RSA ERR OR",! D EN D Q
  805          I V AERR=2 D C KP^GMTSUP  W "DATABAS E NOT AVAI LABLE",! D  END Q
  806          S ( YCNT,Y)=0  F  S Y=$O( ^UTILITY(" VASD",$J,Y )) Q:'Y  S  YCNT=YCNT +1,ADATE=$ P(^(Y,"I") ,U,1),^UTI LITY("GMTS VASD",$J,9 9999
  807           99 -ADATE)=AD ATE_U_$P(^ UTILITY("V ASD",$J,Y, "E"),U,2,9 9)
  808          S G MDT=VASD(" F")
  809          F   S GMDT=$O( ^SCE("ADFN ",DFN,GMDT )) Q:GMDT' >0!(GMDT>V ASD("T"))   D
  810          . S  GMI=0 F   S GMI=$O(^ SCE("ADFN" ,DFN,GMDT, GMI)) Q:GM I'>0  D
  811          . .  S GMIDT=9 999999-GMD T
  812          . .  I '$D(^UT ILITY("GMT SVASD",$J, GMIDT)) D
  813          . .  . Q:$P($G (^SCE(GMI, 0)),U,6)'= ""
  814          . .  . I $P($G (^SCE(GMI, 0)),U,4) Q :$P($G(^SC ($P(^SCE(G MI,0),U,4) ,"OOS")),U )
  815          . .  . S ^UTIL ITY("GMTSV ASD",$J,GM IDT)=GMDT_ U_$S(+$P(^ SCE(GMI,0) ,U,4):$P($ G(^SC(+$P( ^(0),U,4), 0)),U),1:$ P($G(^DIC( 40.7
  816           ,$ P(^SCE(GMI ,0),U,3),0 )),U))_U_" UNSCHEDULE D"
  817          D:$ $ROK^GMTSU ("A7RHSM") &($$NDBI^G MTSU) CVP^ A7RHSM ; 1 1-2-18, XI NDEX fails  at sites  without A7 RHSM
  818          I ' $D(^UTILIT Y("GMTSVAS D",$J)) D  END Q
  819          S I DATE="",YC NT=0
  820          F   S IDATE=$O (^UTILITY( "GMTSVASD" ,$J,IDATE) ) Q:+IDATE '>0!(YCNT= MAX)  D
  821          . S  ADATE=+^( IDATE),ADA TE(0)=^(ID ATE) D PRI NT S YCNT= YCNT+1
  822          D E ND Q
  823   FUTURE ; G ets Patien t's Future  Appointme nts 
  824          ; G MTS*2.7*12 4 - begin  changes pe r NSR20180 306 - Futu re Clinic  Visit Disp lay Recall  Appts
  825          ; a llow site  to decide  whether or  not to us e new func tionality
  826          I $ $GET^XPAR( "ALL","GMT S SHOW FUT URE RECALL  DATE") D
  827          . D  CKP^GMTSU P Q:$D(GMT SQIT)
  828          . N  BEG,END,D ATE1,NODE
  829          . S  BEG=$$DT^ XLFDT,END= $$FMADD^XL FDT(BEG,72 0)
  830          . D  COVER^SDR ROR
  831          . S  DATE1=0 F   S DATE1= $O(^TMP("O RVSTLIST", $J,DATE1))  Q:'+DATE1   D
  832          ..  S NODE=$G( ^TMP("ORVS TLIST",$J, DATE1,"R", 1)) Q:$P(N ODE,";")'= "R"
  833          ..  W !,$$FMTE ^XLFDT($P( NODE,U,2), 5),?18,$P( NODE,U,3)
  834          ..  Q
  835          . W :$D(NODE)  !
  836          . K  ^TMP("ORV STLIST",$J )
  837          ; G MTS*2.7*12 4 - end ch anges per  NSR2018030 6
  838          ;   "     "      - begin  changes pe r NSR20171 207 - Repo rt Tab Dis play Appt  Room Numbe r
  839          S V ASD("F")=$ G(DT,$P($$ NOW^XLFDT, "."))
  840          D S DA^VADPT N  MAX S MAX =$S(+($G(G MTSNDM))>0 :+($G(GMTS NDM)),1:99 999)
  841          I V AERR=2 D C KP^GMTSUP  W "DATABAS E NOT AVAI LABLE",! D  END Q
  842          S ( YCNT,Y)=0  F  S Y=$O( ^UTILITY(" VASD",$J,Y )) Q:'Y  S  YCNT=YCNT +1,ADATE=$ P(^(Y,"I") ,U,1),ADAT E(0)=^UTIL ITY("VASD" ,$J,
  843           Y, "E"),GMTSL OC=$P(^SC( $P(^UTILIT Y("VASD",$ J,Y,"I"),U ,2),0),U,1 1) D PRINT  Q:YCNT=MA X  ;added  GMTSLOC fo r NSR20171 207
  844          ; G MTS*2.7*12 4 - end ch anges per  NSR2017120 7
  845          D E ND Q
  846   PRINT  ; O utput
  847          D C KP^GMTSUP  Q:$D(GMTSQ IT)  S X=A DATE D REG DTM4^GMTSU ,CKP^GMTSU P
  848          ; G MTS*2.7*12 4 - begin  changes pe r NSR20171 207
  849          ;W  X,?18,$E($ P(ADATE(0) ,"^",2),1, 25),?58,$E ($P(ADATE( 0),"^",3), 1,21) ; co mmented ou t per NSR2 0171207
  850          W X ,?18,$E($P (ADATE(0), "^",2),1,2 5)
  851          W:$ G(GMTSLOC) '="" " ("_ GMTSLOC_") "
  852          W ? 58,$E($P(A DATE(0),"^ ",3),1,21)
  853          ; G MTS*2.7*12 4 - end ch anges per  NSR2017120 7, include s cleanup  of GMTSLOC  below
  854          W !  Q
  855   END    ; C lean-up an d Quit
  856          K % I,IDATE,ID ATES,ADATE ,GMTSLOC,V ASD,X,Y,YC NT,Z,^UTIL ITY("VASD" ,$J),^UTIL ITY("GMTSV ASD",$J) Q
  857   ========== ========== ========== ========== ========== ========== ========
  858   GMTSPXEP
  859   Before:
  860    GMTSPXEP  ; SLC/SBW, KER - PCE  Patient Ed ucation co mp ; 3/12/ 03 12:49pm
  861   ;;2.7;Heal th Summary ;**8,10,28 ,35,56**;O ct 20, 199 5
  862   ;
  863   ; External  Reference s
  864   ; DBIA 306 3 EDUC^PXR HS08
  865   ; DBIA 100 11 ^DIWP
  866  
  867   PTED ; Pat ient Educa tion
  868   N GMTSOVT  K ^TMP("PX PE",$J) S  GMTSOVT="A ICTSORXHDE "
  869  
  870   ; GMTSOVT  is a sting  containin g a set of  Service 
  871   ; Categori es for:
  872  
  873   ; Ambulato ry A
  874   ; Inpatien t I
  875   ; Chart Re view C
  876   ; Telecomm unications  T
  877   ; Day Surg ery S
  878   ; Observat ion O
  879   ; Nursing  Home R
  880   ; Ancillar y X
  881   ; Hospital ization H
  882   ; Daily Ho spitalizat ion Ancill ary D
  883   ; Event-Hi storical E
  884  
  885   D EDUC^PXR HS08(DFN,G MTSEND,GMT SBEG,GMTSN DM,GMTSOVT )
  886   Q:'$D(^TMP ("PXPE",$J )) D CKP^G MTSUP Q:$D (GMTSQIT)  D HDR,EDMA IN
  887   Q
  888   MRPTED ; M ost recent  patient e ducation
  889   N GMTSOVT, LATEST K ^ TMP("PXPE" ,$J) S LAT EST="R",GM TSOVT="AIC TSORXHDE"
  890  
  891   ; Returns  most recen t Patient  Education  Topic Type
  892   ; for time  period. G MTSOVT is  a sting co ntaining a
  893   ; set of S ervice Cat egories fo r:
  894  
  895   ; Ambulato ry A
  896   ; Inpatien t I
  897   ; Chart Re view C
  898   ; Telecomm unications  T
  899   ; Day Surg ery S
  900   ; Observat ion O
  901   ; Nursing  Home R
  902   ; Ancillar y X
  903   ; Hospital ization H
  904   ; Daily Ho spitalizat ion Ancill ary D
  905   ; Event-Hi storical E
  906  
  907   D EDUC^PXR HS08(DFN,G MTSEND,GMT SBEG,LATES T,GMTSOVT)
  908   Q:'$D(^TMP ("PXPE",$J ))
  909   D CKP^GMTS UP Q:$D(GM TSQIT) D:G MTSNPG HDR
  910   D EDMAIN
  911   Q
  912   HDR ; Head er
  913   W ?2,"Date ",?12,"Fac ility",?25 ,"Topic -  Understand ing Level" ,!!
  914   Q
  915   EDMAIN ; M ain Educat ion Displa y
  916   N GMDT,GME D,GMIFN,GM N0,GMN1,X, GMTSDAT,ED ,LEVEL,GMS ITE,PSITE, PDT,LTXT
  917   N COMMENT, GMICL,GMTS LN,GMTAB
  918   S GMDT=0
  919   F S GMDT=$ O(^TMP("PX PE",$J,GMD T)) Q:GMDT '>0 D Q:$D (GMTSQIT)
  920   . S GMED=" "
  921   . F S GMED =$O(^TMP(" PXPE",$J,G MDT,GMED))  Q:GMED']" " D Q:$D(G MTSQIT)
  922   . . S GMIF N=0
  923   . . F S GM IFN=$O(^TM P("PXPE",$ J,GMDT,GME D,GMIFN))  Q:GMIFN'>0  D Q:$D(GM TSQIT)
  924   . . . S GM N0=$G(^TMP ("PXPE",$J ,GMDT,GMED ,GMIFN,0))
  925   . . . Q:GM N0']""
  926   . . . S GM N1=$G(^TMP ("PXPE",$J ,GMDT,GMED ,GMIFN,1))
  927   . . . S GM SITE=$S($P (GMN1,U,3) ]"":$E($P( GMN1,U,3), 1,10),$P(G MN1,U,4)]" ":$E($P(GM N1,U,4),1, 10),1:"No  Site")
  928   . . . S X= $P(GMN0,U, 2) D REGDT 4^GMTSU S  GMTSDAT=X
  929   . . . S LT XT="",ED=$ P(GMN0,U), LEVEL=$P(G MN0,U,3)
  930   . . . I LE VEL]"" S L TXT=" - "_ LEVEL
  931   . . . I LE VEL="POOR" !(LEVEL="F AIR")!(LEV EL="GOOD")  S LTXT=LT XT_" UNDER STANDING"
  932   . . . D CK P^GMTSUP Q :$D(GMTSQI T) D:GMTSN PG HDR
  933   . . . I GM TSDAT'=$G( PDT)!GMTSN PG W GMTSD AT S PDT=G MTSDAT,PSI TE=""
  934   . . . I GM SITE'=$G(P SITE) W ?1 2,GMSITE S  PSITE=GMS ITE
  935   . . . W ?2 5,ED,$G(LT XT),!
  936   . . . S CO MMENT="",C OMMENT=$P( ^TMP("PXPE ",$J,GMDT, GMED,GMIFN ,"COM"),U)
  937   . . . I CO MMENT]"" S  GMICL=26, GMTAB=2 D  FORMAT I $ D(^UTILITY ($J,"W")) 
  938   . . . . F  GMTSLN=1:1 :^UTILITY( $J,"W",DIW L) D LINE  Q:$D(GMTSQ IT)
  939   K ^TMP("PX PE",$J)
  940   Q
  941   FORMAT ; F ormat Line
  942   N DIWR,DIW F,X S DIWL =3,DIWR=80 -(GMICL+GM TAB)
  943   K ^UTILITY ($J,"W") S  X=COMMENT  D ^DIWP
  944   Q
  945   LINE ; Wri te Line
  946   D CKP^GMTS UP Q:$D(GM TSQIT) W ? 26,^UTILIT Y($J,"W",D IWL,GMTSLN ,0),!
  947  
  948   After:
  949   GMTSPXEP *  *  97 LIN ES,  (tota l 4097, co mments 157 9) BYTES   Page 1
  950           RS UM: old 47 21012, new  14765738
  951             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  NOV 6,2018 @12:36
  952   GMTSPXEP - -
  953           ;  SLC/SBW,KE R - PCE Pa tient Educ ation comp  ; 08/27/2 002
  954          ;;2 .7;Health  Summary;** 8,10,28,35 ,56,124**; Oct 20, 19 95
  955          ;
  956          ; E xternal Re ferences
  957          ;    DBIA  306 3  EDUC^PX RHS08
  958          ;    DBIA 1001 1  ^DIWP
  959          ;    DBIA 1006 0  FIle #2 00
  960   PTED   ; P atient Edu cation
  961          N G MTSOVT K ^ TMP("PXPE" ,$J) S GMT SOVT="AICT SORXHDE"
  962          ;                        
  963          ;    GMTSOVT i s a sting  containing  a set of  Service 
  964          ;    Categorie s for:
  965          ;                        
  966          ;     Ambulato ry                        A
  967          ;     Inpatien t                         I
  968          ;     Chart Re view                      C
  969          ;     Telecomm unications                T
  970          ;     Day Surg ery                       S
  971          ;     Observat ion                       O
  972          ;     Nursing  Home                      R
  973          ;     Ancillar y                         X
  974          ;     Hospital ization                   H
  975          ;     Daily Ho spitalizat ion Ancill ary D
  976          ;     Event-Hi storical                  E
  977          ;                        
  978          D E DUC^PXRHS0 8(DFN,GMTS END,GMTSBE G,GMTSNDM, GMTSOVT)
  979          Q:' $D(^TMP("P XPE",$J))   D CKP^GMT SUP Q:$D(G MTSQIT)  D  HDR,EDMAI N
  980          Q
  981   MRPTED ; M ost recent  patient e ducation
  982          N G MTSOVT,LAT EST K ^TMP ("PXPE",$J ) S LATEST ="R",GMTSO VT="AICTSO RXHDE"
  983          ;                        
  984          ;    Returns m ost recent  Patient E ducation T opic Types  
  985          ;    for time  period.  G MTSOVT is  a sting co ntaining a
  986          ;    set of Se rvice Cate gories for :
  987          ;                        
  988          ;     Ambulato ry                        A
  989          ;     Inpatien t                         I
  990          ;     Chart Re view                      C
  991          ;     Telecomm unications                T
  992          ;     Day Surg ery                       S
  993          ;     Observat ion                       O
  994          ;     Nursing  Home                      R
  995          ;     Ancillar y                         X
  996          ;     Hospital ization                   H
  997          ;     Daily Ho spitalizat ion Ancill ary D
  998          ;     Event-Hi storical                  E
  999          ;                        
  1000          D E DUC^PXRHS0 8(DFN,GMTS END,GMTSBE G,LATEST,G MTSOVT)
  1001          Q:' $D(^TMP("P XPE",$J))
  1002          D C KP^GMTSUP  Q:$D(GMTSQ IT)  D:GMT SNPG HDR
  1003          D E DMAIN
  1004          Q
  1005   HDR    ; H eader
  1006          W ? 2,"Date",? 12,"Facili ty",?25,"T opic - Und erstanding  Level",!!
  1007          Q
  1008   EDMAIN ; M ain Educat ion Displa y
  1009          N G MDT,GMED,G MIFN,GMN0, GMN1,X,GMT SDAT,GMTSE DUC,GMTSDU Z,ED,LEVEL ,GMSITE,PS ITE,PDT,LT XT
  1010          N C OMMENT,GMI CL,GMTSLN, GMTAB,TITL E,NAME
  1011          S G MDT=0
  1012          F   S GMDT=$O( ^TMP("PXPE ",$J,GMDT) ) Q:GMDT'> 0  D  Q:$D (GMTSQIT)
  1013          . S  GMED=""
  1014          . F   S GMED=$ O(^TMP("PX PE",$J,GMD T,GMED)) Q :GMED']""   D  Q:$D(G MTSQIT)
  1015          . .  S GMIFN=0
  1016          . .  F  S GMIF N=$O(^TMP( "PXPE",$J, GMDT,GMED, GMIFN)) Q: GMIFN'>0   D  Q:$D(GM TSQIT)
  1017          . .  . S GMN0= $G(^TMP("P XPE",$J,GM DT,GMED,GM IFN,0))
  1018          . .  . Q:GMN0' ]""
  1019          . .  . S GMN1= $G(^TMP("P XPE",$J,GM DT,GMED,GM IFN,1))
  1020          . .  . S GMSIT E=$S($P(GM N1,U,3)]"" :$E($P(GMN 1,U,3),1,1 0),$P(GMN1 ,U,4)]"":$ E($P(GMN1, U,4),1,10) ,1:"No Sit e")
  1021          . .  . S X=$P( GMN0,U,2)  D REGDT4^G MTSU S GMT SDAT=X
  1022          . .  . S LTXT= "",ED=$P(G MN0,U),LEV EL=$P(GMN0 ,U,3)
  1023          . .  . I LEVEL ]"" S LTXT =" - "_LEV EL
  1024          . .  . I LEVEL ="POOR"!(L EVEL="FAIR ")!(LEVEL= "GOOD") S  LTXT=LTXT_ " UNDERSTA NDING"
  1025          . .  . D CKP^G MTSUP Q:$D (GMTSQIT)   D:GMTSNPG  HDR
  1026          . .  . I GMTSD AT'=$G(PDT )!GMTSNPG  W GMTSDAT  S PDT=GMTS DAT,PSITE= ""
  1027          . .  . I GMSIT E'=$G(PSIT E) W ?12,G MSITE S PS ITE=GMSITE
  1028          . .  . W ?25,E D,$G(LTXT) ,!
  1029          . .  . ; *124  - NSR20180 109, added  name and  title of e ducation t opic provi der
  1030          . .  . I $$GET ^XPAR("ALL ","GMTS SH OW EDUCATI ON USER/TI TLE") D
  1031          . .  . . S GMT SEDUC=$G(^ TMP("PXPE" ,$J,GMDT,G MED,GMIFN, "S"))
  1032          . .  . . S GMT SDUZ=$P($P (GMTSEDUC, " ",2),";" ,1)
  1033          . .  . . ; get  name and  title from  #200 if a vailable
  1034          . .  . . S NAM E=$$GET1^D IQ(200,GMT SDUZ,.01," E")
  1035          . .  . . S TIT LE=$$GET1^ DIQ(200,GM TSDUZ,8,"E ") I TITLE ']"" S TIT LE="Unknow n"
  1036          . .  . . W ?25 ,"Entered  by: ",TITL E_"/"_NAME ,!
  1037          . .  . ; *124  - end of c hanges
  1038          . .  . S COMME NT="",COMM ENT=$P(^TM P("PXPE",$ J,GMDT,GME D,GMIFN,"C OM"),U)
  1039          . .  . I COMME NT]"" S GM ICL=26,GMT AB=2 D FOR MAT I $D(^ UTILITY($J ,"W")) D 
  1040          . .  . . F GMT SLN=1:1:^U TILITY($J, "W",DIWL)  D LINE Q:$ D(GMTSQIT)
  1041          K ^ TMP("PXPE" ,$J)
  1042          Q
  1043   FORMAT ; F ormat Line
  1044          N D IWR,DIWF,X  S DIWL=3, DIWR=80-(G MICL+GMTAB )
  1045          K ^ UTILITY($J ,"W") S X= COMMENT D  ^DIWP
  1046          Q
  1047   LINE   ; W rite Line
  1048          D C KP^GMTSUP  Q:$D(GMTSQ IT)  W ?26 ,^UTILITY( $J,"W",DIW L,GMTSLN,0 ),!
  1049          Q
  1050   ========== ========== ========== ========== ========== ========== ========
  1051   GMTSDGA3 ( new)
  1052   GMTSDGA3 *  *  28 LIN ES,  (tota l 1367, co mments 403 ) BYTES    Page 1
  1053           RS UM: old 23 91126, new  3598737
  1054             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  NOV 5,2018 @16:01
  1055     1 GMTSDG A3 --
  1056                ;AITC/CR  - Admissi ons (cont)  ; 9/12/18  6:07pm
  1057     2         ;;2.7;Hea lth Summar y;**124**; Oct 20, 19 95
  1058     3         ;
  1059     4         ; ======= ========== ========== ========== ========== ========== ======
  1060     5         ; new rou tine for c lass 1 rem ediation o f changes  from NSR20 171204
  1061     6         ; called  from tag A DOUT in GM TSDA1
  1062     7         ; ------- ---------- ---------- ---------- ---------- ---------- ------
  1063     8         ;
  1064     9         ; Externa l Referenc es
  1065    10         ; ICR 314 5   ^DIC(4 2.4
  1066    11         ; ICR 115 4   ^DIC(4 5.7
  1067    12         ; ICR 100 60  ^VA(20 0
  1068    13         ; ICR 17      ^DGPM(
  1069    14         ;
  1070    15 ADOUT   ; called  from GMTSD GA1
  1071    16         N GMTSVTI ,GMTSVTD,G MTSNODE,GM TSATT,ATTI EN,GMTSPRO V,PROVIEN, GMTSMVTS,G MTSPRPG,GM TSATPG,VAI P
  1072    17         D IN5^VAD PT ; get i npatient d ata
  1073    18         S GMTSVTD =$O(^DGPM( "ATS",DFN, ADA,0)) I  +GMTSVTD S  GMTSMVTS= $O(^(GMTSV TD,0)),GMT SVTI=$O(^( GMTSMVTS,0 ))
  1074    19         Q:'$G(GMT SVTI)
  1075    20         S GMTSNOD E=^DGPM(GM TSVTI,0),S PEC=""
  1076    21         I +$P(GMT SNODE,U,9)  S TS=$P($ G(^DIC(45. 7,+$P(GMTS NODE,U,9), 0)),U,2),S PEC=$P($G( ^DIC(42.4, +TS,0)),U)
  1077    22         S PROVIEN =$P(VAIP(1 3,5),U),GM TSPROV=$P( VAIP(13,5) ,U,2),ATTI EN=$P(VAIP (18),U),GM TSATT=$P(V AIP(18),U, 2)
  1078    23         D CKP^GMT SUP Q:$D(G MTSQIT)  W  "  Last T r Specialt y: ",$E(SP EC,1,25),? 50,"Last P rov: ",GMT SPROV,! D
  1079    24         . S GMTSP RPG=$P($G( ^VA(200,PR OVIEN,.13) ),U,8),GMT SATPG=$P($ G(^VA(200, ATTIEN,.13 )),U,8) ;  digital pa gers
  1080    25         . W ?46," Digital Pa ger: ",$S( GMTSPRPG>0 :GMTSPRPG, 1:"None")
  1081    26         . w !?48, "Last Atte nd: ",GMTS ATT,!
  1082    27         . W ?46," Digital Pa ger: ",$S( GMTSATPG>0 :GMTSATPG, 1:"None"), !
  1083    28         Q======== ========== ========== ========== ========== ========== ==========
  1084   GMTSPNST ( new)
  1085   GMTSPNST *  *  11 LIN ES,  (tota l 386, com ments 256)  BYTES     Page 1
  1086           RS UM: old 32 739, new 6 6381
  1087             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  NOV 6,2018 @12:47
  1088   GMTSPNST - -
  1089           ;A ITC/CR - H S Progress  Notes Sel ected Titl es ;10/8/1 8 4:16 pm
  1090          ;;2 .7;Health  Summary;** 124**;Oct  20, 1995
  1091          ;
  1092          ; r emediation  of NSR201 71206 (Pro gress Note  Title Com ponent)
  1093          ; t his routin e allows t he user to  select an d display  progress n otes
  1094          ; b y title on ly
  1095   SPNT   ; H S componen t SPNT, pr ints note  date and t itle only
  1096          N G MTSPNST
  1097          S G MTSPNST="T ITLE"
  1098          D M AIN^GMTSPN SL
  1099          Q
  1100   ========== ========== ========== ========== ========== ========== ========
  1101   GMTSP124 ( new)
  1102   GMTSP124 *  *  105 LI NES,  (tot al 4056, c omments 86 1) BYTES   Page 1
  1103           RS UM: old 80 73147, new  17563962
  1104             UCI: VISTA ,ROU      Site: TEST .CHEYENNE
D OM A IN . EXT  NOV 6,2018 @12:44
  1105   GMTSP124 - -
  1106           ;A ITC/CR - P ost-init f or GMTS*2. 7*124 ;10/ 30/18 11:5 1AM
  1107          ;;2 .7;Health  Summary;** 124**;Oct  20, 1995
  1108          ; 
  1109          ; c all to: $$ ADD^XPDMEN U - ICR #1 157
  1110          ;           BM ES^XDPUTL    - ICR #1 0141
  1111          Q
  1112   POST   ; c ome here f or post-in stallation  actions
  1113          D B MES^XPDUTL ("Installi ng Health  Summary co mponent fo r patch GM TS*2.7*124 ...")
  1114          ; C omponent I nstall
  1115          N G MTSIN,GMTS LIM,GMTSIN ST,GMTSTL, GMTSINST,G MTSTOT,GMT SBLD,GMTSC PS,GMTSCP, GMTSCI
  1116          S G MTSCPS="SP NT"
  1117          F G MTSCI=1:1  Q:'$L($P(G MTSCPS,";" ,GMTSCI))   D
  1118          . S  GMTSCP=$P (GMTSCPS," ;",GMTSCI)  K GMTSIN
  1119          . D  ARRAY Q:' $D(GMTSIN)
  1120          . I  $L($G(GMT SIN("TIM") )),+($G(GM TSIN(0)))> 0 S GMTSLI M(+($G(GMT SIN(0)))," TIM")=$G(G MTSIN("TIM "))
  1121          . I  $L($G(GMT SIN("OCC") )),+($G(GM TSIN(0)))> 0 S GMTSLI M(+($G(GMT SIN(0)))," OCC")=$G(G MTSIN("OCC "))
  1122          . S  GMTSINST= $$ADD^GMTS XPD1(.GMTS IN),GMTSTO T=+($G(GMT STOT))+($G (GMTSINST) )
  1123          ; R ebuild Ad  Hoc Health  Summary T ype
  1124          D B MES^XPDUTL ("Re-index  and rebui ld Ad Hoc  Health Sum mary after  install." )
  1125          D:+ ($G(GMTSTO T))>0 BUIL D^GMTSXPD3
  1126          D L IM
  1127          I + $$ROK("GMT SXPS1")>0  D
  1128          . N  GMTSHORT  S GMTSHORT =1,GMTSINS T="",GMTSB LD="GMTS*2 .7*124" D  SEND^GMTSX PS1
  1129          D P OST1
  1130          D B MES^XPDUTL ("Complete d installa tion of pa tch GMTS*2 .7*124.")
  1131          Q
  1132          ;
  1133   ARRAY  ; B uild Array
  1134          K G MTSIN N GM TSI,GMTSTX T,GMTSEX,G MTSFLD,GMT SUB,GMTSVA L,GMTSPDX  S GMTSPDX= 1,GMTSCP=$ G(GMTSCP)  Q:'$L(GMTS CP)
  1135          F G MTSI=1:1 D   Q:'$L(GM TSTXT)
  1136          . S  GMTSTXT=" ",GMTSEX=" S GMTSTXT= $T("_GMTSC P_"+"_GMTS I_")" X GM TSEX S:$L( GMTSTXT,"; ")'>3 GMTS TXT="" Q:' $L(GMTSTXT )
  1137          . S  GMTSFLD=$ P(GMTSTXT, ";",2),GMT SUB=$P(GMT STXT,";",3 ),GMTSVAL= $P(GMTSTXT ,";",4)
  1138          . S :$E(GMTSFL D,1)=1&(+G MTSFLD<2)  GMTSVAL=$P (GMTSTXT," ;",4,5)
  1139          . S :$E(GMTSFL D,1)=" "!( '$L(GMTSFL D)) GMTSTX T="" Q:GMT STXT=""
  1140          . S :$L(GMTSFL D)&('$L(GM TSUB)) GMT SIN(GMTSFL D)=GMTSVAL  Q:$L(GMTS FLD)&('$L( GMTSUB))   S:$L(GMTSF LD)&($L(GM TSUB)) GMT SIN(
  1141           GM TSFLD,GMTS UB)=GMTSVA L
  1142          . S :$G(GMTSFL D)=7&(+($G (GMTSUB))> 0) GMTSPDX =0
  1143          K:+ ($G(GMTSPD X))=0 GMTS IN("PDX")
  1144          Q
  1145          ;
  1146   LIM    ; L imits
  1147          N G MTSI,GMTST ,GMTSO,GMT SA S GMTSI =0 F  S GM TSI=$O(GMT SLIM(GMTSI )) Q:+GMTS I=0  D
  1148          . S  GMTSA=$P( $G(^GMT(14 2.1,+($G(G MTSI)),0)) ,"^",3),GM TST=$G(GMT SLIM(+GMTS I,"TIM"))  S:'$L(GMTS T) GMTST=$ S(GMTSA="Y ":"1
  1149           Y  ",1:"")
  1150          . S  GMTSA=$P( $G(^GMT(14 2.1,+($G(G MTSI)),0)) ,"^",5),GM TSO=$G(GMT SLIM(+GMTS I,"OCC"))  S:'$L(GMTS O) GMTSO=$ S(GMTSA="Y ":"1
  1151           0  ",1:"")
  1152          . D  TO^GMTSXP D3(GMTSI,G MTST,GMTSO )
  1153          Q
  1154          ;
  1155   ROK(X) ; R outine OK
  1156          S X =$G(X) Q:' $L(X) 0 N  GMTSEX,GMT STXT S GMT SEX="S GMT STXT=$T(+1 ^"_X_")" X  GMTSEX
  1157          Q:' $L(GMTSTXT ) 0  Q 1
  1158          Q
  1159          ;
  1160   SPNT   ; S elected PN  Titles Co mponent Da ta
  1161          ;0; ;268
  1162          ;.0 1;;PROGRES S NOTES SE LECTED TIT LE
  1163          ;1; ;SPNT;GMTS PNST
  1164          ;1. 1;;0
  1165          ;2; ;Y
  1166          ;3; ;SPNT
  1167          ;3. 5;;2
  1168          ;3. 5;1;Allows  selection  of progre ss notes t itles. Onl y note dat e and titl e are
  1169          ;3. 5;2;displa yed instea d of the e ntire note .
  1170          ;4; ;Y
  1171          ;5; ;
  1172          ;6; ;
  1173          ;7; ;1
  1174          ;7; 1;8925.1
  1175          ;8; ;
  1176          ;9; ;Selected  PN Titles
  1177          ;10 ;;
  1178          ;11 ;;
  1179          ;12 ;;
  1180          ;13 ;;
  1181          ;14 ;;
  1182          ;TI M;;1Y
  1183          ;OC C;;10
  1184          ;
  1185          Q
  1186          ;
  1187   POST1  ; u pdate [GMT S IRM/ADPA C MAINT ME NU] with t wo new opt ions
  1188          ; [ GMTS HS DI SPLAY RECA LL DATE] a nd [GMTS H S USER/TIT LE ED RECO RD]
  1189          ; t hese are s witches to  turn on a nd off som e other op tions
  1190          D B MES^XPDUTL ("Updating  [GMTS IRM /ADPAC MAI NT MENU] o ption...")
  1191          D A DD1
  1192          Q
  1193          ;
  1194   ADD1   ; u pdate [GMT S IRM/ADPA C MAINT ME NU]
  1195          N G MTSOK,GMTS SYN
  1196          S G MTSSYN=12  ; this syn onym can b e adjusted  at the si tes if des ired
  1197          S G MTSOK=$$AD D^XPDMENU( "GMTS IRM/ ADPAC MAIN T MENU","G MTS HS DIS PLAY RECAL L DATE",GM TSSYN)
  1198          I G MTSOK=1 D
  1199          . D  BMES^XPDU TL("[GMTS  HS DISPLAY  RECALL DA TE] option  is part o f [GMTS IR M/ADPAC MA INT MENU]" )
  1200          E   D  G ERR
  1201          . D  BMES^XPDU TL("Couldn 't add opt ion [GMTS  HS DISPLAY  RECALL DA TE] to [GM TS IRM/ADP AC MAINT M ENU]")
  1202          ;
  1203          S G MTSSYN=13
  1204          S G MTSOK=$$AD D^XPDMENU( "GMTS IRM/ ADPAC MAIN T MENU","G MTS HS USE R/TITLE ED  RECORD",G MTSSYN)
  1205          I G MTSOK=1 D
  1206          . D  BMES^XPDU TL("[GMTS  HS USER/TI TLE ED REC ORD] optio n is part  of [GMTS I RM/ADPAC M AINT MENU] ")
  1207          E   D  G ERR
  1208          . D  BMES^XPDU TL("Couldn 't add opt ion [GMTS  HS USER/TI TLE ED REC ORD] to [G MTS IRM/AD PAC MAINT  MENU]")
  1209          Q
  1210          ;
  1211   ERR    ; a lert the u ser if the re is an e rror
  1212          D B MES^XPDUTL ("Unable t o attach t he menu op tion")
  1213          Q
  1214   ========== ========== ========== ========== ========== ========== ========