2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 2/19/2019 12:20:47 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.

2.1 Files compared

# Location File Last Modified
1 C:\AraxisMergeCompare\Pri_un\EPIP combined\GMRC_3.0_101 EPIP_Remediation_Plan_(GMRC_3.0_101).doc Tue Feb 12 17:06:54 2019 UTC
2 C:\AraxisMergeCompare\Pri_re\EPIP combined\GMRC_3.0_101 EPIP_Remediation_Plan_(GMRC_3.0_101).doc Tue Feb 19 12:43:42 2019 UTC

2.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 4 2670
Changed 3 8
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 GMRC *3.0*101
  3   Remediatio n Plan
  4  
  5   Department  of Vetera ns Affairs
  6   January 20 19
  7   Version 2. 0
  8   Revision H istory
  9   DateVersio nDescripti onAuthor01 /11/20192. 0Updates t hroughoutE PIP Projec t Team04/0 3/20181.0I nitial (dr aft) versi onEPIP Pro ject Team+
  10   Table of C ontents
  11   11.
  12   Introducti on
  13  
  14  
  15   12.
  16   Purpose
  17  
  18  
  19   13.
  20   Patch Desc ription
  21  
  22  
  23   23.1.
  24   Business E pics and S ub-Epics
  25  
  26  
  27   34.
  28   Points of  Contact
  29  
  30  
  31   35.
  32   Code Remed iation
  33  
  34  
  35   35.1.
  36   Standards  and Conven tions
  37  
  38  
  39   35.2.
  40   Review and  Analysis
  41  
  42  
  43   35.3.
  44   Coding Cha nges
  45  
  46  
  47   46.
  48   Testing
  49  
  50  
  51   46.1.
  52   Test Plan
  53  
  54  
  55   46.2.
  56   Test Envir onment
  57  
  58  
  59   46.3.
  60   Test Readi ness Revie w
  61  
  62  
  63   56.4.
  64   Testing Ph ases
  65  
  66  
  67   56.4.1.
  68   Unit Testi ng
  69  
  70  
  71   56.4.2.
  72   Component  Integratio n and Syst ems Testin g (CI/ST)
  73  
  74  
  75   56.4.3.
  76   Functional  Testing
  77  
  78  
  79   56.4.4.
  80   Regression  Testing
  81  
  82  
  83   56.4.5.
  84   Section 50 8 Complian ce Testing
  85  
  86  
  87   57.
  88   Documentat ion Remedi ation
  89  
  90  
  91   67.1.
  92   User Guide s
  93  
  94  
  95   67.2.
  96   Installati on Guides
  97  
  98  
  99   67.3.
  100   Technical  Manuals
  101  
  102  
  103   67.4.
  104   Operations  Manuals
  105  
  106  
  107   68.
  108   Project Re porting
  109  
  110  
  111   69.
  112   Project Sc hedule
  113  
  114  
  115   610.
  116   Deployment
  117  
  118  
  119   611.
  120   Sustainmen t Requirem ents
  121  
  122  
  123   712.
  124   Maintenanc e and Know ledge Tran sfer
  125  
  126  
  127   8Appendix  A:
  128   XINDEX Lis ting for M UMPS Code  Changes
  129  
  130  
  131   9Appendix  B:
  132   Source Cod e Changes
  133  
  134  
  135  
  136  
  137   Introducti on
  138   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.
  139   Purpose
  140   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 GMRC*3 .0*101. Th is patch a ddresses t he followi ng NSRs:
  141   NSR2018011 1 Suppress  CP Alerts  for Perso n(s) that  Ordered Co nsult
  142   This NSR h as been im plemented  locally at  the VA Me dical Cent ers in Dur ham NC and  Richmond  VA.
  143   NSR 201801 12 Consult  Tracking  for DOD
  144   This NSR h as been im plemented  locally at  the Capta in James A . Lovell F ederal Hea lth Care C enter in N orth Chica go IL.
  145   This docum ent addres ses the sc hedule, co de remedia tion, test ing, docum entation,  and delive ry of this  remediati on effort.
  146   Patch Desc ription
  147            - ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  148   PLEASE NOT E
  149   To suppres s New Note  alerts, e xisting sy stem param eter ORB S YSTEM ENAB LE/DISABLE  must be s et to Enab le at the  local site .
  150   To enable  consult al erts via H L7 message s, the JVG MR 1.0 pac kage must  already be  installed  at the lo cal site.  This packa ge support s VA-to-Do D interfac e capabili ties and w as develop ed by the  James A. L ovell Fede ral Health  Care Cent er (JAL FH CC).
  151            - ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------
  152   GMRC*3.0*1 01 provide s the foll owing enha ncements t o VistA:
  153   Modifies t he GMRCTIU 1 routine  to suppres s Consult  Request/Re solution ( New Note)  alerts for  selected  consultant  services.  This is n ecessary t o reduce t he number  of alerts  received b y the Orde ring Provi der for a  Clinical P rocedure ( CP). For e xample, a  Primary Ca re Physici an might r equest a G astroenter ology (GI)  consultat ion to eva luate a pa tient. As  a result o f this eva luation, t he GI phys ician asks  a GI clin ical staff  member to  enter a C P order fo r an endos copy. In t his case,  the GI sta ff member  is the Ord ering Prov ider for t he CP, and  the CP or der is tie d to a con sultant se rvice such  as GI CLI NICAL PROC EDURES. Wh en the pro cedure is  completed,  the consu ltant serv ice transm its the re sults, clo ses the co nsult, and  sends an  alert to t he Orderin g Provider . However,  the GI st aff member  who acts  as the Ord ering Prov ider might  order a l arge numbe r of CPs f rom the co nsultant s ervice, an d does not  need to b e alerted  each time  a CP is co mpleted. 
  154   This patch  adds para meter GMRC  NEW NOTE  ALERT DISA BLE to the  PARAMETER  DEFINITIO N file (#8 989.51). T he paramet er is used  to add co nsultant s ervices an d enable o r disable  the suppre ssion of a lerts for  those serv ices. A Ph armacy Inf ormaticist  or Automa ted Data P rocessing  Applicatio n Coordina tor (ADPAC ) at each  site can a ccess the  parameter  through th e new Cons ult New No te Suppres sion [GMRC  NEW NOTE  PARAMETER  EDIT] opti on, locate d on the G MRC MGR me nu.
  155   Enables De partment o f Defense  (DoD) prov iders who  order cons ults throu gh VA to r eceive con sult alert s via Heal th Level 7  (HL7) mes sages rega rdless of  the consul t status.  Currently,  VistA sen ds alerts  to DoD pro viders onl y when a c onsult is  completed.  DoD provi ders do no t receive  alerts gen erated for  pending c onsults, s uch as ale rts regard ing schedu ling or si gnificant  findings.  By providi ng all nec essary con sult alert s, this pa tch enable s improved  informati on exchang e between  VA and DoD  systems,  and suppor ts ongoing  integrati on between  the two o rganizatio ns. 
  156   This patch  adds syst em-level p arameter G MRC DOD CM NT SIGF ME SSAGE to t he PARAMET ER DEFINIT ION file ( #8989.51).  If the pa rameter is  set to ON  (Yes), an d if the J VGMR 1.0 p ackage is  installed  at the loc al site, t hen VistA  will send  pending co nsult aler ts to DoD  providers  via HL7 me ssages. If  the param eter is se t to OFF ( No), then  there are  no changes  to curren t function ality, and  VistA wil l send ale rts to DoD  providers  only for  completed  consults.  Initially,  the param eter is se t to OFF ( No). A Pha rmacy Info rmaticist  or ADPAC a t each sit e can acce ss the par ameter thr ough the n ew DOD Pen ding Consu lt Message s ON/OFF [ GMRC DOD C MNT MESSAG E ON/OFF]  option, lo cated on t he GMRC MG R menu.
  157   Business E pics and S ub-Epics
  158   The Busine ss Epics a nd Sub-Epi cs for the  NSR(s) ad dressed in  this reme diation ar e:
  159   NSR2018011 1 Suppress  CP Alerts  for Perso n(s) that  Ordered Co nsult:
  160   BUSINESS E PIC 971473 : Suppress  CP Alerts  for Order ing Provid er – For C linicians  who order  Clinical P rocedures,  a modific ation to s uppress a  New Note A lert that  prevents a n alert fr om being s ent to the  provider  ordering t he procedu re. Unlike  the curre nt solutio n that sen ds an aler t to the o rdering pr ovider who  is alread y aware th at the pro cedure has  been perf ormed, our  process r educes the  number of  inefficie nt alerts/ notificati ons being  sent to cl inical sta ff when th ose alerts /notificat ions are n ot necessa ry.
  161   NSR2018011 2 Consult  Tracking f or DOD:
  162   BUSINESS E PIC 972722 : DoD Cons ult Update s on Patie nts Treate d at VA –  For DoD Pr oviders wh o order co nsults for  patients  that will  be perform ed at a VA  facility,  a communi cation tha t informs  the DoD pr ovider of  actions ta ken on the  consult.  Unlike the  current s olution th at does no t send inf ormation s uch as whe n the cons ult is sch eduled, co mments abo ut resched uling, or  other even ts such as  when ther e are sign ificant fi ndings, ou r process  enhances t he communi cation bet ween the D oD provide r requesti ng the con sult and t he VA staf f providin g the serv ice so tha t the orde ring provi der is kep t informed  when acti ons are ta ken on the  consult a nd the pat ient recei ves the be st care po ssible.
  163   Points of  Contact
  164   The VA Poi nt of Cont act (POC)  for NSR201 80111 Supp ress CP Al erts for P erson(s) t hat Ordere d Consult  is Richard  Reeves (  HYPE R LINK   "PII                              " PII                       ) .
  165   The VA Poi nt of Cont act (POC)  for NSR201 80112 Cons ult Tracki ng for DOD  is David  Douglas (
  HYPERLINK   "PII                             " PII                      )
  166   Code Remed iation
  167   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.
  168   Standards  and Conven tions
  169   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).
  170   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.
  171   Review and  Analysis
  172   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. 
  173   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. 
  174   Coding Cha nges
  175   The coding  changes r equired fo r NSR20180 111 Suppre ss CP Aler ts for Per son(s) tha t Ordered  Consult ar e in the f ollowing r outine: 
  176   Modified M UMPS routi nes: GMRCT IU1 
  177   New MUMPS  routines:  GMRC101P
  178   The coding  changes r equired fo r NSR20180 112 Consul t Tracking  for DOD a re in the  following  routines: 
  179   Modified M UMPS routi nes: GMRCA SF, GMRCAC MT, GMRCGU IB
  180   New MUMPS  routines:  None
  181   A detailed  analysis  of the cod ing change s is provi ded in App endix B.
  182   Testing
  183   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.
  184   Test Plan
  185   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.
  186   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.
  187   Test Envir onment
  188   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.
  189   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.
  190   Test Readi ness Revie w
  191   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 ).
  192   Testing Ph ases
  193   Leidos wil l perform  developmen t and SQA  testing ac tivities i n phases,  and will p rovide all  required  testing do cumentatio n.
  194   Unit Testi ng
  195   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. 
  196   Component  Integratio n and Syst ems Testin g (CI/ST)
  197   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.
  198   Functional  Testing
  199   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. 
  200   Regression  Testing
  201   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.  
  202   Section 50 8 Complian ce Testing
  203   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.
  204   Documentat ion Remedi ation
  205   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.
  206   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.
  207   The follow ing sectio ns outline  the VDL d ocuments t o be revis ed for thi s remediat ion.
  208   User Guide s
  209   The follow ing User G uide will  be updated  in the VD L:
  210   Consult/Re quest Trac king User  Manual
  211   CPRS User  Guide: GUI  Version
  212   Installati on Guides
  213   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.
  214   Technical  Manuals
  215   The follow ing Techni cal Manual  will be u pdated in  the VDL:
  216   Consult/Re quest Trac king Techn ical Manua l
  217   Operations  Manuals
  218   No Operati ons Manual s require  revision a s a result  of this m odificatio n.
  219   Project Re porting
  220   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. 
  221   Project Sc hedule
  222   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.  
  223   Deployment
  224   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.
  225   Sustainmen t Requirem ents
  226   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
  227   Maintenanc e and Know ledge Tran sfer
  228   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.
  229   XINDEX Lis ting for M UMPS Code  Changes
  230   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.
  231                       V . A.  C R  O S S  R E  F E R E N  C E R  7. 3
  232                            [2008 V A Standard s & Conven tions]
  233                      UC I: VISTA C PU: ROU     Jan 09, 2 019@12:18: 46
  234   The BUILD  file Data  Dictionari es are bei ng process ed.
  235   The option  and funct ion files  are being  processed.
  236   Routines a re being p rocessed.
  237   Routines:  5  Faux Ro utines: 1
  238   GMRC101P   GMRCACMT   GMRCASF    GMRCGUIB   GMRCTIU1  
  239              Data Dicti onaries
  240   |opt            
  241   --- CROSS  REFERENCIN G ---
  242   Compiled l ist of Err ors and Wa rnings                Jan 09, 20 19@12:18:4 6 page 1
  243   No errors  or warning s to repor t
  244   --- END -- -
  245   Source Cod e Changes
  246   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:
  247   Modified M UMPS routi nes: GMRCT IU1, GMRCA CMT, GMRCA SF, GMRCGU IB
  248   New MUMPS  routines:  GMRC101P
  249   GMRCTIU1 
  250   Before: 
  251   GMRCTIU1 ; SLC/JER -  More CT/TI U interfac e modules  ;7/9/2003  [7/9/03 1: 51pm] 
  252   ;;3.0;CONS ULT/REQUES T TRACKING ;**1,4,21, 17,34,46** ;DEC 27, 1 997;Build  23 
  253   ;CEM/DUR L ocal Mod a dded STATU S+25 4-8-2 013 
  254   ;Update or der 
  255   S GMRCORNP =$P(^GMR(1 23,+GMRCO, 0),"^",14)  
  256   D EN^GMRCH L7(GMRCDFN ,+GMRCO,$G (GMRCTYPE) ,$G(GMRCRB ),"RE",GMR CORNP,$G(G MRCVSIT),. GMRCOM) 
  257  
  258   ;CEM/DUR N ext lines  added to s et Request  Service t o use it w hen making  a paramet er call 
  259   N GMRCRSV, NOALERT 
  260   S GMRCRSV= $P(^GMR(12 3,+GMRCO,0 ),"^",5) 
  261   ;Send a me ssage 
  262   I $$COMPLE TE(GMRCA) 
  263   . N GMRCDA TA 
  264   . S GMRCAT X="" 
  265   . I GMRCA= 14 S GMRCA TX="New No te for " 
  266   . ;I GMRCA =14 S GMRC ATX="New N ote for "  ;local mod  original  line 
  267   . I GMRCA= 14 D 
  268   ..I $$GET^ XPAR("RSV. `"_GMRCRSV ,"GMRC NEW  NOTE ALER T DISABLE" ) S NOALER T=1 Q 
  269   ..S GMRCAT X="New Not e for " 
  270   .Q:$G(NOAL ERT)=1 ;en d of local  mods 
  271   After: 
  272   GMRCTIU1 ; SLC/JER -  More CT/TI U interfac e modules  ;7/9/2003  [7/9/03 1: 51pm]
  273    ;;3.0;CON SULT/REQUE ST TRACKIN G;**1,4,21 ,17,34,46, 101**;DEC  27, 1997;B uild 23
  274    ;CEM/DUR  Local Mod  added STAT US+25 4-8- 2013
  275    ;
  276    ;This rou tine invok es IA #269 3
  277   ROLLBACK(D A,TIUDA) ;  Roll-back  a CT reco rd when re sult is de leted or
  278    ;reassign ed
  279    ;Disassoc iate Note  logic
  280    ;The acti on removes  the assoc iation of  a TIU note  with a co nsult.
  281    ;The new  CPRS statu s will cha nge to "AC TIVE", unl ess one of  the
  282    ;remainin g notes ha s a comple ted status
  283    ;This act ion should  send an a lert to th e service  notificati on users.
  284    N DIE,DR, GMRCSTS,GM RCA,GMRCO, GMRCOM,GMR CORNP,GMRC DFN,GMRCNO DE,GMRCLIS T,GMRCD0,G MRCD1,GMRC SF,GMRCADU Z,MSGTOSRV ,GMRCATX,G MRCORTX,GM RCSTAR,GMR CERR,ACTDA ,ACTREC,GM RCLSCH,GMR CLER,GMRCR BDA,GMRCTD A,GMRCRSLT
  285    S GMRCNOD E=$G(^GMR( 123,+DA,0) )
  286    ; If curr ent result  has never  been post ed, no nee d to roll  back
  287    ; Patch G MRC*1*21
  288    I '+$O(^G MR(123,+DA ,50,"B",+T IUDA_";TIU (8925,",0) ) Q
  289    I ($P(GMR CNODE,U,20 )=TIUDA) S  DIE="^GMR (123,",DR= "16///@" D  ^DIE
  290    S GMRCD0= DA,GMRCD1= 0 F  S GMR CD1=$O(^GM R(123,GMRC D0,50,GMRC D1)) Q:'GM RCD1  D
  291    .N DA,DIK
  292    .Q:'(TIUD A=+$G(^GMR (123,GMRCD 0,50,GMRCD 1,0)))
  293    .S DA(1)= GMRCD0,DA= GMRCD1
  294    .S DIK="^ GMR(123,"_ DA(1)_",50 ,"
  295    .D ^DIK
  296    ;
  297    S GMRCA=1 2,GMRCO=DA
  298    D GETLIST ^GMRCTIUL( DA,2,1,.GM RCLIST)
  299    S GMRCSTS =9
  300    ;Followin g if state ment and D O block ac complish t he followi ng
  301    ;If there  are no ot her associ ated TIU D ocs then
  302    ;Set stat us to sche duled if i t was last  status be fore the T IU doc
  303    ;Set stat us to pend ing if it  was the la st status  before the  TIU doc
  304    ;Set stat us to acti ve otherwi se
  305    I '$G(GMR CLIST(0))  S GMRCSTS= 6 D
  306    .S ACTDA= 0,ACTREC=0 ,GMRCRBDA= 0,GMRCLER= -1,GMRCLSC H=-1
  307    .F  S ACT DA=$O(^GMR (123,DA,40 ,ACTDA)) Q :-ACTDA=0  D
  308    ..S ACTRE C=$G(^GMR( 123,DA,40, ACTDA,0))
  309    ..I $P(AC TREC,U,2)= 9,$P($P(AC TREC,U,9), ";",1)=TIU DA S GMRCR BDA=ACTDA
  310    ..I $P(AC TREC,U,2)= 8 S GMRCLS CH=ACTDA
  311    ..I $P(AC TREC,U,2)= 11 S GMRCL ER=ACTDA
  312    .I GMRCLE R'=-1,GMRC LER>GMRCLS CH S GMRCS TS=5
  313    .I GMRCLS CH'=-1,GMR CLSCH>GMRC LER S GMRC STS=8
  314    E  S GMRC D0="" F  S  GMRCD0=$O (^TMP("GMR C50",$J,GM RCD0)) Q:' $L(GMRCD0)  D
  315    .Q:(+GMRC D0=TIUDA)
  316    .S GMRCD1 =0 F  S GM RCD1=$O(^T MP("GMRC50 ",$J,GMRCD 0,GMRCD1))  Q:'GMRCD1   D
  317    ..S:($P($ G(^TMP("GM RC50",$J,G MRCD0,GMRC D1)),U,6)= "completed ") GMRCSTS =2
  318    Q:$G(NOSA VE)
  319    ;Make sta tus comple ted if the  Consult w as Admin.  Completed
  320    S ACTDA=0 ,ACTREC=0
  321    F  S ACTD A=$O(^GMR( 123,DA,40, ACTDA)) Q: -ACTDA=0 D
  322    .S ACTREC =$G(^GMR(1 23,DA,40,A CTDA,0))
  323    .I $P(ACT REC,U,2)=1 0,$P(ACTRE C,U,9)=""  S GMRCSTS= 2
  324    D STATUS^ GMRCP
  325    K ^TMP("G MRC50",$J) ,^TMP("GMR C50R",$J)
  326    ;
  327    S GMRCOM= 0,MSGTOSRV =0,GMRCRSL T=TIUDA_"; TIU(8925,"  D AUDIT^G MRCP
  328    ;
  329    ;Build me ssage info rmation if  status ha s changed  or sig fin ding="Y"
  330    S GMRCSF= $P(GMRCNOD E,U,19)
  331    I ($P(GMR CNODE,U,12 )=$P($G(^G MR(123,GMR CO,0)),U,1 2)) D  Q:G MRCATX=""
  332    . S GMRCA TX="" Q:GM RCSF'="Y"
  333    . S GMRCA TX="*Remov ed consult  note for  "
  334    E  S GMRC ATX=$S((GM RCSF="Y"): "*",1:"")_ "Reactivat ed consult , removed  note for " ,MSGTOSRV= 1
  335    S GMRCORN P=$P(GMRCN ODE,U,14), GMRCDFN=$P (GMRCNODE, U,2)
  336    S GMRCORT X=$$ORTX^G MRCAU(GMRC O)
  337    S GMRCORT X=GMRCATX_ GMRCORTX
  338    S:((GMRCO RNP)&(GMRC ORNP'=DUZ) ) GMRCADUZ (GMRCORNP) =""
  339    S GMRCTDA =TIUDA
  340    D EXTRACT ^TIULQ(GMR CTDA,"GMRC STAR",.GMR CERR,.05)
  341    I '$G(GMR CERR) D
  342    .I $G(GMR CSTAR(GMRC TDA,.05,"I "))'=5 D
  343    ..D MSG^G MRCP(GMRCD FN,GMRCORT X,+GMRCO,2 3,.GMRCADU Z,MSGTOSRV )
  344    Q:($P(GMR CNODE,U,12 )=$P($G(^G MR(123,+GM RCO,0)),U, 12))
  345    ;
  346    ;On statu s change,  send "SC"  (status ch ange) HL7  msg to upd ate order
  347    D EN^GMRC HL7(GMRCDF N,+GMRCO,$ G(GMRCTYPE ),$G(GMRCR B),"SC",GM RCORNP,$G( GMRCVSIT), .GMRCOM)
  348    Q
  349    ;
  350   STATUS ;Up date the s tatus of a  consult t hat has a  TIU result
  351    N GMRCAD, GMRCATX,GM RCOA,GMRCO STS,GMRCOT FN,GMRC,GM RCSF,GMRCL AE,GMRCRSL T,GMRCADUZ ,GMRCOADT
  352    D GETOLD
  353    S GMRCORN P=$G(GMRCA UTH) ;auth or
  354    S GMRCRSL T=GMRCTUFN _";TIU(892 5,"
  355    ;
  356    ;Evaluate  whether a  complete  action is  actually a n addendum  or New no te
  357    I GMRCA=1 0 S GMRCA= $$EVALACT( GMRCOSTS,+ GMRCO,GMRC RSLT)
  358    ;
  359    ;Update t he status  and last a ctivity fi eld
  360    ;Do not c hange the  status if  already co mpleted
  361    I GMRCOST S=2,GMRCST S=9 S GMRC STS=2
  362    D STATUS^ GMRCP
  363    ;
  364    ;Update a ctivity lo g
  365    D AUDIT
  366    ;
  367    ;Update t he last TI U entry mo dified and  add resul t to resul t multiple
  368    D ADD^GMR CTIUA(GMRC TUFN,GMRCO )
  369    ;
  370    ;Update o rder
  371    S GMRCORN P=$P(^GMR( 123,+GMRCO ,0),"^",14 )
  372    D EN^GMRC HL7(GMRCDF N,+GMRCO,$ G(GMRCTYPE ),$G(GMRCR B),"RE",GM RCORNP,$G( GMRCVSIT), .GMRCOM)
  373    ;
  374    N GMRCRSV ,NOALERT ; RTW NSR201 80111 
  375    S GMRCRSV =$P(^GMR(1 23,+GMRCO, 0),"^",5)  ;RTW NSR20 180111
  376    ;
  377    ;Send a m essage
  378    I $$COMPL ETE(GMRCA)  D
  379    . N GMRCD ATA
  380    . S GMRCA TX=""
  381     . ;I GMR CA=14 S GM RCATX="New  Note for  " ;RTW NSR 20180111 S TART
  382    . I GMRCA =14 D
  383    . . I $$G ET^XPAR("R SV.`"_GMRC RSV,"GMRC  NEW NOTE A LERT DISAB LE") S NOA LERT=1 Q
  384    . . S GMR CATX="New  Note for "
  385    . Q:$G(NO ALERT)=1 ; RTW NSR201 80111 End
  386    . I GMRCA =13 S GMRC ATX="Adden dum Added  for "
  387    . S GMRCA TX=$S((GMR CSF="Y"):" *",1:"")_G MRCATX
  388    . S GMRCO RTX=GMRCAT X_"Complet ed Consult  "_$$ORTX^ GMRCAU(+GM RCO)
  389    . S GMRCD ATA=+GMRCO
  390    . S GMRCD ATA=GMRCDA TA_"|"_$G( GMRCRSLT)
  391    . I $P(GM RC(0),"^", 14),$P(GMR C(0),"^",1 4)'=DUZ S  GMRCADUZ($ P(GMRC(0), "^",14))=" "
  392    . D MSG^G MRCP(GMRCD FN,GMRCORT X,GMRCDATA ,23,.GMRCA DUZ,0)
  393    . Q
  394    Q
  395    ;
  396   GETOLD ;sa ve the old  values of  status, a nd the las t activity  data
  397    ;to deter mine how t o update s tatus and  TIU activi ty log
  398    S GMRC(0) =$G(^GMR(1 23,+GMRCO, 0))
  399    S GMRCDFN =$P(GMRC(0 ),"^",2)
  400    S GMRCSF= $P(GMRC(0) ,U,19)
  401    S GMRCOST S=$P(GMRC( 0),"^",12)  ;status b efore acti vity
  402    S GMRCLAE =+$P($G(^G MR(123,+GM RCO,40,0)) ,U,3) ;las t activity  entry
  403    S GMRC(40 )=$G(^GMR( 123,+GMRCO ,40,+GMRCL AE,0))
  404    S GMRCOAD T=+$P(GMRC (40),U,1)  ;last acti vity entry  date
  405    S GMRCOA= $P(GMRC(40 ),"^",2) ; last activ ity
  406    S GMRCOTF N=$P(GMRC( 40),"^",9)  ;last res ult
  407    Q
  408    ;
  409   AUDIT ;Det ermine app ropriate u pdate acti vity.
  410    ;Quit if  new activi ty is same  as previo us "Incomp lete Rpt"  activity
  411    I GMRCOTF N=GMRCRSLT ,GMRCOA=9, GMRCOA=GMR CA,GMRCOST S=GMRCSTS  Q
  412    ;
  413    S GMRCOM= 0
  414    S GMRCDT= $$NOW^XLFD T
  415    ;Check fo r overwrit e of incom plete rpt  activity i f the new
  416    ;activity  occurs wi thin 15 mi nutes of t he last.
  417    S GMRCOAD T=$$FMADD^ XLFDT(GMRC OADT,0,0,1 5)
  418    I GMRCOTF N=GMRCRSLT ,GMRCOA=9, $$COMPLETE (GMRCA),GM RCDT<GMRCO ADT D AUDI T1 Q
  419    D AUDIT^G MRCP Q
  420    Q
  421    ;
  422   AUDIT1 ;ov erwrite la st activit y
  423    L +^GMR(1 23,+GMRCO, 40):5 I '$ T S GMRCUT =1,GMRCERR =1,GMRCERM S="Activit y Trail No t filed -  Consult In  Use By An other User ." L -^GMR (123,+GMRC O,40) Q
  424    S DA=$P(^ GMR(123,+G MRCO,40,0) ,"^",3)
  425    D AUDIT1^ GMRCP
  426    Q
  427    ;
  428   COMPLETE(G MRCA) ;Det ermine if  the action  is a comp lete actio n (10,13,1 4)
  429    Q $S(GMRC A=13:1,GMR CA=14:1,GM RCA=10:1,1 :0)
  430    ;
  431   EVALACT(GM RCOSTS,GMR CO,GMRCRSL T) ;Evalua te complet e action b ased on pr ev results  and sts
  432    N EVALA,G MRCLAE
  433    I '$D(^GM R(123,+GMR CO,50)) Q  10
  434    I GMRCOST S'=2 Q 10
  435    I '$D(^GM R(123,+GMR CO,50,"B", GMRCRSLT))  Q 14
  436    S EVALA=0 ,GMRCLAE=+ $P($G(^GMR (123,+GMRC O,40,0)),U ,3)+1
  437    F  S GMRC LAE=$O(^GM R(123,+GMR CO,40,GMRC LAE),-1) Q :'GMRCLAE   D  Q:+EVA LA
  438    . S GMRCL AE(40)=^GM R(123,+GMR CO,40,GMRC LAE,0)
  439    . I $P(GM RCLAE(40), U,9)=GMRCR SLT D
  440    .. I $P(G MRCLAE(40) ,U,2)=9 S  EVALA=14 Q
  441    .. I $$CO MPLETE($P( GMRCLAE(40 ),U,2)) S  EVALA=13 Q
  442    I +EVALA  Q EVALA
  443    Q 10
  444   EDPAR ; Ed it SUPPRES SION OF AL ERTS FOR A  REQUEST S ERVICE. RT W NSR20181 011
  445    N DIC,DA, DIE,DR,DID EL,DTOUT,G MRCPAR,GMT SCNT,GMTST ,GMTSI,GMT SORD
  446    S GMTSCNT =0
  447    S GMRCPAR =$$FIND1^D IC(8989.51 ,"","","GM RC NEW NOT E ALERT DI SABLE")
  448   L ; Lock R ecord
  449    L +^XTV(8 989.51,GMR CPAR) S GM TSCNT=GMTS CNT+1,GMTS T=$T
  450    I 'GMTST, GMTSCNT'>3  H 2 G L
  451    I 'GMTST, GMTSCNT>3  W !," Anot her user i s editing  this entry .",!," Una ble to res equence at  this time ." Q
  452    S GMTSI=0  F  S GMTS I=$O(GMTSO RD(GMTSI))  Q:+GMTSI= 0 D
  453    . S GMTSF I=$P(GMTSO RD(GMTSI), "^",2),GMT SEQ=$P(GMT SORD(GMTSI ),"^",1)
  454    D EDITPAR ^XPAREDIT( GMRCPAR)
  455    L -^XTV(8 989.51,GMR CPAR)
  456    Q  ;RTW E ND NSR2018 0111
  457   ========== ========== ========== ========== ========== ========== ========
  458   GMRCACMT
  459   Before: 
  460   GMRCACMT ; SLC/DLT,DC M,MA,JFR -  Comment A ction and  alerting ; 4/29/14 
  461   GMRCACMT ; SLC/DLT,DC M,MA,JFR -  Comment A ction and  alerting ;  5/26/15 1 0:51am 
  462   ;;3.0;CONS ULT/REQUES T TRACKING ;**4,14,18 ,20,22,29, 35,47,55,7 5**;DEC 27 , 1997;Bui ld 22 
  463  
  464   ; This rou tine invok es IA #100 60 
  465   . D STATUS ^GMRCP 
  466   S G=^GMR(1 23,GMRCO,0 ),DFN=$P(G ,"^",2),GM RCORNP=GMR CPROV 
  467   D EN^GMRCH L7(DFN,GMR CO,$G(GMRC TYPE),$G(G MRCWARD)," SC",GMRCOR NP,$G(GMRC VIST),.GMR COM,,$G(GM RCAD)) 
  468   D END 
  469  
  470   After: 
  471   GMRCACMT ; SLC/DLT,DC M,MA,JFR -  Comment A ction and  alerting ; 4/29/14
  472    ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,14,1 8,20,22,29 ,35,47,55, 75,101**;D EC 27, 199 7;Build 22
  473    ;
  474    ; This ro utine invo kes IA #10 060
  475    ;
  476   COMMENT(GM RCO) ;Add  a comment  without ch anging the  status
  477    K GMRCQIT ,GMRCQUT N  GMRCA
  478    I $D(IOTM ),$D(IOBM) ,$D(IOSTBM ) D FULL^V ALM1
  479    S GMRCNOW =$$NOW^XLF DT,GMRCAD= GMRCNOW
  480    S GMRCOM= 1,GMRCA=20 ,GMRCPROV= $P(^GMR(12 3,GMRCO,0) ,"^",14) D  AUDIT^GMR CP
  481    ; GMRCOM= 1 defined  the variab le and tel ls AUDIT^G MRCP that  the 
  482    ; word-pr ocessing l ogic shoul d be execu ted. If an  actual co mment is 
  483    ; added,  $P(GMRCOM, "^",2)=1 ( send alert ), if not  GMRCOM=1 a nd no '^' 
  484    ; exists  (do not se nd alert)
  485    I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q
  486    ;continue  if no loc k problems  occurred
  487    I $P(GMRC OM,"^",2)  D
  488    . I $P($G (^GMR(123, GMRCO,12)) ,U,5)="F"  D
  489    .. W !!," The orderi ng provide r for this  inter-fac ility cons ult will"
  490    .. W " au tomaticall y be ",!," notified." ,!
  491    . D PROCA LRT("",1,2 0,GMRCO)
  492    . ;if a N on VA Care  consult,  notify HCP  of the co mment
  493    . I $$FEE ^GMRCHL7H( $$GET1^DIQ (123,GMRCO ,1,"I")) D  COMMENT^G MRCHL7H(GM RCO)
  494    . ;update  LAST ACTI ON field e ven though  no status  change
  495    . N GMRCD R,GMRCSTS
  496    . S GMRCS TS="",GMRC DR="9////2 0"
  497    . D STATU S^GMRCP
  498   I $D(^XPD( 9.7,"B","J VGMR 1.0") ),$$GET^XP AR("SYS"," GMRC DOD C MNT SIGF M ESSAGE",1)  D ;RTW NS R20180112
  499    . D EN^GM RCHL7(DFN, GMRCO,$G(G MRCTYPE),$ G(GMRCWARD ),"SC",GMR CORNP,$G(G MRCVIST),. GMRCOM,,$G (GMRCAD))  ;RTW NSR20 180112 ORD ERS PORTAB ILITY
  500    
  501    D END
  502    Q
  503    ;
  504   PROCALRT(G MRCORTX,GM RCDELR,ACT ION,GMRCO)  ;Process  alert for  comments
  505    ;If GMRCD ELR=1, the  ordering  provider c an be dele ted from t he list.
  506    N GMRCADU Z,GMRCANS, NOTIF,GMRC QIT,GMRCTM
  507    ;S GMRCAN S=$$READ(" Y","Do You  Wish To S end An Ale rt With Th is Comment ","N","Ent er Y to co ntinue wit h recipien t prompts.  Otherwise , enter N. ",1)
  508    ;I (GMRCA NS[U)!(GMR CANS=0) D  END Q
  509    ;
  510    D WHOTO
  511    ;I $G(GMR CQIT) D EN D Q ;User  "^" at req uesting pr ovider.
  512    ;
  513    N GMRCALT
  514    S NOTIF=$ S(ACTION=2 0:63,ACTIO N=8:63,1:2 3)
  515    ;
  516    D SENDMSG (NOTIF,+GM RCO,$G(GMR CTM))
  517    Q
  518    ;
  519   SENDMSG(NO TIF,GMRCO, GMRCATM) ; Send the a lert
  520    N GMRCDFN
  521    I '$D(GMR CADUZ) S G MRCADUZ=""
  522    W !,"Proc essing Ale rts..."
  523    S GMRCDFN =$P($G(^GM R(123,+GMR CO,0)),"^" ,2)
  524    I '$L(GMR CORTX) D
  525    . N TXT
  526    . S TXT=" Comment Ad ded to "
  527    . I $P($G (^GMR(123, GMRCO,12)) ,U,5)'="P"  S GMRCORT X=TXT_"con sult " Q
  528    . S GMRCO RTX=TXT_"r emote cons ult "
  529    S GMRCORT X=GMRCORTX _$$ORTX^GM RCAU(+GMRC O)
  530    D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,NOT IF,.GMRCAD UZ,$G(GMRC ATM))
  531    Q
  532    ;
  533   END ;kill  off variab les and ex it
  534    K GMRC,GM RCA,GMRCMS G,GMRCOM,G MRCO,GMRCO RTX,GMRCER R,GMRCERMS ,GMRCQUT,G MRCUT
  535    I $D(DTOU T)!$D(DIRO UT) S GMRC QIT=""
  536    K DTOUT,D IROUT,DUOU T,DIRUT
  537    S:$D(^TMP ("GMRC",$J ,"CURRENT" ,"MENU"))  XQORM("HIJ ACK")=^("M ENU")
  538    Q
  539    ;
  540   WHOTO ;Get  the users  who shoul d receive  an alert
  541    ;Asks abo ut request ing provid er first,  then promp ts for add itional us ers
  542    ;Returns  GMRCADUZ a rray of us ers to sen d an alert  to and GM RCQIT if " ^"
  543    N GMRCRP, GMRCANS,GM RCUPD
  544    S GMRCRP= +$P($G(^GM R(123,+GMR CO,0)),U,1 4) ;reques ting provi der entry
  545    S GMRCUPD =$$VALID^G MRCAU($P(^ GMR(123,+G MRCO,0),U, 5),GMRCO,D UZ)
  546    I GMRCRP= DUZ D  ;al ert team i f ord. pro v. takes t he action
  547    . S GMRCT M=1
  548    . W !,"Se rvice upda te users w ill be not ified.",!
  549    I +GMRCUP D>1,GMRCRP '=DUZ D  ;  alert ord . prov if  update use rs takes a ction
  550    . S GMRCA DUZ(GMRCRP )=""
  551    . W !,"Re questing p rovider wi ll be noti fied.",!
  552    I '$G(GMR CTM),+GMRC UPD<2 D  ; alert both  if not or d. prov or  update us er
  553    . S GMRCT M=1,GMRCAD UZ(GMRCRP) =""
  554    . W !,"Re questing p rovider an d service  update use rs will be  notified. ",!
  555    ;
  556    ;
  557   ANDTO ;Ask  for addit ional reci pients
  558    D NAMELIS T("Additio nal alert  recipients : ",.GMRCA DUZ,GMRCDE LR)
  559    Q
  560    ;
  561   NAMELIST(G MRCP,GMRCO LD,GMRCDEL R) ;manage  the list  of recipie nts
  562    ;
  563    ; GMRCP -  Prompt
  564    ; GMRCOLD  - Origina l list wit h ordering  provider.
  565    ; GMRCDEL R - 1 mean s the orig inal list  may have n ames delet ed
  566    ; Returns  final lis t in GMRCO LD array
  567    ;
  568    N GMRCNEW ,GMRCNT,GM RCDUZ,GMRC USER,GMRCQ ,GMRCADD,D IC,X,Y
  569    ;
  570    M GMRCNEW =GMRCOLD
  571    I GMRCDEL R=1 K GMRC OLD S GMRC OLD="" ;Re move manda tory users  from GMRC OLD
  572    S GMRCNT= 0 F  D  Q: (GMRCUSER[ U)
  573    .S GMRCUS ER=$$READ( "FAO;3;46" ,$S(GMRCNT :"And ",1: "")_GMRCP, "","^D NAM EHELP^GMRC ACMT")
  574    .S:'$L(GM RCUSER) GM RCUSER=U Q :(GMRCUSER [U)
  575    .I ($E(GM RCUSER,1)= "-") S GMR CADD=0,GMR CUSER=$E(G MRCUSER,2, $L(GMRCUSE R))
  576    .E  S GMR CADD=1
  577    .;
  578    .S X=GMRC USER,DIC=2 00,DIC(0)= "EMQ" D ^D IC
  579    .;
  580    .I (Y>0)  D  I 1
  581    ..;W $E($ P(Y,U,2),$ L(GMRCUSER )+1,$L($P( Y,U,2)))
  582    ..;
  583    ..I GMRCA DD D
  584    ...I $D(G MRCNEW(+Y) ) W " alre ady in the  list." Q
  585    ...S GMRC NEW(+Y)=""  W " added  to the li st." S GMR CNT=GMRCNT +1
  586    ..;
  587    ..I 'GMRC ADD D
  588    ...I $D(G MRCOLD(+Y) ) W " can' t delete t his name f rom the li st." Q
  589    ...I '$D( GMRCNEW(+Y )) W " not  currently  in the li st." Q
  590    ...K GMRC NEW(+Y) S  GMRCNT=GMR CNT-1 W "  deleted fr om the lis t."
  591    .;
  592    .E  I $L( GMRCUSER)  W " Name n ot found."
  593    ;
  594    M GMRCOLD =GMRCNEW
  595    Q
  596    ;
  597   READ(GMRC0 ,GMRCA,GMR CB,GMRCH,G MRCL) ;rea d logic
  598    ;
  599    ; GMRC0 - > DIR(0) - -- Type of  read
  600    ; GMRCA - > DIR("A")  - Prompt
  601    ; GMRCB - > DIR("B")  - Default  Answer
  602    ; GMRCH - > DIR("?")  - Help te xt or ^Exe cute code
  603    ; GMRCL - > Number o f blank li nes to put  before Pr ompt
  604    ;
  605    ; Returns  "^" or an swer
  606    ;
  607    N GMRCLIN E,DIR,DTOU T,DUOUT,DI RUT,DIROUT
  608    Q:'$L($G( GMRC0)) U
  609    S DIR(0)= GMRC0
  610    S:$L($G(G MRCA)) DIR ("A")=GMRC A
  611    S:$L($G(G MRCB)) DIR ("B")=GMRC B
  612    S:$L($G(G MRCH)) DIR ("?")=GMRC H
  613    F GMRCLIN E=1:1:($G( GMRCL)-1)  W !
  614    D ^DIR
  615    I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q U
  616    Q Y
  617    ;
  618    ;
  619   NAMEHELP ; Help for t he recipie nt list lo gic
  620    N GMRCDUZ
  621    W !,"Ente r the name  of the us er to send  the alert  to,"
  622    W !," or  put a '-'  in front o f a name t o delete f rom the li st."
  623    W !
  624    W !," Exa mple:"
  625    W !," SMI TH,FRED ->  to add Fr ed to the  list."
  626    W !," -SM ITH,FRED - > to delet e Fred fro m the list ."
  627    W !,"Alre ady select ed: "
  628    W !
  629    S GMRCDUZ =0 F  S GM RCDUZ=$O(G MRCNEW(GMR CDUZ)) Q:' GMRCDUZ  D
  630    .W !,?5,$ P(^VA(200, GMRCDUZ,0) ,U,1)
  631    .W:$D(GMR COLD(GMRCD UZ)) " <ma ndatory>"
  632    W !
  633    Q
  634    ;
  635    EDPAR ; E dit SUPPRE SSION OF D OD ALERTS  FOR COMMEN T OR SIG F INDING ON  PENDING CO NSULT. ;RT W NSR20180 112
  636    N DIC,DA, DIE,DR,DID EL,DTOUT,G MRCPAR,GMT SCNT,GMTST ,GMTSI,GMT SORD
  637    S GMTSCNT =0
  638    S GMRCPAR =$$FIND1^D IC(8989.51 ,"","","GM RC DOD CMN T SIGF MES SAGE")
  639   L ; Lock R ecord
  640    L +^XTV(8 989.51,GMR CPAR) S GM TSCNT=GMTS CNT+1,GMTS T=$T
  641    I 'GMTST, GMTSCNT'>3  H 2 G L
  642    I 'GMTST, GMTSCNT>3  W !," Anot her user i s editing  this entry .",!," Una ble to res equence at  this time ." Q
  643    S GMTSI=0  F  S GMTS I=$O(GMTSO RD(GMTSI))  Q:+GMTSI= 0 D
  644    . S GMTSF I=$P(GMTSO RD(GMTSI), "^",2),GMT SEQ=$P(GMT SORD(GMTSI ),"^",1)
  645    D EDITPAR ^XPAREDIT( GMRCPAR)
  646    L -^XTV(8 989.51,GMR CPAR)
  647    Q  ;;RTW  END NSR201 80112
  648   ========== ========== ========== ========== ========== ========== ========
  649   GMRCASF
  650   Before: 
  651   GMRCASF ;S LC/DLT - S ignificant  Findings  Action ;7/ 11/03 13:2 8
  652    ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,10,1 4,22,29,35 ,46**;DEC  27, 1997;B uild 23
  653   SF(GMRCO)  ;Evaluate  Significan t Findings  and updat e accordin gly
  654    ;GMRCO is  the selec ted consul t
  655    N GMRCQIT ,GMRCLCK
  656    I '$L($G( GMRCO)) D  SELECT^GMR CA2(.GMRCO ) I $D(GMR CQUT) D EN D Q
  657    I '+($G(G MRCO)) D E ND Q
  658    I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D   Q
  659    . N DIR
  660    . W !,"Th e requesti ng facilit y may not  take this  action on  an "
  661    . W "inte r-facility  consult."
  662    . S DIR(0 )="E" D ^D IR
  663    . D END
  664    I '$$LOCK ^GMRCA1(GM RCO) D END  Q
  665    S GMRCLCK =1
  666    ;
  667    I $D(IOTM ),$D(IOBM) ,$D(IOSTBM ) D FULL^V ALM1
  668    N GMRC,GM RCSTS,GMRC SF,GMRCSFO ,GMRCORTX, GMRCDR
  669    S GMRC(0) =$G(^GMR(1 23,+GMRCO, 0)) Q:GMRC (0)=""
  670    ;
  671    S GMRCSFO =$P(GMRC(0 ),"^",19)
  672    W !!,"Cur rent Signi ficant Fin dings = "_ $S(GMRCSFO ="U":"Unkn own",GMRCS FO="Y":"Ye s",GMRCSFO ="N":"No", 1:"not ent ered yet") ,!!
  673    S GMRCSF= $$GETSIGF( GMRCSFO)
  674    I GMRCSF= 0 D END Q
  675    ; If no c hange in o ld and new  value ask  if should  continue
  676    I GMRCSF= GMRCSFO D   I 'Y D EN D Q
  677    . W !,"Th e old and  new Signif icant Find ings are t he same."
  678    . N DIR,D A,DTOUT,DU OUT,DIRUT, DIROUT
  679    . S DIR(" A")="Do yo u want to  proceed wi th this ac tion"
  680    . S DIR(0 )="Y"
  681    . S DIR(" B")="NO"
  682    . D ^DIR
  683    . I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S Y= 0 Q
  684    . I Y=0 Q
  685    ;
  686    ;Update l ast action  and sig f indings bu t don't ch ange the s tatus
  687    S GMRCSTS =$P(GMRC(0 ),"^",12), GMRCA=4
  688    S GMRCDR= "8////^S X =GMRCSTS;9 ////^S X=G MRCA;15/// /^S X=GMRC SF"
  689    D STATUS^ GMRCP
  690    I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q
  691    ;
  692    ;GMRCOM=1  tells AUD IT^GMRCP t o do the w ord-proces sing logic
  693    ;If an ac tual comme nt is adde d, $P(GMRC OM,"^",2)= 1 (send al ert),
  694    ; if not  GMRCOM=1 a nd no '^'  exists (do  not send  alert)
  695    S GMRCOM= 1 D AUDIT^ GMRCP
  696    I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q
  697    ;
  698    I GMRCSTS =2 D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),U,2 ),GMRCO,$G (GMRCTYPE) ,$G(GMRCRB ),"RE",GMR CORNP,$G(G MRCVSIT),, ,$G(GMRCAD ))
  699    D SETORTX
  700    I GMRCSTS =2 D SENDA LRT(GMRCOR TX) Q
  701    I +$P(GMR COM,"^",2)  D
  702    . W !,"An  alert wit h the foll owing text  will be s ent if rec ipients ar e selected : "
  703    . W !," " _GMRCORTX_ $$ORTX^GMR CAU(+GMRCO )
  704    . W !
  705    . I GMRCS TS'=2 W !, "or the al ert will b e sent whe n the orde r is compl eted.",!
  706    . I $P($G (^GMR(123, GMRCO,12)) ,U,5)="F"  D
  707    . W !!,"T he orderin g provider  for this  inter-faci lity consu lt will "
  708    . W "auto matically  be ",!,"no tified.",!
  709    . D PROCA LRT^GMRCAC MT(GMRCORT X,1,4,GMRC O)
  710    . ;For co nsults not  completed , the orig inal provi der may be  deleted f rom
  711    . ;the re cipient li st for the  alert.
  712    D END
  713    Q
  714    ;
  715   SETORTX ;S et prefix  text for t he alert
  716    S GMRCORT X=$S(GMRCS F="N":"No  ",GMRCSF=" Y":"",1:"U nknown ")
  717    S GMRCORT X=GMRCORTX _"Sig Find ings for " _$P($G(^OR D(100.01,+ GMRCSTS,0) ),"^",2)_"  consult "  Q
  718    Q
  719    ;
  720   SENDALRT(G MRCORTX) ; Send to th e requesti ng provide r
  721    N GMRCRP, GMRCADUZ,G MRCDELR
  722    S GMRCRP= $P($G(^GMR (123,+GMRC O,0)),U,14 ) ;request ing clinic ian
  723    I +GMRCRP ,GMRCRP'=D UZ D
  724    . S GMRCA DUZ(+GMRCR P)=""
  725    . W !,"Al ert will b e sent to  Requesting  Provider:  "_$P($G(^ VA(200,+GM RCRP,0)),U ,1)
  726    E  W !,"N o automati c alerts w ill be sen t to the R equesting  Provider."
  727    S GMRCDEL R=0
  728    D ANDTO^G MRCACMT
  729    D SENDMSG ^GMRCACMT( 23,+GMRCO)
  730    ;Sig Find ings uses  the CONSUL T/REQUEST  RESOLUTION  (23) noti fication
  731    Q
  732    ;
  733   GETSIGF(GM RCSFO) ;Ge t the sign ificant fi ndings
  734    ;GMRCSFO  is the old  significa nt finding s value
  735    N DIR,DA, DTOUT,DUOU T,DIRUT,DI ROUT
  736    S DIR(0)= "123,15"
  737    S DIR("B" )=GMRCSFO
  738    S:DIR("B" )="" DIR(" B")="unkno wn"
  739    S DIR("A" )="Are the re signifi cant findi ngs? (Y/N/ U)"
  740    D ^DIR
  741    I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q 0
  742    Q Y
  743    ;
  744   END ;clean up variabl es
  745    I $G(GMRC LCK) D UNL OCK^GMRCA1 (GMRCO)
  746    K GMRCO,G MRCA,GMRCM SG,GMRCOM, GMRCSEL,GM RCERR,GMRC ERMS
  747    I $D(DTOU T)!$D(DIRO UT) S GMRC QIT=""
  748    S:$D(^TMP ("GMRC",$J ,"CURRENT" ,"MENU"))  XQORM("HIJ ACK")=^("M ENU")
  749    Q
  750   After:
  751   GMRCASF ;S LC/DLT - S ignificant  Findings  Action ;7/ 11/03 13:2 8
  752    ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,10,1 4,22,29,35 ,46,101**; DEC 27, 19 97;Build 2 3
  753   SF(GMRCO)  ;Evaluate  Significan t Findings  and updat e accordin gly
  754    ;GMRCO is  the selec ted consul t
  755    N GMRCQIT ,GMRCLCK
  756    I '$L($G( GMRCO)) D  SELECT^GMR CA2(.GMRCO ) I $D(GMR CQUT) D EN D Q
  757    I '+($G(G MRCO)) D E ND Q
  758    I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D   Q
  759    . N DIR
  760    . W !,"Th e requesti ng facilit y may not  take this  action on  an "
  761    . W "inte r-facility  consult."
  762    . S DIR(0 )="E" D ^D IR
  763    . D END
  764    I '$$LOCK ^GMRCA1(GM RCO) D END  Q
  765    S GMRCLCK =1
  766    ;
  767    I $D(IOTM ),$D(IOBM) ,$D(IOSTBM ) D FULL^V ALM1
  768    N GMRC,GM RCSTS,GMRC SF,GMRCSFO ,GMRCORTX, GMRCDR
  769    S GMRC(0) =$G(^GMR(1 23,+GMRCO, 0)) Q:GMRC (0)=""
  770    ;
  771    S GMRCSFO =$P(GMRC(0 ),"^",19)
  772    W !!,"Cur rent Signi ficant Fin dings = "_ $S(GMRCSFO ="U":"Unkn own",GMRCS FO="Y":"Ye s",GMRCSFO ="N":"No", 1:"not ent ered yet") ,!!
  773    S GMRCSF= $$GETSIGF( GMRCSFO)
  774    I GMRCSF= 0 D END Q
  775    ; If no c hange in o ld and new  value ask  if should  continue
  776    I GMRCSF= GMRCSFO D   I 'Y D EN D Q
  777    . W !,"Th e old and  new Signif icant Find ings are t he same."
  778    . N DIR,D A,DTOUT,DU OUT,DIRUT, DIROUT
  779    . S DIR(" A")="Do yo u want to  proceed wi th this ac tion"
  780    . S DIR(0 )="Y"
  781    . S DIR(" B")="NO"
  782    . D ^DIR
  783    . I $D(DT OUT)!$D(DU OUT)!$D(DI RUT)!$D(DI ROUT) S Y= 0 Q
  784    . I Y=0 Q
  785    ;
  786    ;Update l ast action  and sig f indings bu t don't ch ange the s tatus
  787    S GMRCSTS =$P(GMRC(0 ),"^",12), GMRCA=4
  788    S GMRCDR= "8////^S X =GMRCSTS;9 ////^S X=G MRCA;15/// /^S X=GMRC SF"
  789    D STATUS^ GMRCP
  790    I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q
  791    ;
  792    ;GMRCOM=1  tells AUD IT^GMRCP t o do the w ord-proces sing logic
  793    ;If an ac tual comme nt is adde d, $P(GMRC OM,"^",2)= 1 (send al ert),
  794    ; if not  GMRCOM=1 a nd no '^'  exists (do  not send  alert)
  795    S GMRCOM= 1 D AUDIT^ GMRCP
  796    I $G(GMRC ERR)=1 S G MRCMSG=GMR CERMS D EX AC^GMRCADC (GMRCMSG), END Q
  797   ; RTW NSR2 0180112 ST ART send s ignificant  findings  to DoD reg ardless of  GMRCSTS v alue/statu
  798    ; I GMRCS TS=2 D EN^ GMRCHL7($P (^GMR(123, GMRCO,0),U ,2),GMRCO, $G(GMRCTYP E),$G(GMRC RB),"RE",G MRCORNP,$G (GMRCVSIT) ,,,$G(GMRC AD))
  799    I $D(^XPD (9.7,"B"," JVGMR 1.0" )),$$GET^X PAR("SYS", "GMRC DOD  CMNT SIGF  MESSAGE",1 ) D ;RTW N SR20180112
  800    . S TP="S C"
  801    . D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),U,2 ),GMRCO,$G (GMRCTYPE) ,$G(GMRCRB ),TP,GMRCO RNP,$G(GMR CVSIT),,,$ G(GMRCAD))
  802    D SETORTX
  803    ;I GMRCST S=2 D SEND ALRT(GMRCO RTX) Q
  804    D SENDALR T(GMRCORTX ) Q
  805    ;RTW NSR2 0180112 EN D
  806    I +$P(GMR COM,"^",2)  D
  807    . W !,"An  alert wit h the foll owing text  will be s ent if rec ipients ar e selected : "
  808    . W !," " _GMRCORTX_ $$ORTX^GMR CAU(+GMRCO )
  809    . W !
  810    . I GMRCS TS'=2 W !, "or the al ert will b e sent whe n the orde r is compl eted.",!
  811    . I $P($G (^GMR(123, GMRCO,12)) ,U,5)="F"  D
  812    . W !!,"T he orderin g provider  for this  inter-faci lity consu lt will "
  813    . W "auto matically  be ",!,"no tified.",!
  814    . D PROCA LRT^GMRCAC MT(GMRCORT X,1,4,GMRC O)
  815    . ;For co nsults not  completed , the orig inal provi der may be  deleted f rom
  816    . ;the re cipient li st for the  alert.
  817    D END
  818    Q
  819    ;
  820   SETORTX ;S et prefix  text for t he alert
  821    S GMRCORT X=$S(GMRCS F="N":"No  ",GMRCSF=" Y":"",1:"U nknown ")
  822    S GMRCORT X=GMRCORTX _"Sig Find ings for " _$P($G(^OR D(100.01,+ GMRCSTS,0) ),"^",2)_"  consult "  Q
  823    Q
  824    ;
  825   SENDALRT(G MRCORTX) ; Send to th e requesti ng provide r
  826    N GMRCRP, GMRCADUZ,G MRCDELR
  827    S GMRCRP= $P($G(^GMR (123,+GMRC O,0)),U,14 ) ;request ing clinic ian
  828    I +GMRCRP ,GMRCRP'=D UZ D
  829    . S GMRCA DUZ(+GMRCR P)=""
  830    . W !,"Al ert will b e sent to  Requesting  Provider:  "_$P($G(^ VA(200,+GM RCRP,0)),U ,1)
  831    E  W !,"N o automati c alerts w ill be sen t to the R equesting  Provider."
  832    S GMRCDEL R=0
  833    D ANDTO^G MRCACMT
  834    D SENDMSG ^GMRCACMT( 23,+GMRCO)
  835    ;Sig Find ings uses  the CONSUL T/REQUEST  RESOLUTION  (23) noti fication
  836    Q
  837    ;
  838   GETSIGF(GM RCSFO) ;Ge t the sign ificant fi ndings
  839    ;GMRCSFO  is the old  significa nt finding s value
  840    N DIR,DA, DTOUT,DUOU T,DIRUT,DI ROUT
  841    S DIR(0)= "123,15"
  842    S DIR("B" )=GMRCSFO
  843    S:DIR("B" )="" DIR(" B")="unkno wn"
  844    S DIR("A" )="Are the re signifi cant findi ngs? (Y/N/ U)"
  845    D ^DIR
  846    I $D(DTOU T)!$D(DUOU T)!$D(DIRU T)!$D(DIRO UT) Q 0
  847    Q Y
  848    ;
  849   END ;clean up variabl es
  850    I $G(GMRC LCK) D UNL OCK^GMRCA1 (GMRCO)
  851    K GMRCO,G MRCA,GMRCM SG,GMRCOM, GMRCSEL,GM RCERR,GMRC ERMS
  852    I $D(DTOU T)!$D(DIRO UT) S GMRC QIT=""
  853    S:$D(^TMP ("GMRC",$J ,"CURRENT" ,"MENU"))  XQORM("HIJ ACK")=^("M ENU")
  854    Q
  855   ========== ========== ========== ========== ========== ========== ========
  856   GMRCGUIB
  857   Before: 
  858   GMRCGUIB ; SLC/DCM,JF R,MA/AFS,P B - GUI ac tions for  consults ; 01/10/18 1 3:55
  859    ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,12,1 8,20,17,22 ,29,30,35, 45,53,55,6 4,46,75,86 ,90,91**;D EC 27, 199 7;Build 4
  860    ;
  861    ; This ro utine invo kes IA #29 80
  862    ; This ro utine invo kes IA #67 55 - DE674 5 - PB Apr  12, 2017
  863    ;
  864   SETDA() ;s et DA of w here audit  actions a re to be f iled
  865    S:'$D(^GM R(123,+GMR CO,40,0))  ^GMR(123,G MRCO,40,0) ="^123.02D A^^"
  866    S DA=$S($ P(^GMR(123 ,+GMRCO,40 ,0),"^",3) :$P(^(0)," ^",3)+1,1: 1)
  867    S $P(^GMR (123,+GMRC O,40,0),"^ ",3,4)=DA_ "^"_DA
  868    Q DA
  869   REASON(GMR CFN,GMRCRQ ,GMRCDT) ; Load the r eason for  the reques t into ^GM R(123,GMRC O,20
  870    ;GMRCFN=F ile 123 IF N; GMRCRQ= Array cont aining Rea son For Re quest
  871    ;GMRCDT=D ate time o f entry
  872    S ^GMR(12 3,GMRCFN,2 0,0)="^^^" _GMRCDT_"^ "
  873    S L=0,LN= 1 F  S L=$ O(GMRCRQ(L )) Q:L=""   S ^GMR(12 3,GMRCFN,2 0,LN,0)=GM RCRQ(L),LN =LN+1
  874    S LN=LN-1 ,$P(^GMR(1 23,GMRCFN, 20,0),"^", 3)=LN
  875    K LN,L
  876    Q
  877   SETCOM(COM MENT,WHO)  ;Set comme nt array i nto tracki ng actions
  878    N GMRCNOW ,DR,DIE
  879    S GMRCNOW =$$NOW^XLF DT
  880    I $P($G(^ GMR(123,+G MRCO,0))," ^",11)=$G( GMRCPA) S  GMRCPA=""
  881    S DIE="^G MR(123,GMR CO,40,",DA (1)=GMRCO, DR=".01/// /^S X=GMRC NOW;1////^ S X=GMRCA; 2////^S X= GMRCAD;3// //^S X=$G( GMRCORNP); 4////^S X= $S($G(WHO) :WHO,1:DUZ );6////^S  X=$G(GMRCF R);8////^S  X=$G(GMRC FF);7////^ S X=$G(GMR CPA)"
  882    D ^DIE
  883    S ^GMR(12 3,GMRCO,40 ,DA,1,0)=" ^^^^"_GMRC AD_"^"
  884    S (GMRCND ,GMRCND1)= 0 F  S GMR CND1=$O(CO MMENT(GMRC ND1)) Q:GM RCND1=""   S GMRCND=G MRCND+1,^G MR(123,GMR CO,40,DA,1 ,GMRCND,0) =COMMENT(G MRCND)
  885    S $P(^GMR (123,GMRCO ,40,DA,1,0 ),"^",3)=G MRCND,$P(^ (0),"^",4) =GMRCND,^G MR(123,GMR CO,40,"B", GMRCNOW,DA )=""
  886    D:$D(^GMR (123,+GMRC O,0)) AG12 3S1^GMRCXR (+GMRCO) ; alb/sat 86  - update  AG xref
  887    ;
  888    ; if an I FC, call e vent handl er to gene rate a msg  to remote  site
  889    I $D(^GMR (123,+GMRC O,12)),$D( ^(40,DA))  D TRIGR^GM RCIEVT(GMR CO,DA)
  890    ;
  891    K GMRCND, GMRCND1
  892    Q
  893   CMT(GMRCO, GMRCOM,GMR CADUZ,GMRC WHN,GMRCWH O) ;add co mment to c onsult
  894    ; GMRCO =  IEN from  file 123
  895    ; GMRCOM  = array of  comments  in format  GMRCOM(1)= "xxxx", GM RCOM(2)="x xx"
  896    ; GMRCADU Z = array  of alert r ecipients  as GMRCADU Z(DUZ)=""  (optional)
  897    ; GMRCWHO  = IEN fro m file 200  who's res ponsible a ctivity (o ptional)
  898    ; GMRCWHN  = date ti me of acti vity in FM  format
  899    ; GMRCFOR C = copy o f GMRCADUZ ; these us ers will r ecieve ale rt 63 even  if alert  is turned  OFF; optio nal argume nt to MSG^ GMRCP
  900    ;
  901    N DA,GMRC A,GMRCAD,G MRCORTX,GM RCDFN,GMRC TM,GMRCRP, GMRCUPD,GM RCFORC
  902    M GMRCFOR C=GMRCADUZ
  903    S DA=$$SE TDA ; get  next activ ity tracki ng entry
  904    S GMRCA=2 0,GMRCAD=G MRCWHN S:$ G(GMRCWHO)  GMRCORNP= GMRCWHO
  905    D SETCOM( .GMRCOM,$G (GMRCWHO))
  906    ;if a Non  VA Care c onsult, no tify HCP o f the comm ent
  907    I $$FEE^G MRCHL7H($$ GET1^DIQ(1 23,+GMRCO, 1,"I")) D  COMMENT^GM RCHL7H(+GM RCO)
  908    D  ;updat e LAST ACT ION field  even thoug h no statu s change
  909    . N GMRCD R,GMRCSTS
  910    . S GMRCS TS="",GMRC DR="9////2 0"
  911    . D STATU S^GMRCP
  912    S GMRCDFN =$P(^GMR(1 23,+GMRCO, 0),"^",2)
  913    S GMRCORT X="Comment  Added to  Consult "
  914    D POST^HM PEVNT(GMRC DFN,"consu lt",GMRCO, "") ; DE67 45 PB - Ad ded to mak e a call t o HMP to s ync the pa tient comm ents
  915    I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D
  916    . S GMRCO RTX="Comme nt Added t o remote c onsult "
  917    S GMRCORT X=GMRCORTX _$$ORTX^GM RCAU(+GMRC O)
  918    S GMRCRP= +$P(^GMR(1 23,GMRCO,0 ),U,14)
  919    S GMRCUPD =$$VALID^G MRCAU($P(^ GMR(123,+G MRCO,0),U, 5),GMRCO,D UZ)
  920    I GMRCRP= DUZ D  ;al ert team i f ord. pro v. takes t he action
  921    . S GMRCT M=1
  922    I GMRCUPD >1,GMRCRP' =DUZ D  ;  alert ord.  prov if u pdate user s takes ac tion
  923    . S GMRCA DUZ(GMRCRP )=""
  924    I '$G(GMR CTM),GMRCU PD<2 D  ;a lert both  if not ord . prov or  update use r
  925    . S GMRCT M=1,GMRCAD UZ(GMRCRP) =""
  926    D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,63, .GMRCADUZ, $G(GMRCTM) ,.GMRCFORC )
  927    Q
  928   SFILE(GMRC O,GMRCA,GM RCSF,GMRCO RNP,GMRCDU Z,GMRCOM,G MRCALF,GMR CATO,GMRCA D) ;Proces s various  file updat e function s from the  GUI for a  consult
  929    ; ADMIN C OMPLETE or  SIGNIFICA NT FINDING S
  930    ;Input va riables:
  931    ;GMRCO=Fi le 123 IEN  of the co nsult reco rd
  932    ;GMRCA=po inter to R EQUEST ACT ION TYPES  (#123.1) 1 0=complete , 4=Sig fi nd.
  933    ;GMRCSF=S ignificant  Findings  flag: 'Y'=  significa nt finding
  934    ; : 'N'=  no signifi cant findi ng
  935    ; : 'U'=u nknown sig nificant f inding
  936    ;GMRCORNP =Provider  Responsibl e for acti on
  937    ;GMRCDUZ= Person act ually doin g the acti on
  938    ;GMRCOM=A n array of  comments  by referen ce ARRAY(1 )="xxx",AR RAY(2)="xx x"
  939    ;GMRCALF= Flag to si gnal that  alerts are  to be sen t; 'N'=NO,  'Y'=YES
  940    ;GMRCATO= Who alerts  are to be  sent to;  a comma de limited st ring of DU Z's
  941    ;GMRCAD = FM date/ti me of acti vity
  942    ;
  943    ;Output:
  944    ; GMRCERR =Error Fla g: 0 if no  error, 1  if error o ccurred
  945    ; GMRCERM S - Error  message or  null
  946    ; returne d as GMRCE RR^GMRCERM S
  947    ;
  948    N GMRCERR ,GMRCERMS, GMRCTM
  949    L +^GMR(1 23,GMRCO): 5 I '$T S  GMRCERR=1, GMRCERMS=" Record Loc ked. File  Update Not  Accomplis hed." Q GM RCERR_"^"_ GMRCERMS
  950    S GMRCERR =0,GMRCTM= 0,GMRCERMS ="",DR="", GMRCORTX=" "
  951    N GMRCADU Z S GMRCAD UZ=""
  952    S GMRCNOW =$$NOW^XLF DT,GMRCSTS =$P(^GMR(1 23,+GMRCO, 0),"^",12) ,GMRCDFN=$ P(^(0),"^" ,2)
  953    I '$G(GMR CDUZ) S GM RCDUZ=DUZ
  954    I '$G(GMR CAD) S GMR CAD=GMRCNO W
  955    ;Insure c omment arr ay contain s text for  Complete  action.
  956    I GMRCA=1 0 D  I GMR CERR=1 S G MRCERMS="C omment fie ld must co ntain a te xt value!"  Q GMRCERR _"^"_GMRCE RMS
  957    . S GMRCE RR=1
  958    . I '$D(G MRCOM) Q
  959    . N GMRCO M1 S GMRCO M1=""
  960    . F  S GM RCOM1=$O(G MRCOM(GMRC OM1)) Q:(G MRCOM1=""! (GMRCERR=0 )) D
  961    .. I $TR( $G(GMRCOM( GMRCOM1)), " ","")'=" " S GMRCER R=0 Q
  962    I +$G(GMR CA),GMRCA= 10 D
  963    .S GMRCSF =$G(GMRCSF ,"")
  964    .S GMRCST S=2
  965    .S DR="8/ ///^S X=GM RCSTS;9/// /^S X=GMRC A;15////^S  X=GMRCSF"
  966    .S GMRCOR TX="Comple ted Consul t "_$$ORTX ^GMRCAU(+G MRCO)_$S(G MRCSF="Y": " with Sig  Findings" ,GMRCSF="N ":" with n o Sig Find ings",1:"" )
  967    .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))=""
  968    .Q
  969    I $G(GMRC ALF)=1 D
  970    .N I
  971    .F I=1:1  S X=$P(GMR CATO,";",I ) Q:X=""   S GMRCADUZ (X)=""
  972    .Q
  973    I $L(GMRC A),GMRCA=4  S DR=DR_$ S($L(DR):" ;",1:"")_" 9////^S X= GMRCA;15// //^S X=GMR CSF" D
  974    .S GMRCOR TX=$S(GMRC SF="Y":"Si g Findings  ",GMRCSF= "N":"No Si g Findings  ",1:"Unkn own Sig Fi ndings ")_ "for consu lt "_$$ORT X^GMRCAU(G MRCO)
  975    .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))=""
  976    .S GMRCUP D=$$VALID^ GMRCAU($P( ^GMR(123,+ GMRCO,0),U ,5),GMRCO, DUZ)
  977    .I +GMRCU PD<2 S GMR CTM=1
  978    .I +GMRCU PD>1,+$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)=DU Z S GMRCTM =1
  979    .Q
  980    I $L(DR)  S DIE="^GM R(123,",DA =GMRCO D ^ DIE K DIE, DR
  981    I '$O(GMR COM(0)) D  AUDIT^GMRC P
  982    I $D(GMRC OM),$O(GMR COM(0)) D
  983    .N DA
  984    .S DA=$$S ETDA()
  985    .D SETCOM (.GMRCOM,G MRCDUZ)
  986    .Q
  987    L -^GMR(1 23,GMRCO)
  988    ;
  989    D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,$S( GMRCA=20:6 3,1:23),.G MRCADUZ,GM RCTM)
  990    ;
  991    I $S(GMRC A=10:1,(GM RCA=4&($P( ^GMR(123,G MRCO,0),U, 12)=2)):1, 1:0) D
  992    . D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),"^" ,2),GMRCO, $G(GMRCTYP E),$G(GMRC RB),"RE",G MRCORNP,$G (GMRCVSIT) ,.GMRCOM,, GMRCAD)
  993    K DIE,DR, DA,GMRCDT, GMRCNOW,GM RCAD,GMRCO RNP,GMRCDU Z,GMRCRSLT ,GMRCSTS,G MRCADUZ,GM RCORTX,GMR CDFN
  994    Q GMRCERR _"^"_GMRCE RMS
  995    ;
  996   SCH(GMRCO, GMRCORNP,G MRCAD,GMRC ADUZ,GMRCM T) ;schedu le a consu lt API
  997    ; Input v ariables:
  998    ;GMRCO -  The intern al file nu mber of th e consult  from File  123
  999    ;GMRCORNP  - Name of  the perso n who actu ally 'Rece ived' the  consult
  1000    ;GMRCAD -  Actual da te time th at consult  was recei ved into t he service .
  1001    ;GMRCADUZ  - array o f alert re cipients a s chosen b y user (by  reference )
  1002    ; ARRAY(D UZ)=""
  1003    ;GMRCMT -  array of  comments i f entered  (by refere nce)
  1004    ; ARRAY(1 )="FIRST L INE OF COM MENT"
  1005    ; ARRAY(2 )="SECOND  LINE OF CO MMENT"
  1006    ;
  1007    ;Output:
  1008    ;GMRCERR  - Error Co ndition Co de: 0 = NO  error, 1= error
  1009    ;GMRCERMS  - Error m essage or  null
  1010    ; returne d as GMRCE RR^GMRCERM S
  1011           ;
  1012    N DFN,GMR CSTS,GMRCN OW,GMRCERR ,GMRCERMS
  1013    S GMRCERR =0,GMRCERM S="",GMRCN OW=$$NOW^X LFDT
  1014    S:$G(GMRC AD)="" GMR CAD=GMRCNO W
  1015    S:'$G(GMR CDUZ) GMRC DUZ=DUZ
  1016    S DFN=$P( $G(^GMR(12 3,GMRCO,0) ),"^",2) I  DFN="" D   Q GMRCERR _"^"_GMRCE RMS
  1017    . S GMRCE RR="1",GMR CERMS="Not  A Valid C onsult - F ile Not Fo und."
  1018    . D EXIT^ GMRCGUIA
  1019    S GMRCSTS =8,GMRCA=8
  1020    D STATUS^ GMRCP I $D (GMRCQUT)  D EXIT^GMR CGUIA Q GM RCERR_"^"_ GMRCERMS
  1021    I '$O(GMR CMT(0)) D  AUDIT^GMRC P
  1022    I $O(GMRC MT(0)) D
  1023    . S DA=$$ SETDA
  1024    . D SETCO M(.GMRCMT, GMRCDUZ)
  1025    D EN^GMRC HL7(DFN,GM RCO,"","", "SC",GMRCO RNP,"","", "",GMRCAD)
  1026    D  ;send  alerts
  1027    . N GMRCU PD,GMRCTM, TXT
  1028    . S TXT=" Scheduled  Consult: " _$$ORTX^GM RCAU(GMRCO )
  1029    . S GMRCT M=0
  1030    . I $P(^G MR(123,+GM RCO,0),U,1 4),$P(^GMR (123,+GMRC O,0),U,14) '=DUZ S GM RCADUZ($P( ^(0),U,14) )=""
  1031    . S GMRCU PD=$$VALID ^GMRCAU($P (^GMR(123, +GMRCO,0), U,5),GMRCO ,DUZ)
  1032    . I +GMRC UPD<2 S GM RCTM=1
  1033    . I +GMRC UPD>1,+$P( $G(^GMR(12 3,+GMRCO,0 )),U,14)=D UZ S GMRCT M=1
  1034    . D MSG^G MRCP(DFN,T XT,GMRCO,6 3,.GMRCADU Z,GMRCTM)
  1035    D EXIT^GM RCGUIA
  1036    Q GMRCERR _"^"_GMRCE RMS
  1037   DOCLIST(GM RCAR,GMRCD A,GMRCMED)  ;return l ist of lin ked result s
  1038    ; Input:
  1039    ; GMRCAR  - array to  return li st, passed  by refere nce
  1040    ; GMRCDA  - ien from  file 123
  1041    ; GMRCMED - 1 = incl ude med re sults; 0 =  only TIU  docs
  1042    ;
  1043    ; Output:
  1044    ; GMRCAR  - array in  format
  1045    ; GMRCAR( 0)=zero no de of reco rd
  1046    ; GMRCAR( 50,1)="ien ;global re f," e.g. 5 ;TIU(8925,  or 3;MCAR (691,
  1047    ; GMRCAR( 50,2)="ien ;global re f,"
  1048    ;
  1049    I '$D(^GM R(123,GMRC DA,0)) Q
  1050    S GMRCAR( 0)=^GMR(12 3,GMRCDA,0 ),$P(GMRCA R(0),U,20) =""
  1051    N RES,CNT  S RES="", CNT=1
  1052    F  S RES= $O(^GMR(12 3,GMRCDA,5 0,"B",RES) ) Q:RES=""   D
  1053    . I '$G(G MRCMED) Q: RES'["TIU( 8925"
  1054    . S GMRCA R(50,CNT)= RES
  1055    . I RES[" MCAR" D
  1056    .. N ARR, STR
  1057    .. D MEDL KUP^MCARUT L3(.ARR,+$ P(RES,"MCA R(",2),+RE S)
  1058    .. I '+AR R K GMRCAR (50,CNT) Q
  1059    .. S STR= $P(ARR,U,9 )_U_$P(ARR ,U,6)_$S($ P(ARR,U,10 ):"^^^^^^^ ^1",1:"")
  1060    .. S GMRC AR(50,CNT) =GMRCAR(50 ,CNT)_U_ST R
  1061    . S CNT=C NT+1
  1062    Q
  1063   After: 
  1064   GMRCGUIB ; SLC/DCM,JF R,MA/AFS,P B - GUI ac tions for  consults ; 01/10/18 1 3:55
  1065    ;;3.0;CON SULT/REQUE ST TRACKIN G;**4,12,1 8,20,17,22 ,29,30,35, 45,53,55,6 4,46,75,86 ,90,91,101 **;DEC 27,  1997;Buil d 4
  1066    ;
  1067    ; This ro utine invo kes IA #29 80
  1068    ; This ro utine invo kes IA #67 55 - DE674 5 - PB Apr  12, 2017
  1069    ;
  1070   SETDA() ;s et DA of w here audit  actions a re to be f iled
  1071    S:'$D(^GM R(123,+GMR CO,40,0))  ^GMR(123,G MRCO,40,0) ="^123.02D A^^"
  1072    S DA=$S($ P(^GMR(123 ,+GMRCO,40 ,0),"^",3) :$P(^(0)," ^",3)+1,1: 1)
  1073    S $P(^GMR (123,+GMRC O,40,0),"^ ",3,4)=DA_ "^"_DA
  1074    Q DA
  1075   REASON(GMR CFN,GMRCRQ ,GMRCDT) ; Load the r eason for  the reques t into ^GM R(123,GMRC O,20
  1076    ;GMRCFN=F ile 123 IF N; GMRCRQ= Array cont aining Rea son For Re quest
  1077    ;GMRCDT=D ate time o f entry
  1078    S ^GMR(12 3,GMRCFN,2 0,0)="^^^" _GMRCDT_"^ "
  1079    S L=0,LN= 1 F  S L=$ O(GMRCRQ(L )) Q:L=""   S ^GMR(12 3,GMRCFN,2 0,LN,0)=GM RCRQ(L),LN =LN+1
  1080    S LN=LN-1 ,$P(^GMR(1 23,GMRCFN, 20,0),"^", 3)=LN
  1081    K LN,L
  1082    Q
  1083   SETCOM(COM MENT,WHO)  ;Set comme nt array i nto tracki ng actions
  1084    N GMRCNOW ,DR,DIE
  1085    S GMRCNOW =$$NOW^XLF DT
  1086    I $P($G(^ GMR(123,+G MRCO,0))," ^",11)=$G( GMRCPA) S  GMRCPA=""
  1087    S DIE="^G MR(123,GMR CO,40,",DA (1)=GMRCO, DR=".01/// /^S X=GMRC NOW;1////^ S X=GMRCA; 2////^S X= GMRCAD;3// //^S X=$G( GMRCORNP); 4////^S X= $S($G(WHO) :WHO,1:DUZ );6////^S  X=$G(GMRCF R);8////^S  X=$G(GMRC FF);7////^ S X=$G(GMR CPA)"
  1088    D ^DIE
  1089    S ^GMR(12 3,GMRCO,40 ,DA,1,0)=" ^^^^"_GMRC AD_"^"
  1090    S (GMRCND ,GMRCND1)= 0 F  S GMR CND1=$O(CO MMENT(GMRC ND1)) Q:GM RCND1=""   S GMRCND=G MRCND+1,^G MR(123,GMR CO,40,DA,1 ,GMRCND,0) =COMMENT(G MRCND)
  1091    S $P(^GMR (123,GMRCO ,40,DA,1,0 ),"^",3)=G MRCND,$P(^ (0),"^",4) =GMRCND,^G MR(123,GMR CO,40,"B", GMRCNOW,DA )=""
  1092    D:$D(^GMR (123,+GMRC O,0)) AG12 3S1^GMRCXR (+GMRCO) ; alb/sat 86  - update  AG xref
  1093    ;
  1094    ; if an I FC, call e vent handl er to gene rate a msg  to remote  site
  1095    I $D(^GMR (123,+GMRC O,12)),$D( ^(40,DA))  D TRIGR^GM RCIEVT(GMR CO,DA)
  1096    ;
  1097    K GMRCND, GMRCND1
  1098    Q
  1099   CMT(GMRCO, GMRCOM,GMR CADUZ,GMRC WHN,GMRCWH O) ;add co mment to c onsult
  1100    ; GMRCO =  IEN from  file 123
  1101    ; GMRCOM  = array of  comments  in format  GMRCOM(1)= "xxxx", GM RCOM(2)="x xx"
  1102    ; GMRCADU Z = array  of alert r ecipients  as GMRCADU Z(DUZ)=""  (optional)
  1103    ; GMRCWHO  = IEN fro m file 200  who's res ponsible a ctivity (o ptional)
  1104    ; GMRCWHN  = date ti me of acti vity in FM  format
  1105    ; GMRCFOR C = copy o f GMRCADUZ ; these us ers will r ecieve ale rt 63 even  if alert  is turned  OFF; optio nal argume nt to MSG^ GMRCP
  1106    ;
  1107    N DA,GMRC A,GMRCAD,G MRCORTX,GM RCDFN,GMRC TM,GMRCRP, GMRCUPD,GM RCFORC
  1108    M GMRCFOR C=GMRCADUZ
  1109    S DA=$$SE TDA ; get  next activ ity tracki ng entry
  1110    S GMRCA=2 0,GMRCAD=G MRCWHN S:$ G(GMRCWHO)  GMRCORNP= GMRCWHO
  1111    D SETCOM( .GMRCOM,$G (GMRCWHO))
  1112    ;if a Non  VA Care c onsult, no tify HCP o f the comm ent
  1113    I $$FEE^G MRCHL7H($$ GET1^DIQ(1 23,+GMRCO, 1,"I")) D  COMMENT^GM RCHL7H(+GM RCO)
  1114    D  ;updat e LAST ACT ION field  even thoug h no statu s change
  1115    . N GMRCD R,GMRCSTS
  1116    . S GMRCS TS="",GMRC DR="9////2 0"
  1117    . D STATU S^GMRCP
  1118    S GMRCDFN =$P(^GMR(1 23,+GMRCO, 0),"^",2)
  1119    S GMRCORT X="Comment  Added to  Consult "
  1120    D POST^HM PEVNT(GMRC DFN,"consu lt",GMRCO, "") ; DE67 45 PB - Ad ded to mak e a call t o HMP to s ync the pa tient comm ents
  1121    I $P($G(^ GMR(123,GM RCO,12)),U ,5)="P" D
  1122    . S GMRCO RTX="Comme nt Added t o remote c onsult "
  1123    S GMRCORT X=GMRCORTX _$$ORTX^GM RCAU(+GMRC O)
  1124    S GMRCRP= +$P(^GMR(1 23,GMRCO,0 ),U,14)
  1125    S GMRCUPD =$$VALID^G MRCAU($P(^ GMR(123,+G MRCO,0),U, 5),GMRCO,D UZ)
  1126    I GMRCRP= DUZ D  ;al ert team i f ord. pro v. takes t he action
  1127    . S GMRCT M=1
  1128    I GMRCUPD >1,GMRCRP' =DUZ D  ;  alert ord.  prov if u pdate user s takes ac tion
  1129    . S GMRCA DUZ(GMRCRP )=""
  1130    I '$G(GMR CTM),GMRCU PD<2 D  ;a lert both  if not ord . prov or  update use r
  1131    . S GMRCT M=1,GMRCAD UZ(GMRCRP) =""
  1132    D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,63, .GMRCADUZ, $G(GMRCTM) ,.GMRCFORC )
  1133   I $D(^XPD( 9.7,"B","J VGMR 1.0") ),$$GET^XP AR("SYS"," GMRC DOD C MNT SIGF M ESSAGE",1)  D ;RTW NS R2018011
  1134    . D EN^GM RCHL7($P(^ GMR(123,GM RCO,0),"^" ,2),GMRCO, $G(GMRCTYP E),$G(GMRC RB),"SC",G MRCORNP,$G (GMRCVSIT) ,.GMRCOM,, GMRCAD) ;R TW NSR2018 0112 
  1135   Q
  1136   SFILE(GMRC O,GMRCA,GM RCSF,GMRCO RNP,GMRCDU Z,GMRCOM,G MRCALF,GMR CATO,GMRCA D) ;Proces s various  file updat e function s from the  GUI for a  consult
  1137    ; ADMIN C OMPLETE or  SIGNIFICA NT FINDING S
  1138    ;Input va riables:
  1139    ;GMRCO=Fi le 123 IEN  of the co nsult reco rd
  1140    ;GMRCA=po inter to R EQUEST ACT ION TYPES  (#123.1) 1 0=complete , 4=Sig fi nd.
  1141    ;GMRCSF=S ignificant  Findings  flag: 'Y'=  significa nt finding
  1142    ; : 'N'=  no signifi cant findi ng
  1143    ; : 'U'=u nknown sig nificant f inding
  1144    ;GMRCORNP =Provider  Responsibl e for acti on
  1145    ;GMRCDUZ= Person act ually doin g the acti on
  1146    ;GMRCOM=A n array of  comments  by referen ce ARRAY(1 )="xxx",AR RAY(2)="xx x"
  1147    ;GMRCALF= Flag to si gnal that  alerts are  to be sen t; 'N'=NO,  'Y'=YES
  1148    ;GMRCATO= Who alerts  are to be  sent to;  a comma de limited st ring of DU Z's
  1149    ;GMRCAD = FM date/ti me of acti vity
  1150    ;
  1151    ;Output:
  1152    ; GMRCERR =Error Fla g: 0 if no  error, 1  if error o ccurred
  1153    ; GMRCERM S - Error  message or  null
  1154    ; returne d as GMRCE RR^GMRCERM S
  1155    ;
  1156    N GMRCERR ,GMRCERMS, GMRCTM
  1157    L +^GMR(1 23,GMRCO): 5 I '$T S  GMRCERR=1, GMRCERMS=" Record Loc ked. File  Update Not  Accomplis hed." Q GM RCERR_"^"_ GMRCERMS
  1158    S GMRCERR =0,GMRCTM= 0,GMRCERMS ="",DR="", GMRCORTX=" "
  1159    N GMRCADU Z S GMRCAD UZ=""
  1160    S GMRCNOW =$$NOW^XLF DT,GMRCSTS =$P(^GMR(1 23,+GMRCO, 0),"^",12) ,GMRCDFN=$ P(^(0),"^" ,2)
  1161    I '$G(GMR CDUZ) S GM RCDUZ=DUZ
  1162    I '$G(GMR CAD) S GMR CAD=GMRCNO W
  1163    ;Insure c omment arr ay contain s text for  Complete  action.
  1164    I GMRCA=1 0 D  I GMR CERR=1 S G MRCERMS="C omment fie ld must co ntain a te xt value!"  Q GMRCERR _"^"_GMRCE RMS
  1165    . S GMRCE RR=1
  1166    . I '$D(G MRCOM) Q
  1167    . N GMRCO M1 S GMRCO M1=""
  1168    . F  S GM RCOM1=$O(G MRCOM(GMRC OM1)) Q:(G MRCOM1=""! (GMRCERR=0 )) D
  1169    .. I $TR( $G(GMRCOM( GMRCOM1)), " ","")'=" " S GMRCER R=0 Q
  1170    I +$G(GMR CA),GMRCA= 10 D
  1171    .S GMRCSF =$G(GMRCSF ,"")
  1172    .S GMRCST S=2
  1173    .S DR="8/ ///^S X=GM RCSTS;9/// /^S X=GMRC A;15////^S  X=GMRCSF"
  1174    .S GMRCOR TX="Comple ted Consul t "_$$ORTX ^GMRCAU(+G MRCO)_$S(G MRCSF="Y": " with Sig  Findings" ,GMRCSF="N ":" with n o Sig Find ings",1:"" )
  1175    .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))=""
  1176    .Q
  1177    I $G(GMRC ALF)=1 D
  1178    .N I
  1179    .F I=1:1  S X=$P(GMR CATO,";",I ) Q:X=""   S GMRCADUZ (X)=""
  1180    .Q
  1181    I $L(GMRC A),GMRCA=4  S DR=DR_$ S($L(DR):" ;",1:"")_" 9////^S X= GMRCA;15// //^S X=GMR CSF" D
  1182    .S GMRCOR TX=$S(GMRC SF="Y":"Si g Findings  ",GMRCSF= "N":"No Si g Findings  ",1:"Unkn own Sig Fi ndings ")_ "for consu lt "_$$ORT X^GMRCAU(G MRCO)
  1183    .I $P($G( ^GMR(123,+ GMRCO,0)), U,14),$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)'=D UZ S GMRCA DUZ($P($G( ^(0)),U,14 ))=""
  1184    .S GMRCUP D=$$VALID^ GMRCAU($P( ^GMR(123,+ GMRCO,0),U ,5),GMRCO, DUZ)
  1185    .I +GMRCU PD<2 S GMR CTM=1
  1186    .I +GMRCU PD>1,+$P($ G(^GMR(123 ,+GMRCO,0) ),U,14)=DU Z S GMRCTM =1
  1187    .Q
  1188    I $L(DR)  S DIE="^GM R(123,",DA =GMRCO D ^ DIE K DIE, DR
  1189    I '$O(GMR COM(0)) D  AUDIT^GMRC P
  1190    I $D(GMRC OM),$O(GMR COM(0)) D
  1191    .N DA
  1192    .S DA=$$S ETDA()
  1193    .D SETCOM (.GMRCOM,G MRCDUZ)
  1194    .Q
  1195    L -^GMR(1 23,GMRCO)
  1196    ;
  1197    D MSG^GMR CP(GMRCDFN ,GMRCORTX, +GMRCO,$S( GMRCA=20:6 3,1:23),.G MRCADUZ,GM RCTM)
  1198    ;
  1199   ;RTW BEGIN  NSR201801 12
  1200    ;I $S(GMR CA=10:1,(G MRCA=4&($P (^GMR(123, GMRCO,0),U ,12)=2)):1 ,1:0) D
  1201    I $D(^XPD (9.7,"B"," JVGMR 1.0" )),$$GET^X PAR("SYS", "GMRC DOD  CMNT SIGF  MESSAGE",1 ) D  ;RTW  NSR2018011 2
  1202    .D EN^GMR CHL7($P(^G MR(123,GMR CO,0),"^", 2),GMRCO,$ G(GMRCTYPE ),$G(GMRCR B),"SC",GM RCORNP,$G( GMRCVSIT), .GMRCOM,,G MRCAD) ;RT W NSR20180 112
  1203    K DIE,DR, DA,GMRCDT, GMRCNOW,GM RCAD,GMRCO RNP,GMRCDU Z,GMRCRSLT ,GMRCSTS,G MRCADUZ,GM RCORTX,GMR CDFN
  1204    Q GMRCERR _"^"_GMRCE RMS
  1205    ;
  1206   SCH(GMRCO, GMRCORNP,G MRCAD,GMRC ADUZ,GMRCM T) ;schedu le a consu lt API
  1207    ; Input v ariables:
  1208    ;GMRCO -  The intern al file nu mber of th e consult  from File  123
  1209    ;GMRCORNP  - Name of  the perso n who actu ally 'Rece ived' the  consult
  1210    ;GMRCAD -  Actual da te time th at consult  was recei ved into t he service .
  1211    ;GMRCADUZ  - array o f alert re cipients a s chosen b y user (by  reference )
  1212    ; ARRAY(D UZ)=""
  1213    ;GMRCMT -  array of  comments i f entered  (by refere nce)
  1214    ; ARRAY(1 )="FIRST L INE OF COM MENT"
  1215    ; ARRAY(2 )="SECOND  LINE OF CO MMENT"
  1216    ;
  1217    ;Output:
  1218    ;GMRCERR  - Error Co ndition Co de: 0 = NO  error, 1= error
  1219    ;GMRCERMS  - Error m essage or  null
  1220    ; returne d as GMRCE RR^GMRCERM S
  1221           ;
  1222    N DFN,GMR CSTS,GMRCN OW,GMRCERR ,GMRCERMS
  1223    S GMRCERR =0,GMRCERM S="",GMRCN OW=$$NOW^X LFDT
  1224    S:$G(GMRC AD)="" GMR CAD=GMRCNO W
  1225    S:'$G(GMR CDUZ) GMRC DUZ=DUZ
  1226    S DFN=$P( $G(^GMR(12 3,GMRCO,0) ),"^",2) I  DFN="" D   Q GMRCERR _"^"_GMRCE RMS
  1227    . S GMRCE RR="1",GMR CERMS="Not  A Valid C onsult - F ile Not Fo und."
  1228    . D EXIT^ GMRCGUIA
  1229    S GMRCSTS =8,GMRCA=8
  1230    D STATUS^ GMRCP I $D (GMRCQUT)  D EXIT^GMR CGUIA Q GM RCERR_"^"_ GMRCERMS
  1231    I '$O(GMR CMT(0)) D  AUDIT^GMRC P
  1232    I $O(GMRC MT(0)) D
  1233    . S DA=$$ SETDA
  1234    . D SETCO M(.GMRCMT, GMRCDUZ)
  1235    D EN^GMRC HL7(DFN,GM RCO,"","", "SC",GMRCO RNP,"","", "",GMRCAD)
  1236    D  ;send  alerts
  1237    . N GMRCU PD,GMRCTM, TXT
  1238    . S TXT=" Scheduled  Consult: " _$$ORTX^GM RCAU(GMRCO )
  1239    . S GMRCT M=0
  1240    . I $P(^G MR(123,+GM RCO,0),U,1 4),$P(^GMR (123,+GMRC O,0),U,14) '=DUZ S GM RCADUZ($P( ^(0),U,14) )=""
  1241    . S GMRCU PD=$$VALID ^GMRCAU($P (^GMR(123, +GMRCO,0), U,5),GMRCO ,DUZ)
  1242    . I +GMRC UPD<2 S GM RCTM=1
  1243    . I +GMRC UPD>1,+$P( $G(^GMR(12 3,+GMRCO,0 )),U,14)=D UZ S GMRCT M=1
  1244    . D MSG^G MRCP(DFN,T XT,GMRCO,6 3,.GMRCADU Z,GMRCTM)
  1245    D EXIT^GM RCGUIA
  1246    Q GMRCERR _"^"_GMRCE RMS
  1247   DOCLIST(GM RCAR,GMRCD A,GMRCMED)  ;return l ist of lin ked result s
  1248    ; Input:
  1249    ; GMRCAR  - array to  return li st, passed  by refere nce
  1250    ; GMRCDA  - ien from  file 123
  1251    ; GMRCMED - 1 = incl ude med re sults; 0 =  only TIU  docs
  1252    ;
  1253    ; Output:
  1254    ; GMRCAR  - array in  format
  1255    ; GMRCAR( 0)=zero no de of reco rd
  1256    ; GMRCAR( 50,1)="ien ;global re f," e.g. 5 ;TIU(8925,  or 3;MCAR (691,
  1257    ; GMRCAR( 50,2)="ien ;global re f,"
  1258    ;
  1259    I '$D(^GM R(123,GMRC DA,0)) Q
  1260    S GMRCAR( 0)=^GMR(12 3,GMRCDA,0 ),$P(GMRCA R(0),U,20) =""
  1261    N RES,CNT  S RES="", CNT=1
  1262    F  S RES= $O(^GMR(12 3,GMRCDA,5 0,"B",RES) ) Q:RES=""   D
  1263    . I '$G(G MRCMED) Q: RES'["TIU( 8925"
  1264    . S GMRCA R(50,CNT)= RES
  1265    . I RES[" MCAR" D
  1266    .. N ARR, STR
  1267    .. D MEDL KUP^MCARUT L3(.ARR,+$ P(RES,"MCA R(",2),+RE S)
  1268    .. I '+AR R K GMRCAR (50,CNT) Q
  1269    .. S STR= $P(ARR,U,9 )_U_$P(ARR ,U,6)_$S($ P(ARR,U,10 ):"^^^^^^^ ^1",1:"")
  1270    .. S GMRC AR(50,CNT) =GMRCAR(50 ,CNT)_U_ST R
  1271    . S CNT=C NT+1
  1272    Q
  1273   ========== ========== ========== ========== ========== ========== ========
  1274   GMRC101P ( New)
  1275   GMRC101P ; EPIP/RTW -  Post inst all for GM RC*3.0*101  consults  ;12/12/18  13:55
  1276    ;;3.0;CON SULT/REQUE ST TRACKIN G;**101**; DEC 27, 19 97;Build 2 9
  1277    ;
  1278   ADDPAR ;
  1279    ;N GMRCNM ,GMRCDTXT, GMRCVT,GMR CVDT,GMRCV DOM,GMRCVH ,GMRX,MSG, FDA2,FDA,G MRCMSG,GMR CGIEN,GMRC IDT,GMRCID OM,GMRCIH, GMRCKW,GMR CIT,GMRCPR EC,GMRCENT
  1280    N FDA,FDA 2,GMRCDTXT ,GMRCENT,G MRCGIEN,GM RCIDOM,GMR CIDT,GMRCI H,GMRCIT,G MRCKW,GMRC MSG,GMRCMV ,GMRCNM,GM RCPREC,GMR CVDOM,GMRC VDT,GMRCVH ,GMRCVT,GM RX,GMRXMV, GRMCMV,MSG
  1281    S (GMRCID T,GMRCIDOM ,GMRCIH,GM RCKW,GMRCI T,GMRCPREC ,GMRCENT)= ""
  1282    S GMRCNM= "" F GMRCN M="GMRC DO D CMNT SIG F MESSAGE" ,"GMRC NEW  NOTE ALER T DISABLE"  Q:GMRCNM= ""  D
  1283    . Q:$D(^X TV(8989.51 ,"B",GMRCN M))
  1284    . I GMRCN M="GMRC DO D CMNT SIG F MESSAGE"  D
  1285    . . S GMR CDTXT="DOD  CMT SF ME SSAGE ON O FF",GMRCMV =0,GMRCVT= "GENERATE  DOD COMMEN T MESSAGE  OFF",GMRCV DOM="0:OFF ;1:ON",GMR CVH="Enter  a 1 to tu rn on the  DOD COMMEN T MESSAGE  GENERATION  or a 0 to  turn it o ff."
  1286    . . S GMR CMSG(1)="D oD provide rs may ord er consult s that are  acted upo n by VA st aff. This  "
  1287    . . S GMR CMSG(2)="f unction al lows updat e messages  to be sen t to infor m the DoD  provider w hen"
  1288    . . S GMR CMSG(3)="a  comment o r signific ant findin g was adde d to the c onsult by  VA staff.  "
  1289    . . S GMR CMSG(4)="T hese comme nts commun icate info rmation su ch as when  the consu lt is"
  1290    . . S GMR CMSG(5)="s cheduled,  comments a bout resch eduling, a nd other e vents such  as when t he"
  1291    . . S GMR CMSG(6)="p atient doe s not show  up for th eir appoin tment. DoD  integrati on require s"
  1292    . . S GMR CMSG(7)="t he exchang e of order s and info rmation be tween the  VA and DoD  systems."
  1293    . I GMRCN M="GMRC NE W NOTE ALE RT DISABLE " D
  1294    . . S GMR CDTXT="Sup press New  TIU Note A lert",GMRC MV=1,GMRCV T="TIU Ale rt (Enable /Disable)  suppressio n."
  1295    . . S GMR CVDOM="E:E nable;D:Di sable",GMR CVH="Enter  'E' to en able, or ' D' to disa ble TIU ne w note pro vider aler t supressi on.",GMRCK W="REQUEST  SERVICE", GMRCIDT="P ",GMRCIDOM =123.5
  1296    . . S GMR CIH="Selec t a REQUES T SERVICE  Consult to  suppress  alerts.",G MRCIT="REQ UEST SERVI CE"
  1297    . . S GMR CMSG(1)="T his is use d in consu lt trackin g to suppr ess alerts  generated  when a ne w"
  1298    . . S GMR CMSG(2)="T IU note is  added dur ing comple tion. This  can suppr ess sendin g an alert "
  1299    . . S GMR CMSG(3)="t o the crea tor of the  consult w hen a new  note is ad ded."
  1300    . S GMRCP REC=1,GMRC ENT=4.2,GM RCVDT="S"
  1301    . S FDA(8 989.51,"+1 ,",.01)=GM RCNM
  1302    . S FDA(8 989.51,"+1 ,",.02)=GM RCDTXT
  1303    . S FDA(8 989.51,"+1 ,",.03)=GM RCMV
  1304    . S FDA(8 989.51,"+1 ,",.04)=GM RCIT
  1305    . S FDA(8 989.51,"+1 ,",.05)=GM RCVT
  1306    . S FDA(8 989.51,"+1 ,",1.1)=GM RCVDT
  1307    . S FDA(8 989.51,"+1 ,",1.2)=GM RCVDOM
  1308    . S FDA(8 989.51,"+1 ,",1.3)=GM RCVH
  1309    . S FDA(8 989.51,"+1 ,",6.1)=GM RCIDT
  1310    . S FDA(8 989.51,"+1 ,",6.2)=GM RCIDOM
  1311    . S FDA(8 989.51,"+1 ,",6.3)=GM RCIH
  1312    . D UPDAT E^DIE(""," FDA","FDAI EN","MSG")
  1313    . S GMRCG IEN=+$P($Q (^XTV(8989 .51,"B",GM RCNM)),"," ,4)
  1314    . D WP^DI E(8989.51, GMRCGIEN_" ,",20,,"GM RCMSG")
  1315    . S FDA2( 1,8989.513 ,"+2,"_GMR CGIEN_",", .01)=GMRCP REC
  1316    . S FDA2( 1,8989.513 ,"+2,"_GMR CGIEN_",", .02)=GMRCE NT
  1317    . D UPDAT E^DIE(""," FDA2(1)")
  1318    . K FDA,F DAIEN
  1319    I $D(MSG)  D  Q
  1320    . S GMRX= "Parameter  definitio n failed t o load. Th e followin g error me ssage was  returned:"
  1321    . W !
  1322    . D MES^X PDUTL(GMRX )
  1323    S GMRX="P arameter d efinitions  created s uccessfull y."
  1324    D MES^XPD UTL(GMRX)
  1325    Q
  1326   MENU ;add  new option s to the G MRC MGR me nu
  1327    ;GMRC MGR  class 1 M ENU
  1328    ;GMRC DOD  CMNT MESS AGE ON/OFF  new class  1 option
  1329    ;GMRC NEW  NOTE PARA METER EDIT  new class  1 option
  1330    N FDA,GMR COP,GMRCIE N,GMRCOPNM
  1331    S GMRCOP= +$P($Q(^DI C(19,"B"," GMRC MGR") ),",",4)
  1332    S GMRCOPN M="" F GMR COPNM="GMR C DOD CMNT  MESSAGE O N/OFF","GM RC NEW NOT E PARAMETE R EDIT" Q: GMRCOPNM=" "  D
  1333    . S GMRCI EN=0 S GMR CIEN=+$P($ Q(^DIC(19, "B",GMRCOP NM)),",",4 )
  1334    . S GMRCS YN=$S(GMRC OPNM["DOD" :"DOD",GMR COPNM["NEW ":"NN",1:0 )
  1335    . Q:$D(^D IC(19,GMRC OP,10,"B", GMRCIEN))
  1336    . S FDA(1 ,19.01,"+2 ,"_GMRCOP_ ",",.01)=G MRCIEN
  1337    . S FDA(1 ,19.01,"+2 ,"_GMRCOP_ ",",2)=GMR CSYN
  1338    . D UPDAT E^DIE(""," FDA(1)")
  1339    Q