10. EPMO Open Source Coordination Office Redaction File Detail Report

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

10.1 Files compared

# Location File Last Modified
1 MASS.zip\MASS SD-5.3-676.KID Wed Jun 6 15:15:06 2018 UTC
2 MASS.zip\MASS SD-5.3-676.KID Tue Jun 12 16:58:20 2018 UTC

10.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 9 23036
Changed 8 16
Inserted 0 0
Removed 0 0

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

10.4 Active regular expressions

No regular expressions were active.

10.5 Comparison detail

  1   KIDS Distr ibution sa ved on Jun  05, 2018@ 14:39:38
  2   SD v34
  3   **KIDS**:S D*5.3*676^
  4  
  5   **INSTALL  NAME**
  6   SD*5.3*676
  7   "BLD",1058 8,0)
  8   SD*5.3*676 ^SCHEDULIN G^0^318060 5^y
  9   "BLD",1058 8,1,0)
  10   ^^563^563^ 3180605^^^ ^
  11   "BLD",1058 8,1,1,0)
  12   Descriptio n:
  13   "BLD",1058 8,1,2,0)
  14   ---------- -- 
  15   "BLD",1058 8,1,3,0)
  16    
  17   "BLD",1058 8,1,4,0)
  18   The Medica l Appointm ent Schedu ling Syste m (MASS) p rogram wil l deploy a  
  19   "BLD",1058 8,1,5,0)
  20   commercial  schedulin g applicat ion to sup port sched ulers, and  ultimatel y
  21   "BLD",1058 8,1,6,0)
  22   our Vetera ns, within  the Chalm ers P. Wyl ie Departm ent of Vet erans 
  23   "BLD",1058 8,1,7,0)
  24   Affairs (V A) Ambulat ory Care C enter in C olumbus, O H. This de ployment 
  25   "BLD",1058 8,1,8,0)
  26   and integr ation will  allow the  VA to mov e from a c linic-base d scheduli ng
  27   "BLD",1058 8,1,9,0)
  28   system to  a resource -based sch eduling sy stem, ther eby standa rdizing an
  29   "BLD",1058 8,1,10,0)
  30   improving  scheduling  processes , providin g resource  supply ma nagement, 
  31   "BLD",1058 8,1,11,0)
  32   and delive ring impro ved access  to care f or our Vet erans. 
  33   "BLD",1058 8,1,12,0)
  34    
  35   "BLD",1058 8,1,13,0)
  36   The MASS I ndefinite  Delivery/I ndefinite  Quantity ( IDIQ) cont ract 
  37   "BLD",1058 8,1,14,0)
  38   establishe s the over arching re quirements  for the M ASS Contra ctor to 
  39   "BLD",1058 8,1,15,0)
  40   incrementa lly captur e requirem ents, desi gn, develo p, deploy,  implement
  41   "BLD",1058 8,1,16,0)
  42   and train  MASS acros s the VA h ealth care  enterpris e. This pr ogram 
  43   "BLD",1058 8,1,17,0)
  44   involves i nitiation,  design, a nd executi on of a pi lot site a
  45   "BLD",1058 8,1,18,0)
  46    
  47   "BLD",1058 8,1,19,0)
  48   Chalmers P . Wylie VA  Ambulator y Care Cen ter (herea fter refer red to as 
  49   "BLD",1058 8,1,20,0)
  50   the Columb us ACC and  its assoc iated Comm unity Base d Outpatie nt Clinics
  51   "BLD",1058 8,1,21,0)
  52   to demonst rate the M ASS busine ss value,  the integr ation of M ASS within  
  53   "BLD",1058 8,1,22,0)
  54   the VA ent erprise, t he impact  MASS will  have on va rious clin ical and 
  55   "BLD",1058 8,1,23,0)
  56   administra tive proce sses and w orkflows,  and the ef fort neces sary for t he 
  57   "BLD",1058 8,1,24,0)
  58   affected s takeholder s to adopt  these cha nges. 
  59   "BLD",1058 8,1,25,0)
  60    
  61   "BLD",1058 8,1,26,0)
  62   The enterp rise-wide  Medical Ap pointment  Scheduling  System (M ASS), 
  63   "BLD",1058 8,1,27,0)
  64   enabled by  Cadence,  will manag e the appo intment li fecycle, i mprove 
  65   "BLD",1058 8,1,28,0)
  66   clinical r esource ma nagement,  and inform  VHA manag ement at a ll 
  67   "BLD",1058 8,1,29,0)
  68   organizati onal level s with rea l-time bus iness, res ource util ization an
  69   "BLD",1058 8,1,30,0)
  70   demand, su pply, and  quality se rvice metr ics intell igence. Th e MASS 
  71   "BLD",1058 8,1,31,0)
  72   implementa tion will  address cr itical cha llenges fo r stakehol der and 
  73   "BLD",1058 8,1,32,0)
  74   user adopt ion across  the enter prise, sea mless inte gration wi th VistA, 
  75   "BLD",1058 8,1,33,0)
  76   and preser ver local  autonomy w hile intro ducing nat ionally st andardized
  77   "BLD",1058 8,1,34,0)
  78   rules and  workflows.
  79   "BLD",1058 8,1,35,0)
  80    
  81   "BLD",1058 8,1,36,0)
  82   The Schedu ling patch  SD*5.3*67 6 is the i nitial rel ease of th e MASS 
  83   "BLD",1058 8,1,37,0)
  84   scheduling  integrati on develop ment for t he VistA P ilot at Co lumbus, OH .
  85   "BLD",1058 8,1,38,0)
  86   This patch  includes  all of the  necessary  component s that wil l enable 
  87   "BLD",1058 8,1,39,0)
  88   bidirectio nal HL7 (H ealth Leve l 7) v2 SI U (Schedul ing Messag e) 
  89   "BLD",1058 8,1,40,0)
  90   scheduling  integrati on with MA SS.
  91   "BLD",1058 8,1,41,0)
  92    
  93   "BLD",1058 8,1,42,0)
  94   SD*5.3*676  patch enh ancements  include:
  95   "BLD",1058 8,1,43,0)
  96    
  97   "BLD",1058 8,1,44,0)
  98   1. Ability  to trigge r and buil d HL7v2 SI U messages  for any M ASS 
  99   "BLD",1058 8,1,45,0)
  100      schedul able clini cs. 
  101   "BLD",1058 8,1,46,0)
  102    
  103   "BLD",1058 8,1,47,0)
  104   2. Ability  to lock d own VistA  from perfo rming acti ons on the  appointme nts 
  105   "BLD",1058 8,1,48,0)
  106      now bei ng schedul ed in MASS .
  107   "BLD",1058 8,1,49,0)
  108    
  109   "BLD",1058 8,1,50,0)
  110   3. Include s a conver sion utili ty to sync  up VistA  and MASS w hen the 
  111   "BLD",1058 8,1,51,0)
  112      system  goes live.
  113   "BLD",1058 8,1,52,0)
  114      
  115   "BLD",1058 8,1,53,0)
  116    
  117   "BLD",1058 8,1,54,0)
  118   Patch Comp onents:
  119   "BLD",1058 8,1,55,0)
  120   ---------- -------
  121   "BLD",1058 8,1,56,0)
  122   HLO Applic ations:
  123   "BLD",1058 8,1,57,0)
  124   SD-SIU-OUT
  125   "BLD",1058 8,1,58,0)
  126   SD-SIU-IN
  127   "BLD",1058 8,1,59,0)
  128   SD-ACK-OUT
  129   "BLD",1058 8,1,60,0)
  130   HLO Logica l Links:
  131   "BLD",1058 8,1,61,0)
  132   SD SIU OUT
  133   "BLD",1058 8,1,62,0)
  134   SD ACK OUT
  135   "BLD",1058 8,1,63,0)
  136    
  137   "BLD",1058 8,1,64,0)
  138   Parameters :
  139   "BLD",1058 8,1,65,0)
  140   SDMX CLINI C RO FLAG  DEFAULT
  141   "BLD",1058 8,1,66,0)
  142   SDMX CONV  THREADS
  143   "BLD",1058 8,1,67,0)
  144   SDMX MASS  ENABLED
  145   "BLD",1058 8,1,68,0)
  146   SDMX PROVI DER TIME
  147   "BLD",1058 8,1,69,0)
  148   SDMX KIOSK  CHECK IN  ONLY 
  149   "BLD",1058 8,1,70,0)
  150   MASS ASCII  CHAR REPL ACEMENT 
  151   "BLD",1058 8,1,71,0)
  152   MASS ASCII  CHARACTER  SWITCH 
  153   "BLD",1058 8,1,72,0)
  154    
  155   "BLD",1058 8,1,73,0)
  156   Files & Fi elds Assoc iated:
  157   "BLD",1058 8,1,74,0)
  158    
  159   "BLD",1058 8,1,75,0)
  160   File Name  (Number)       Field  Name (Numb er)     Ne w/Modified /Deleted
  161   "BLD",1058 8,1,76,0)
  162   ---------- --------       ------ ---------- ---     -- ---------- --------
  163   "BLD",1058 8,1,77,0)
  164   HOSPITAL L OCATION (4 4)  MASS C LINIC FLAG  (22902)         New
  165   "BLD",1058 8,1,78,0)
  166    
  167   "BLD",1058 8,1,79,0)
  168    
  169   "BLD",1058 8,1,80,0)
  170   Forms Asso ciated:
  171   "BLD",1058 8,1,81,0)
  172    
  173   "BLD",1058 8,1,82,0)
  174   Form Name        File  #  New/Mo dified/Del eted
  175   "BLD",1058 8,1,83,0)
  176   ---------        ---- --  ------ ---------- ----
  177   "BLD",1058 8,1,84,0)
  178   N/A               N/A      N/A
  179   "BLD",1058 8,1,85,0)
  180    
  181   "BLD",1058 8,1,86,0)
  182    
  183   "BLD",1058 8,1,87,0)
  184   Mail Group s Associat ed:
  185   "BLD",1058 8,1,88,0)
  186    
  187   "BLD",1058 8,1,89,0)
  188    
  189   "BLD",1058 8,1,90,0)
  190   Mail Group  Name New/ Modified/D eleted
  191   "BLD",1058 8,1,91,0)
  192   ---------- ----- ---- ---------- ------
  193   "BLD",1058 8,1,92,0)
  194   N/A                 N /A
  195   "BLD",1058 8,1,93,0)
  196    
  197   "BLD",1058 8,1,94,0)
  198    
  199   "BLD",1058 8,1,95,0)
  200   Options As sociated:
  201   "BLD",1058 8,1,96,0)
  202    
  203   "BLD",1058 8,1,97,0)
  204   Option Nam e            Type     New/Modifi ed/Deleted
  205   "BLD",1058 8,1,98,0)
  206   ---------- -            ----     ---------- ----------  
  207   "BLD",1058 8,1,99,0)
  208   MASS CONVE RSION        MENU         NEW
  209   "BLD",1058 8,1,100,0)
  210   DGMX CONVE RSION RUN    ROUTINE      NEW
  211   "BLD",1058 8,1,101,0)
  212   ORMX CONV  MENU  RUN    ROUTINE      NEW
  213   "BLD",1058 8,1,102,0)
  214   SDMXFL  RU N            ROUTINE      NEW
  215   "BLD",1058 8,1,103,0)
  216    
  217   "BLD",1058 8,1,104,0)
  218    
  219   "BLD",1058 8,1,105,0)
  220   SDMX CONVE RSION RUN    ROUTINE      NEW
  221   "BLD",1058 8,1,106,0)
  222    
  223   "BLD",1058 8,1,107,0)
  224   Protocols  Associated :
  225   "BLD",1058 8,1,108,0)
  226    
  227   "BLD",1058 8,1,109,0)
  228   Protocol N ame   New/ Modified/D eleted
  229   "BLD",1058 8,1,110,0)
  230   ---------- ---   ---- ---------- ------ 
  231   "BLD",1058 8,1,111,0)
  232   SDAM APPOI NTMENT EVE NTS Modifi ed
  233   "BLD",1058 8,1,112,0)
  234   SD SIU TRI GGER  New
  235   "BLD",1058 8,1,113,0)
  236    
  237   "BLD",1058 8,1,114,0)
  238    
  239   "BLD",1058 8,1,115,0)
  240   Security K eys Associ ated:
  241   "BLD",1058 8,1,116,0)
  242    
  243   "BLD",1058 8,1,117,0)
  244   Security K ey Name
  245   "BLD",1058 8,1,118,0)
  246   ---------- -------
  247   "BLD",1058 8,1,119,0)
  248   N/A
  249   "BLD",1058 8,1,120,0)
  250    
  251   "BLD",1058 8,1,121,0)
  252   Templates  Associated :
  253   "BLD",1058 8,1,122,0)
  254    
  255   "BLD",1058 8,1,123,0)
  256   Template N ame   Type     File N ame (Numbe r)  New/Mo dified/Del eted 
  257   "BLD",1058 8,1,124,0)
  258   ---------- ---   ----     ------ ---------- --  ------ ---------- ----
  259   "BLD",1058 8,1,125,0)
  260   N/A               N/A      N/A                   N/A
  261   "BLD",1058 8,1,126,0)
  262    
  263   "BLD",1058 8,1,127,0)
  264    
  265   "BLD",1058 8,1,128,0)
  266   Additional  Informati on:
  267   "BLD",1058 8,1,129,0)
  268   N/A
  269   "BLD",1058 8,1,130,0)
  270    
  271   "BLD",1058 8,1,131,0)
  272   New Servic e Requests  (NSRs):
  273   "BLD",1058 8,1,132,0)
  274   ---------- ---------- --------  
  275   "BLD",1058 8,1,133,0)
  276   N/A
  277   "BLD",1058 8,1,134,0)
  278    
  279   "BLD",1058 8,1,135,0)
  280    
  281   "BLD",1058 8,1,136,0)
  282   Patient Sa fety Issue s (PSIs):
  283   "BLD",1058 8,1,137,0)
  284   ---------- ---------- ---------
  285   "BLD",1058 8,1,138,0)
  286   N/A
  287   "BLD",1058 8,1,139,0)
  288    
  289   "BLD",1058 8,1,140,0)
  290    
  291   "BLD",1058 8,1,141,0)
  292   Defect Tra cking Syst em Ticket( s) & Overv iew:
  293   "BLD",1058 8,1,142,0)
  294   ---------- ---------- ---------- ---------- ----
  295   "BLD",1058 8,1,143,0)
  296   N/A
  297   "BLD",1058 8,1,144,0)
  298    
  299   "BLD",1058 8,1,145,0)
  300   Problem:
  301   "BLD",1058 8,1,146,0)
  302   -------
  303   "BLD",1058 8,1,147,0)
  304   N/A
  305   "BLD",1058 8,1,148,0)
  306    
  307   "BLD",1058 8,1,149,0)
  308   Resolution :
  309   "BLD",1058 8,1,150,0)
  310   ----------
  311   "BLD",1058 8,1,151,0)
  312   N/A
  313   "BLD",1058 8,1,152,0)
  314    
  315   "BLD",1058 8,1,153,0)
  316   Test Sites :
  317   "BLD",1058 8,1,154,0)
  318   ----------
  319   "BLD",1058 8,1,155,0)
  320   N/A
  321   "BLD",1058 8,1,156,0)
  322    
  323   "BLD",1058 8,1,157,0)
  324    
  325   "BLD",1058 8,1,158,0)
  326   Software a nd Documen tation Ret rieval Ins tructions:
  327   "BLD",1058 8,1,159,0)
  328   ---------- ---------- ---------- ---------- ---------- -- 
  329   "BLD",1058 8,1,160,0)
  330   Software b eing relea sed as a h ost file a nd/or docu mentation  describing  
  331   "BLD",1058 8,1,161,0)
  332   the new fu nctionalit y introduc ed by this  patch are  available .
  333   "BLD",1058 8,1,162,0)
  334    
  335   "BLD",1058 8,1,163,0)
  336   The prefer red method  is to ret rieve file s from dow nload. DNS        . DNS     .
  337   "BLD",1058 8,1,164,0)
  338   This trans mits the f iles from  the first  available  server. Si tes may 
  339   "BLD",1058 8,1,165,0)
  340   also elect  to retrie ve files d irectly fr om a speci fic server
  341   "BLD",1058 8,1,166,0)
  342    
  343   "BLD",1058 8,1,167,0)
  344   Sites may  retrieve t he softwar e and/or d ocumentati on directl y using 
  345   "BLD",1058 8,1,168,0)
  346   Secure Fil e Transfer  Protocol  (SFTP) fro m the ANON YMOUS.SOFT WARE 
  347   "BLD",1058 8,1,169,0)
  348   directory  at the fol lowing 
  349   "BLD",1058 8,1,170,0)
  350   OI Field O ffices:
  351   "BLD",1058 8,1,171,0)
  352    
  353   "BLD",1058 8,1,172,0)
  354   Hines:  DN S     .URL          
  355   "BLD",1058 8,1,173,0)
  356   Salt Lake  City:        
. URL        
  357   "BLD",1058 8,1,174,0)
  358    
  359   "BLD",1058 8,1,175,0)
  360   Documentat ion can al so be foun d on the V A Software  Documenta tion Libra ry 
  361   "BLD",1058 8,1,176,0)
  362   at:
  363   "BLD",1058 8,1,177,0)
  364   http://www . DNS     /vdl/
  365   "BLD",1058 8,1,178,0)
  366    
  367   "BLD",1058 8,1,179,0)
  368    
  369   "BLD",1058 8,1,180,0)
  370   Title   Fi le Name        FTP Mo de
  371   "BLD",1058 8,1,181,0)
  372   ---------- ---------- ---------- ---------- ---------- ---------- ---------- -
  373   "BLD",1058 8,1,182,0)
  374    
  375   "BLD",1058 8,1,183,0)
  376    
  377   "BLD",1058 8,1,184,0)
  378   Patch Inst allation:
  379   "BLD",1058 8,1,185,0)
  380    
  381   "BLD",1058 8,1,186,0)
  382    
  383   "BLD",1058 8,1,187,0)
  384   Pre/Post I nstallatio n Overview :
  385   "BLD",1058 8,1,188,0)
  386   ---------- ---------- ---------- -
  387   "BLD",1058 8,1,189,0)
  388   N/A
  389   "BLD",1058 8,1,190,0)
  390    
  391   "BLD",1058 8,1,191,0)
  392   Pre-Instal lation Ins tructions:
  393   "BLD",1058 8,1,192,0)
  394   ---------- ---------- ----------
  395   "BLD",1058 8,1,193,0)
  396   This patch  may be in stalled wi th users o n the syst em althoug h it is 
  397   "BLD",1058 8,1,194,0)
  398   recommende d that it  be install ed during  non-peak h ours to mi nimize 
  399   "BLD",1058 8,1,195,0)
  400   potential  disruption  to users.  This patc h should t ake less t han 5 minu tes 
  401   "BLD",1058 8,1,196,0)
  402   to install .
  403   "BLD",1058 8,1,197,0)
  404    
  405   "BLD",1058 8,1,198,0)
  406   There are  no ListMan  Options t hat need t o be disab led for th is patch.
  407   "BLD",1058 8,1,199,0)
  408    
  409   "BLD",1058 8,1,200,0)
  410    
  411   "BLD",1058 8,1,201,0)
  412   Installati on Instruc tions:
  413   "BLD",1058 8,1,202,0)
  414   ---------- ---------- ------
  415   "BLD",1058 8,1,203,0)
  416    
  417   "BLD",1058 8,1,204,0)
  418   1.      Ch oose the P ackMan mes sage conta ining this  patch.
  419   "BLD",1058 8,1,205,0)
  420    
  421   "BLD",1058 8,1,206,0)
  422   2.      Ch oose the I NSTALL/CHE CK MESSAGE  PackMan o ption. 
  423   "BLD",1058 8,1,207,0)
  424    
  425   "BLD",1058 8,1,208,0)
  426   3.      Fr om the Ker nel Instal lation and  Distribut ion System  Menu, sel ect 
  427   "BLD",1058 8,1,209,0)
  428   the Instal lation Men u (See Ins tall Promp ts Sample  below for  more 
  429   "BLD",1058 8,1,210,0)
  430   detail).   From this  menu, you  may elect  to use the  following  options. 
  431   "BLD",1058 8,1,211,0)
  432   When promp ted for th e INSTALL  NAME enter  SD*5.3*67 6:
  433   "BLD",1058 8,1,212,0)
  434   a.      Ba ckup a Tra nsport Glo bal - This  option wi ll create  a backup 
  435   "BLD",1058 8,1,213,0)
  436   message of  any routi nes export ed with th is patch.  It will no t backup a ny 
  437   "BLD",1058 8,1,214,0)
  438   other chan ges such a s DDs or t emplates.
  439   "BLD",1058 8,1,215,0)
  440   b.      Co mpare Tran sport Glob al to Curr ent System  - This op tion will 
  441   "BLD",1058 8,1,216,0)
  442   allow you  to view al l changes  that will  be made wh en this pa tch is 
  443   "BLD",1058 8,1,217,0)
  444   installed.   It compa res all co mponents o f this pat ch routine s, DDs, 
  445   "BLD",1058 8,1,218,0)
  446   templates,  etc.
  447   "BLD",1058 8,1,219,0)
  448   c.      Ve rify Check sums in Tr ansport Gl obal - Thi s option w ill allow  you 
  449   "BLD",1058 8,1,220,0)
  450   to ensure  the integr ity of the  routines  that are i n the tran sport glob al.
  451   "BLD",1058 8,1,221,0)
  452   4.      Fr om the Ins tallation  Menu, sele ct the Ins tall Packa ge(s) opti on 
  453   "BLD",1058 8,1,222,0)
  454   and choose  the patch  to instal l.
  455   "BLD",1058 8,1,223,0)
  456    
  457   "BLD",1058 8,1,224,0)
  458   5.      Wh en prompte d 'Want KI DS to Rebu ild Menu T rees Upon  Completion  of 
  459   "BLD",1058 8,1,225,0)
  460   Install? N O//' Press  <Enter>.
  461   "BLD",1058 8,1,226,0)
  462    
  463   "BLD",1058 8,1,227,0)
  464   6.      Wh en prompte d 'Want KI DS to INHI BIT LOGONs  during th e install?  
  465   "BLD",1058 8,1,228,0)
  466   NO//'
  467   "BLD",1058 8,1,229,0)
  468   Press <Ent er>.
  469   "BLD",1058 8,1,230,0)
  470   7.      Wh en prompte d 'Want to  DISABLE S cheduled O ptions, Me nu Options
  471   "BLD",1058 8,1,231,0)
  472   and Protoc ols? NO//'  
  473   "BLD",1058 8,1,232,0)
  474   Press <Ent er>.
  475   "BLD",1058 8,1,233,0)
  476   8.      If  prompted  'Delay Ins tall (Minu tes):  (0  - 60): 0// ' respond  0.
  477   "BLD",1058 8,1,234,0)
  478    
  479   "BLD",1058 8,1,235,0)
  480    
  481   "BLD",1058 8,1,236,0)
  482   Install Pr ompts Samp le:
  483   "BLD",1058 8,1,237,0)
  484   ---------- ---------- ------
  485   "BLD",1058 8,1,238,0)
  486    
  487   "BLD",1058 8,1,239,0)
  488    
  489   "BLD",1058 8,1,240,0)
  490   VISTA>D ^X UP
  491   "BLD",1058 8,1,241,0)
  492    
  493   "BLD",1058 8,1,242,0)
  494   Setting up  programme r environm ent
  495   "BLD",1058 8,1,243,0)
  496   This is a  TEST accou nt.
  497   "BLD",1058 8,1,244,0)
  498    
  499   "BLD",1058 8,1,245,0)
  500   Terminal T ype set to : C-VT100
  501   "BLD",1058 8,1,246,0)
  502    
  503   "BLD",1058 8,1,247,0)
  504   Select OPT ION NAME:  XPD LOAD D ISTRIBUTIO N       Lo ad a Distr ibution
  505   "BLD",1058 8,1,248,0)
  506   Load a Dis tribution
  507   "BLD",1058 8,1,249,0)
  508   Enter a Ho st File: C :\HFS\SD_5 _3_676.KID
  509   "BLD",1058 8,1,250,0)
  510    
  511   "BLD",1058 8,1,251,0)
  512   KIDS Distr ibution sa ved on Dec  11, 2017@ 17:30:58
  513   "BLD",1058 8,1,252,0)
  514   Comment: S D*5.3*676  12/11/17
  515   "BLD",1058 8,1,253,0)
  516    
  517   "BLD",1058 8,1,254,0)
  518   This Distr ibution co ntains Tra nsport Glo bals for t he followi ng Package (s):
  519   "BLD",1058 8,1,255,0)
  520   Build SD*5 .3*676 has  been load ed before,  here is w hen: 
  521   "BLD",1058 8,1,256,0)
  522         SD*5 .3*676   I nstall Com pleted
  523   "BLD",1058 8,1,257,0)
  524                       w as loaded  on Oct 05,  2017@22:2 9:55
  525   "BLD",1058 8,1,258,0)
  526         SD*5 .3*676   I nstall Com pleted
  527   "BLD",1058 8,1,259,0)
  528                       w as loaded  on Oct 10,  2017@16:0 3:37
  529   "BLD",1058 8,1,260,0)
  530         SD*5 .3*676   I nstall Com pleted
  531   "BLD",1058 8,1,261,0)
  532                       w as loaded  on Nov 15,  2017@00:1 2:36
  533   "BLD",1058 8,1,262,0)
  534         SD*5 .3*676   I nstall Com pleted
  535   "BLD",1058 8,1,263,0)
  536                       w as loaded  on Nov 20,  2017@14:5 9:25
  537   "BLD",1058 8,1,264,0)
  538         SD*5 .3*676   I nstall Com pleted
  539   "BLD",1058 8,1,265,0)
  540                       w as loaded  on Nov 20,  2017@20:4 0:22
  541   "BLD",1058 8,1,266,0)
  542         SD*5 .3*676   I nstall Com pleted
  543   "BLD",1058 8,1,267,0)
  544                       w as loaded  on Nov 21,  2017@15:4 0:34
  545   "BLD",1058 8,1,268,0)
  546         SD*5 .3*676   I nstall Com pleted
  547   "BLD",1058 8,1,269,0)
  548                       w as loaded  on Nov 30,  2017@15:0 5:44
  549   "BLD",1058 8,1,270,0)
  550         SD*5 .3*676   I nstall Com pleted
  551   "BLD",1058 8,1,271,0)
  552                       w as loaded  on Dec 05,  2017@16:1 6:46
  553   "BLD",1058 8,1,272,0)
  554   OK to cont inue with  Load? NO//  YES
  555   "BLD",1058 8,1,273,0)
  556    
  557   "BLD",1058 8,1,274,0)
  558    
  559   "BLD",1058 8,1,275,0)
  560   Distributi on OK!
  561   "BLD",1058 8,1,276,0)
  562    
  563   "BLD",1058 8,1,277,0)
  564   Want to Co ntinue wit h Load? YE S// 
  565   "BLD",1058 8,1,278,0)
  566   Loading Di stribution ...
  567   "BLD",1058 8,1,279,0)
  568    
  569   "BLD",1058 8,1,280,0)
  570      SD*5.3* 676
  571   "BLD",1058 8,1,281,0)
  572    
  573   "BLD",1058 8,1,282,0)
  574   Use INSTAL L NAME: SD *5.3*676 t o install  this Distr ibution.
  575   "BLD",1058 8,1,283,0)
  576    
  577   "BLD",1058 8,1,284,0)
  578    
  579   "BLD",1058 8,1,285,0)
  580   VISTA>D ^X UP
  581   "BLD",1058 8,1,286,0)
  582    
  583   "BLD",1058 8,1,287,0)
  584   Setting up  programme r environm ent
  585   "BLD",1058 8,1,288,0)
  586    
  587   "BLD",1058 8,1,289,0)
  588   This is a  TEST accou nt.
  589   "BLD",1058 8,1,290,0)
  590    
  591   "BLD",1058 8,1,291,0)
  592   Terminal T ype set to : C-VT100
  593   "BLD",1058 8,1,292,0)
  594    
  595   "BLD",1058 8,1,293,0)
  596   Select OPT ION NAME:  XPD INS
  597   "BLD",1058 8,1,294,0)
  598        1   X PD INSTALL  BUILD        Install  Package(s )
  599   "BLD",1058 8,1,295,0)
  600        2   X PD INSTALL ATION MENU        Ins tallation
  601   "BLD",1058 8,1,296,0)
  602   CHOOSE 1-2 : 1  XPD I NSTALL BUI LD     Ins tall Packa ge(s)
  603   "BLD",1058 8,1,297,0)
  604   Install Pa ckage(s)
  605   "BLD",1058 8,1,298,0)
  606   Select INS TALL NAME:  SD*5.3*67 6       Lo aded from  Distributi on    
  607   "BLD",1058 8,1,299,0)
  608   12/12/17@2 3:49
  609   "BLD",1058 8,1,300,0)
  610   :43
  611   "BLD",1058 8,1,301,0)
  612        => SD *5.3*676 1 2/11/17  ; Created on  Dec 11, 2 017@17:30: 58
  613   "BLD",1058 8,1,302,0)
  614    
  615   "BLD",1058 8,1,303,0)
  616   This Distr ibution wa s loaded o n Dec 12,  2017@23:49 :43 with h eader of 
  617   "BLD",1058 8,1,304,0)
  618      SD*5.3* 676 12/11/ 17  ;Creat ed on Dec  11, 2017@1 7:30:58
  619   "BLD",1058 8,1,305,0)
  620      It cons isted of t he followi ng Install (s):
  621   "BLD",1058 8,1,306,0)
  622        SD*5. 3*676
  623   "BLD",1058 8,1,307,0)
  624   Checking I nstall for  Package S D*5.3*676
  625   "BLD",1058 8,1,308,0)
  626    
  627   "BLD",1058 8,1,309,0)
  628   Install Qu estions fo r SD*5.3*6 76
  629   "BLD",1058 8,1,310,0)
  630    
  631   "BLD",1058 8,1,311,0)
  632   Incoming F iles:
  633   "BLD",1058 8,1,312,0)
  634    
  635   "BLD",1058 8,1,313,0)
  636      44         HOSPITA L LOCATION   (Partial  Definitio n)
  637   "BLD",1058 8,1,314,0)
  638   Note:  You  already h ave the 'H OSPITAL LO CATION' Fi le.
  639   "BLD",1058 8,1,315,0)
  640    
  641   "BLD",1058 8,1,316,0)
  642   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install?  NO// 
  643   "BLD",1058 8,1,317,0)
  644    
  645   "BLD",1058 8,1,318,0)
  646    
  647   "BLD",1058 8,1,319,0)
  648   Want KIDS  to INHIBIT  LOGONs du ring the i nstall? NO // 
  649   "BLD",1058 8,1,320,0)
  650   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls? NO// 
  651   "BLD",1058 8,1,321,0)
  652    
  653   "BLD",1058 8,1,322,0)
  654   Enter the  Device you  want to p rint the I nstall mes sages.
  655   "BLD",1058 8,1,323,0)
  656   You can qu eue the in stall by e nter a 'Q'  at the de vice promp t.
  657   "BLD",1058 8,1,324,0)
  658   Enter a '^ ' to abort  the insta ll.
  659   "BLD",1058 8,1,325,0)
  660    
  661   "BLD",1058 8,1,326,0)
  662   DEVICE: HO ME//   CON SOLE
  663   "BLD",1058 8,1,327,0)
  664    
  665   "BLD",1058 8,1,328,0)
  666    Install S tarted for  SD*5.3*67 6 : 
  667   "BLD",1058 8,1,329,0)
  668                   Dec 1 2, 2017@23 :51:21
  669   "BLD",1058 8,1,330,0)
  670    
  671   "BLD",1058 8,1,331,0)
  672   Build Dist ribution D ate: Dec 1 1, 2017
  673   "BLD",1058 8,1,332,0)
  674    
  675   "BLD",1058 8,1,333,0)
  676    Installin g Routines :
  677   "BLD",1058 8,1,334,0)
  678                    Dec  12, 2017@2 3:51:22
  679   "BLD",1058 8,1,335,0)
  680    
  681   "BLD",1058 8,1,336,0)
  682    Installin g Data Dic tionaries:  
  683   "BLD",1058 8,1,337,0)
  684                    Dec  12, 2017@2 3:51:22
  685   "BLD",1058 8,1,338,0)
  686    
  687   "BLD",1058 8,1,339,0)
  688    Installin g PACKAGE  COMPONENTS
  689   "BLD",1058 8,1,340,0)
  690    
  691   "BLD",1058 8,1,341,0)
  692    Installin g PROTOCOL
  693   "BLD",1058 8,1,342,0)
  694    
  695   "BLD",1058 8,1,343,0)
  696    Installin g OPTION
  697   "BLD",1058 8,1,344,0)
  698    
  699   "BLD",1058 8,1,345,0)
  700    Installin g PARAMETE R DEFINITI ON
  701   "BLD",1058 8,1,346,0)
  702    
  703   "BLD",1058 8,1,347,0)
  704    Installin g HLO APPL ICATION RE GISTRY
  705   "BLD",1058 8,1,348,0)
  706                    Dec  12, 2017@2 3:51:23
  707   "BLD",1058 8,1,349,0)
  708    
  709   "BLD",1058 8,1,350,0)
  710    Updating  Routine fi le...
  711   "BLD",1058 8,1,351,0)
  712    
  713   "BLD",1058 8,1,352,0)
  714    Updating  KIDS files ...
  715   "BLD",1058 8,1,353,0)
  716    
  717   "BLD",1058 8,1,354,0)
  718    SD*5.3*67 6 Installe d. 
  719   "BLD",1058 8,1,355,0)
  720                   Dec 1 2, 2017@23 :51:23
  721   "BLD",1058 8,1,356,0)
  722    
  723   "BLD",1058 8,1,357,0)
  724    No link t o PACKAGE  file
  725   "BLD",1058 8,1,358,0)
  726    
  727   "BLD",1058 8,1,359,0)
  728    NO Instal l Message  sent 
  729   "BLD",1058 8,1,360,0)
  730    
  731   "BLD",1058 8,1,361,0)
  732   Install Co mpleted
  733   "BLD",1058 8,1,362,0)
  734    
  735   "BLD",1058 8,1,363,0)
  736   VISTA>
  737   "BLD",1058 8,1,364,0)
  738    
  739   "BLD",1058 8,1,365,0)
  740    
  741   "BLD",1058 8,1,366,0)
  742   Patch Back out Instru ctions:
  743   "BLD",1058 8,1,367,0)
  744   ---------- ---------- ------
  745   "BLD",1058 8,1,368,0)
  746   1.      Go  to MailMa n menu, ch oose optio n Read/Man age Messag es and sel ect 
  747   "BLD",1058 8,1,369,0)
  748   the backup  message t hat was cr eating dur ing Instal lation ste p 3.c - Ba ckup
  749   "BLD",1058 8,1,370,0)
  750   2.      Wh en prompte d 'Type <E nter> to c ontinue or  '^' to ex it:' type  '^' 
  751   "BLD",1058 8,1,371,0)
  752   and then < Enter>
  753   "BLD",1058 8,1,372,0)
  754   3.      Wh en prompte d 'Enter m essage act ion:' type  'Xtract P ackMan' an
  755   "BLD",1058 8,1,373,0)
  756   then <Ente r>
  757   "BLD",1058 8,1,374,0)
  758   4.      Th e followin g message  and the pr ompt will  display:
  759   "BLD",1058 8,1,375,0)
  760   Warning: I nstalling  this messa ge will ca use a perm anent upda te of glob als 
  761   "BLD",1058 8,1,376,0)
  762   and routin es.
  763   "BLD",1058 8,1,377,0)
  764   Do you rea lly want t o do this?  NO//' typ e 'YES' an d then <En ter>
  765   "BLD",1058 8,1,378,0)
  766   5.      Wh en prompte d: 
  767   "BLD",1058 8,1,379,0)
  768   'Shall I p reserve th e routines  on disk i n a separa te back-up  message? 
  769   "BLD",1058 8,1,380,0)
  770   YES//' typ e 'NO' and  then <Ent er>
  771   "BLD",1058 8,1,381,0)
  772   6.      Th e system w ill displa y the foll owing mess age and sh ow all the  
  773   "BLD",1058 8,1,382,0)
  774   routines t hat were u nloaded co nfirming t hat all th e routines  in the bu ild 
  775   "BLD",1058 8,1,383,0)
  776   have been  restored t o the prio r version  (unloaded) :
  777   "BLD",1058 8,1,384,0)
  778   'No backup  message b uilt.
  779   "BLD",1058 8,1,385,0)
  780    ***LIST o f routines  from back up. See fu ll routine  list at t he end of  the 
  781   "BLD",1058 8,1,386,0)
  782   document** *
  783   "BLD",1058 8,1,387,0)
  784    
  785   "BLD",1058 8,1,388,0)
  786   Select Pac kMan funct ion: and t hen <Enter >'
  787   "BLD",1058 8,1,389,0)
  788   7.      ne xVerify th at all six  routines  are listed  as above  have been 
  789   "BLD",1058 8,1,390,0)
  790   backed out :
  791   "BLD",1058 8,1,391,0)
  792   No backup  message bu ilt.
  793   "BLD",1058 8,1,392,0)
  794   When promp ted 'Want  KIDS to IN HIBIT LOGO Ns during  the instal l? NO//'
  795   "BLD",1058 8,1,393,0)
  796   Press <Ent er>.
  797   "BLD",1058 8,1,394,0)
  798   When promp ted 'Want  to DISABLE  Scheduled  Options,  Menu Optio ns, and 
  799   "BLD",1058 8,1,395,0)
  800   Protocols?  NO//' 
  801   "BLD",1058 8,1,396,0)
  802   Press <Ent er>.
  803   "BLD",1058 8,1,397,0)
  804   If prompte d 'Delay I nstall (Mi nutes):  ( 0 - 60): 0 //' respon d 0.
  805   "BLD",1058 8,1,398,0)
  806   8.      Th ere are no  globals t hat are be ing saved  off for th is patch t
  807   "BLD",1058 8,1,399,0)
  808   restore. A ll other o bjects sho uld be man ually back ed out or  deleted 
  809   "BLD",1058 8,1,400,0)
  810   Fileman. 
  811   "BLD",1058 8,1,401,0)
  812   9.      De leting Fil es:
  813   "BLD",1058 8,1,402,0)
  814   The follow ing FileMa n files sh ould be de leted unde r their re spective 
  815   "BLD",1058 8,1,403,0)
  816   groups. To  delete th e file, op en FileMan  for the f ile specif ied. Look  for 
  817   "BLD",1058 8,1,404,0)
  818   the name a nd once se lected ent er @ to en ter the de lete optio n.
  819   "BLD",1058 8,1,405,0)
  820    
  821   "BLD",1058 8,1,406,0)
  822   Example:
  823   "BLD",1058 8,1,407,0)
  824   VA FileMan  22.2
  825   "BLD",1058 8,1,408,0)
  826    
  827   "BLD",1058 8,1,409,0)
  828    
  829   "BLD",1058 8,1,410,0)
  830   Select OPT ION: 1  EN TER OR EDI T FILE ENT RIES
  831   "BLD",1058 8,1,411,0)
  832    
  833   "BLD",1058 8,1,412,0)
  834   Input to w hat File:  PROTOCOL//              (4498 en tries)
  835   "BLD",1058 8,1,413,0)
  836   EDIT WHICH  FIELD: AL L//
  837   "BLD",1058 8,1,414,0)
  838    
  839   "BLD",1058 8,1,415,0)
  840   Select PRO TOCOL NAME : SD SIU T RIGGER        SD SIU  TRIGGER
  841   "BLD",1058 8,1,416,0)
  842   NAME: SD S IU TRIGGER // @
  843   "BLD",1058 8,1,417,0)
  844      SURE YO U WANT TO  DELETE THE  ENTIRE 'S D SIU TRIG GER' PROTO COL?
  845   "BLD",1058 8,1,418,0)
  846    
  847   "BLD",1058 8,1,419,0)
  848   10.     Mo difying fi les:
  849   "BLD",1058 8,1,420,0)
  850   The follow ing files  can be upd ated in Fi leMan but  they are e xisting 
  851   "BLD",1058 8,1,421,0)
  852   files. The y should n ot be dele ted. Inste ad reverti ng them ba ck will be  
  853   "BLD",1058 8,1,422,0)
  854   the correc t approach .
  855   "BLD",1058 8,1,423,0)
  856    
  857   "BLD",1058 8,1,424,0)
  858   Example:
  859   "BLD",1058 8,1,425,0)
  860    
  861   "BLD",1058 8,1,426,0)
  862   VA FileMan  22.2
  863   "BLD",1058 8,1,427,0)
  864    
  865   "BLD",1058 8,1,428,0)
  866    
  867   "BLD",1058 8,1,429,0)
  868   Select OPT ION: 1  EN TER OR EDI T FILE ENT RIES
  869   "BLD",1058 8,1,430,0)
  870    
  871   "BLD",1058 8,1,431,0)
  872   Input to w hat File:  PROTOCOL//              (4498 en tries)
  873   "BLD",1058 8,1,432,0)
  874   EDIT WHICH  FIELD: AL L// item
  875   "BLD",1058 8,1,433,0)
  876        1   I TEM    (mu ltiple)
  877   "BLD",1058 8,1,434,0)
  878        2   I TEM TEXT
  879   "BLD",1058 8,1,435,0)
  880   CHOOSE 1-2 : 1  ITEM   (multiple )
  881   "BLD",1058 8,1,436,0)
  882      EDIT WH ICH ITEM S UB-FIELD:  ALL//
  883   "BLD",1058 8,1,437,0)
  884   THEN EDIT  FIELD:
  885   "BLD",1058 8,1,438,0)
  886    
  887   "BLD",1058 8,1,439,0)
  888   Select PRO TOCOL NAME : SDAM APP OINTMENT E VENTS        Appointm ent Event 
  889   "BLD",1058 8,1,440,0)
  890   Driver
  891   "BLD",1058 8,1,441,0)
  892   Select ITE M: SD SIU  TRIGGER//  SD SIU TRI GGER        SD SIU TR IGGER
  893   "BLD",1058 8,1,442,0)
  894            . ..OK? Yes/ /   (Yes)
  895   "BLD",1058 8,1,443,0)
  896    
  897   "BLD",1058 8,1,444,0)
  898     ITEM: SD  SIU TRIGG ER// @
  899   "BLD",1058 8,1,445,0)
  900      SURE YO U WANT TO  DELETE THE  ENTIRE IT EM?
  901   "BLD",1058 8,1,446,0)
  902    
  903   "BLD",1058 8,1,447,0)
  904   Protocol:
  905   "BLD",1058 8,1,448,0)
  906   SDAM APPOI NTMENT EVE NTS
  907   "BLD",1058 8,1,449,0)
  908   1.      Re move SD SI U TRIGGER  from the I tem list
  909   "BLD",1058 8,1,450,0)
  910    
  911   "BLD",1058 8,1,451,0)
  912   11.     To  clean up  the item r un BACKOUT ^SDMXPOST  to clean u p the cros
  913   "BLD",1058 8,1,452,0)
  914   references .
  915   "BLD",1058 8,1,453,0)
  916    
  917   "BLD",1058 8,1,454,0)
  918   VISTA>D BA CKOUT^SDMX POST
  919   "BLD",1058 8,1,455,0)
  920    
  921   "BLD",1058 8,1,456,0)
  922   Backup fil e Temporar y backup f ile: found ; restore  commencing ... Restor ing 
  923   "BLD",1058 8,1,457,0)
  924   data dicti onary for  file #44.. . SD*5.3*6 76 Back ou t finished !
  925   "BLD",1058 8,1,458,0)
  926    
  927   "BLD",1058 8,1,459,0)
  928   VISTA>
  929   "BLD",1058 8,1,460,0)
  930    
  931   "BLD",1058 8,1,461,0)
  932   Post-Insta llation In structions :
  933   "BLD",1058 8,1,462,0)
  934   ---------- ---------- ---------- -
  935   "BLD",1058 8,1,463,0)
  936   See Techni cal Manual  for cross  reference /object co ntents ver ification
  937   "BLD",1058 8,1,464,0)
  938    
  939   "BLD",1058 8,1,465,0)
  940   Check list  to Verify :
  941   "BLD",1058 8,1,466,0)
  942   1.      It em 22902 i n the hosp ital locat ion file.
  943   "BLD",1058 8,1,467,0)
  944   2.      HL O Applicat ions
  945   "BLD",1058 8,1,468,0)
  946   3.      HL  Logical L inks
  947   "BLD",1058 8,1,469,0)
  948   4.      Pr otocol
  949   "BLD",1058 8,1,470,0)
  950   5.      Pa rameters
  951   "BLD",1058 8,1,471,0)
  952   6.      Op tions
  953   "BLD",1058 8,1,472,0)
  954    
  955   "BLD",1058 8,1,473,0)
  956    
  957   "BLD",1058 8,1,474,0)
  958   Routine In formation:
  959   "BLD",1058 8,1,475,0)
  960   ========== ==========
  961   "BLD",1058 8,1,476,0)
  962    
  963   "BLD",1058 8,1,477,0)
  964    
  965   "BLD",1058 8,1,478,0)
  966   The second  line of e ach of the se routine s now look s like:
  967   "BLD",1058 8,1,479,0)
  968    ;;5.3;Sch eduling;** [Patch Lis t]**;Aug 1 3, 1993;Bu ild 63
  969   "BLD",1058 8,1,480,0)
  970    
  971   "BLD",1058 8,1,481,0)
  972   The checks ums below  are new ch ecksums, a nd
  973   "BLD",1058 8,1,482,0)
  974    
  975   "BLD",1058 8,1,483,0)
  976    can be ch ecked with  CHECK1^XT SUMBLD.
  977   "BLD",1058 8,1,484,0)
  978    
  979   "BLD",1058 8,1,485,0)
  980   Routine Na me: SDAM
  981   "BLD",1058 8,1,486,0)
  982       Before : B1000938 2   After:  B10247694   **149,17 7,76,242,3 80,676**
  983   "BLD",1058 8,1,487,0)
  984   Routine Na me: SDAM2
  985   "BLD",1058 8,1,488,0)
  986       Before : B3080301 8   After:  B31432956   **250,29 6,327,478, 446,627,67 6**
  987   "BLD",1058 8,1,489,0)
  988   Routine Na me: SDAM3
  989   "BLD",1058 8,1,490,0)
  990       Before : B1089527 5   After:  B11043233   **63,189 ,380,478,4 92,676**
  991   "BLD",1058 8,1,491,0)
  992   Routine Na me: SDAMC
  993   "BLD",1058 8,1,492,0)
  994       Before : B1537679 7   After:  B15498369   **20,28, 32,46,263, 414,444,47 8,
  995   "BLD",1058 8,1,493,0)
  996                                                  538,554 ,597,592,6 76**
  997   "BLD",1058 8,1,494,0)
  998   Routine Na me: SDAMEX
  999   "BLD",1058 8,1,495,0)
  1000       Before : B2359620 8   After:  B23902444   *676*
  1001   "BLD",1058 8,1,496,0)
  1002   Routine Na me: SDAMN
  1003   "BLD",1058 8,1,497,0)
  1004       Before :  B727263 7   After:   B7440404   **478,67 6**
  1005   "BLD",1058 8,1,498,0)
  1006   Routine Na me: SDAMWI
  1007   "BLD",1058 8,1,499,0)
  1008       Before : B1313891 3   After:  B13400175   
  1009   "BLD",1058 8,1,500,0)
  1010   **63,94,24 1,250,296, 380,327,67 6**
  1011   "BLD",1058 8,1,501,0)
  1012   Routine Na me: SDC
  1013   "BLD",1058 8,1,502,0)
  1014       Before : B2763764 9   After:  B28386728   **15,32, 79,132,167 ,478,487,5 23,
  1015   "BLD",1058 8,1,503,0)
  1016                                                  545,627 ,676**
  1017   "BLD",1058 8,1,504,0)
  1018   Routine Na me: SDCO1
  1019   "BLD",1058 8,1,505,0)
  1020       Before : B3253740 4   After:  B32904159   **27,132 ,149,193,2 50,296,446 ,
  1021   "BLD",1058 8,1,506,0)
  1022                                                  538,627 ,676**
  1023   "BLD",1058 8,1,507,0)
  1024   Routine Na me: SDCOAM
  1025   "BLD",1058 8,1,508,0)
  1026       Before : B2081065 6   After:  B21133832   **1,20,2 7,66,132,6 76**
  1027   "BLD",1058 8,1,509,0)
  1028   Routine Na me: SDM
  1029   "BLD",1058 8,1,510,0)
  1030       Before : B3624172 3   After:  B36678428   **15,32, 38,41,44,7 9,94,167,1 68,
  1031   "BLD",1058 8,1,511,0)
  1032                                                  218,223 ,250,254,2 96,380,478 ,
  1033   "BLD",1058 8,1,512,0)
  1034                                                  441,619 ,676**
  1035   "BLD",1058 8,1,513,0)
  1036   Routine Na me: SDMULT
  1037   "BLD",1058 8,1,514,0)
  1038       Before : B1032594 3   After:  B10527012   **63,168 ,380,478,6 76**
  1039   "BLD",1058 8,1,515,0)
  1040   Routine Na me: SDMXCA NC
  1041   "BLD",1058 8,1,516,0)
  1042       Before :       n/ a   After:  B37363690   **676**
  1043   "BLD",1058 8,1,517,0)
  1044   Routine Na me: SDMXCH KI
  1045   "BLD",1058 8,1,518,0)
  1046       Before :       n/ a   After:  B15269182   **676**
  1047   "BLD",1058 8,1,519,0)
  1048   Routine Na me: SDMXCH KO
  1049   "BLD",1058 8,1,520,0)
  1050       Before :       n/ a   After:  B15245930   **676**
  1051   "BLD",1058 8,1,521,0)
  1052   Routine Na me: SDMXCO RE
  1053   "BLD",1058 8,1,522,0)
  1054       Before :       n/ a   After:  B24765165   **676**
  1055   "BLD",1058 8,1,523,0)
  1056   Routine Na me: SDMXER RO
  1057   "BLD",1058 8,1,524,0)
  1058       Before :       n/ a   After:   B4538024   **676**
  1059   "BLD",1058 8,1,525,0)
  1060   Routine Na me: SDMXFL AG
  1061   "BLD",1058 8,1,526,0)
  1062       Before :       n/ a   After:  B10435281   **676**
  1063   "BLD",1058 8,1,527,0)
  1064   Routine Na me: SDMXGA PT
  1065   "BLD",1058 8,1,528,0)
  1066       Before :       n/ a   After:  B27411750   **676**
  1067   "BLD",1058 8,1,529,0)
  1068   Routine Na me: SDMXLK RQ
  1069   "BLD",1058 8,1,530,0)
  1070       Before :       n/ a   After:  B21359925   **676**
  1071   "BLD",1058 8,1,531,0)
  1072   Routine Na me: SDMXMA KE
  1073   "BLD",1058 8,1,532,0)
  1074       Before :       n/ a   After:  B44182642   **676**
  1075   "BLD",1058 8,1,533,0)
  1076   Routine Na me: SDMXNS
  1077   "BLD",1058 8,1,534,0)
  1078       Before :       n/ a   After:   B9089731   **676**
  1079   "BLD",1058 8,1,535,0)
  1080   Routine Na me: SDMXPO ST
  1081   "BLD",1058 8,1,536,0)
  1082       Before :       n/ a   After:   B2034392   **676**
  1083   "BLD",1058 8,1,537,0)
  1084   Routine Na me: SDMXPR E
  1085   "BLD",1058 8,1,538,0)
  1086       Before :       n/ a   After:   B1473467   **676**
  1087   "BLD",1058 8,1,539,0)
  1088   Routine Na me: SDMXSC HI
  1089   "BLD",1058 8,1,540,0)
  1090       Before :       n/ a   After: B152446643   **676**
  1091   "BLD",1058 8,1,541,0)
  1092   Routine Na me: SDMXSC HP
  1093   "BLD",1058 8,1,542,0)
  1094       Before :       n/ a   After:  B68944719   **676**
  1095   "BLD",1058 8,1,543,0)
  1096   Routine Na me: SDMXSC HT
  1097   "BLD",1058 8,1,544,0)
  1098       Before :       n/ a   After:  B46137707   **676**
  1099   "BLD",1058 8,1,545,0)
  1100   Routine Na me: SDMXTR CT
  1101   "BLD",1058 8,1,546,0)
  1102       Before :       n/ a   After:  B19365757   **676**
  1103   "BLD",1058 8,1,547,0)
  1104   Routine Na me: SDMXUC AN
  1105   "BLD",1058 8,1,548,0)
  1106       Before :       n/ a   After:  B11140871   **676**
  1107   "BLD",1058 8,1,549,0)
  1108   Routine Na me: SDNEXT
  1109   "BLD",1058 8,1,550,0)
  1110       Before : B2193408 6   After:  B22402085   **41,45, 165,549,67 6**
  1111   "BLD",1058 8,1,551,0)
  1112   Routine Na me: SDNEXT 1
  1113   "BLD",1058 8,1,552,0)
  1114       Before :       n/ a   After:  B25894699   **676**
  1115   "BLD",1058 8,1,553,0)
  1116    
  1117   "BLD",1058 8,1,554,0)
  1118   Routine li st of prec eding patc hes: 492,  549, 592,  619, 627
  1119   "BLD",1058 8,1,555,0)
  1120    
  1121   "BLD",1058 8,1,556,0)
  1122    
  1123   "BLD",1058 8,1,557,0)
  1124   ========== ========== ========== ========== ========== ========== ========== ====
  1125   "BLD",1058 8,1,558,0)
  1126    
  1127   "BLD",1058 8,1,559,0)
  1128   User Infor mation:  
  1129   "BLD",1058 8,1,560,0)
  1130     Entered  By  :   NE EDHAM,MALC OLM      D ate Entere d  :   OCT   2,2017
  1131   "BLD",1058 8,1,561,0)
  1132     Complete d By:                          D ate Comple ted:   
  1133   "BLD",1058 8,1,562,0)
  1134     Released  By :                          D ate Releas ed :   
  1135   "BLD",1058 8,1,563,0)
  1136   ========== ========== ========== ========== ========== ========== ========== ====
  1137   "BLD",1058 8,4,0)
  1138   ^9.64PA^44 ^1
  1139   "BLD",1058 8,4,44,0)
  1140   44
  1141   "BLD",1058 8,4,44,2,0 )
  1142   ^9.641^44^ 1
  1143   "BLD",1058 8,4,44,2,4 4,0)
  1144   HOSPITAL L OCATION  ( File-top l evel)
  1145   "BLD",1058 8,4,44,2,4 4,1,0)
  1146   ^9.6411^22 902^1
  1147   "BLD",1058 8,4,44,2,4 4,1,22902, 0)
  1148   MASS CLINI C FLAG
  1149   "BLD",1058 8,4,44,222 )
  1150   y^y^p^^^^n ^^n
  1151   "BLD",1058 8,4,44,224 )
  1152  
  1153   "BLD",1058 8,4,"APDD" ,44,44)
  1154  
  1155   "BLD",1058 8,4,"APDD" ,44,44,229 02)
  1156  
  1157   "BLD",1058 8,4,"B",44 ,44)
  1158  
  1159   "BLD",1058 8,6.3)
  1160   99
  1161   "BLD",1058 8,"ABPKG")
  1162   n
  1163   "BLD",1058 8,"INI")
  1164  
  1165   "BLD",1058 8,"INID")
  1166   ^n^n
  1167   "BLD",1058 8,"INIT")
  1168  
  1169   "BLD",1058 8,"KRN",0)
  1170   ^9.67PA^77 9.2^20
  1171   "BLD",1058 8,"KRN",.4 ,0)
  1172   .4
  1173   "BLD",1058 8,"KRN",.4 ,"NM",0)
  1174   ^9.68A^^
  1175   "BLD",1058 8,"KRN",.4 01,0)
  1176   .401
  1177   "BLD",1058 8,"KRN",.4 01,"NM",0)
  1178   ^9.68A^^
  1179   "BLD",1058 8,"KRN",.4 02,0)
  1180   .402
  1181   "BLD",1058 8,"KRN",.4 02,"NM",0)
  1182   ^9.68A^^
  1183   "BLD",1058 8,"KRN",.4 03,0)
  1184   .403
  1185   "BLD",1058 8,"KRN",.4 03,"NM",0)
  1186   ^9.68A^^
  1187   "BLD",1058 8,"KRN",.5 ,0)
  1188   .5
  1189   "BLD",1058 8,"KRN",.5 ,"NM",0)
  1190   ^9.68A^^
  1191   "BLD",1058 8,"KRN",.8 4,0)
  1192   .84
  1193   "BLD",1058 8,"KRN",.8 4,"NM",0)
  1194   ^9.68A^^
  1195   "BLD",1058 8,"KRN",3. 6,0)
  1196   3.6
  1197   "BLD",1058 8,"KRN",3. 6,"NM",0)
  1198   ^9.68A^^
  1199   "BLD",1058 8,"KRN",3. 8,0)
  1200   3.8
  1201   "BLD",1058 8,"KRN",3. 8,"NM",0)
  1202   ^9.68A^^
  1203   "BLD",1058 8,"KRN",9. 2,0)
  1204   9.2
  1205   "BLD",1058 8,"KRN",9. 2,"NM",0)
  1206   ^9.68A^^
  1207   "BLD",1058 8,"KRN",9. 8,0)
  1208   9.8
  1209   "BLD",1058 8,"KRN",9. 8,"NM",0)
  1210   ^9.68A^52^ 32
  1211   "BLD",1058 8,"KRN",9. 8,"NM",18, 0)
  1212   SDNEXT^^0^ B22402085
  1213   "BLD",1058 8,"KRN",9. 8,"NM",19, 0)
  1214   SDNEXT1^^0 ^B25894699
  1215   "BLD",1058 8,"KRN",9. 8,"NM",20, 0)
  1216   SDAM^^0^B1 0247694
  1217   "BLD",1058 8,"KRN",9. 8,"NM",21, 0)
  1218   SDC^^0^B28 150691
  1219   "BLD",1058 8,"KRN",9. 8,"NM",23, 0)
  1220   SDAMEX^^0^ B23902444
  1221   "BLD",1058 8,"KRN",9. 8,"NM",24, 0)
  1222   SDM^^0^B36 678428
  1223   "BLD",1058 8,"KRN",9. 8,"NM",25, 0)
  1224   SDMULT^^0^ B10527012
  1225   "BLD",1058 8,"KRN",9. 8,"NM",28, 0)
  1226   SDMXCANC^^ 0^B5663647 3
  1227   "BLD",1058 8,"KRN",9. 8,"NM",29, 0)
  1228   SDMXCHKO^^ 0^B1959702 3
  1229   "BLD",1058 8,"KRN",9. 8,"NM",30, 0)
  1230   SDMXCHKI^^ 0^B2054386 6
  1231   "BLD",1058 8,"KRN",9. 8,"NM",31, 0)
  1232   SDMXCORE^^ 0^B4139569 9
  1233   "BLD",1058 8,"KRN",9. 8,"NM",32, 0)
  1234   SDMXERRO^^ 0^B4538024
  1235   "BLD",1058 8,"KRN",9. 8,"NM",33, 0)
  1236   SDMXGAPT^^ 0^B3064907 4
  1237   "BLD",1058 8,"KRN",9. 8,"NM",34, 0)
  1238   SDMXMAKE^^ 0^B1213039 95
  1239   "BLD",1058 8,"KRN",9. 8,"NM",35, 0)
  1240   SDMXNS^^0^ B17884729
  1241   "BLD",1058 8,"KRN",9. 8,"NM",36, 0)
  1242   SDMXSCHI^^ 0^B1513657 77
  1243   "BLD",1058 8,"KRN",9. 8,"NM",37, 0)
  1244   SDMXSCHP^^ 0^B1223239 91
  1245   "BLD",1058 8,"KRN",9. 8,"NM",38, 0)
  1246   SDMXSCHT^^ 0^B5182138 4
  1247   "BLD",1058 8,"KRN",9. 8,"NM",39, 0)
  1248   SDMXUCAN^^ 0^B6936679
  1249   "BLD",1058 8,"KRN",9. 8,"NM",40, 0)
  1250   SDMXLKRQ^^ 0^B4319585 8
  1251   "BLD",1058 8,"KRN",9. 8,"NM",41, 0)
  1252   SDMXTRCT^^ 0^B1936575 7
  1253   "BLD",1058 8,"KRN",9. 8,"NM",42, 0)
  1254   SDMXFLAG^^ 0^B1043528 1
  1255   "BLD",1058 8,"KRN",9. 8,"NM",43, 0)
  1256   SDMXPRE^^0 ^B1473467
  1257   "BLD",1058 8,"KRN",9. 8,"NM",44, 0)
  1258   SDMXPOST^^ 0^B2034392
  1259   "BLD",1058 8,"KRN",9. 8,"NM",45, 0)
  1260   SDAM3^^0^B 11043233
  1261   "BLD",1058 8,"KRN",9. 8,"NM",46, 0)
  1262   SDAMN^^0^B 7440404
  1263   "BLD",1058 8,"KRN",9. 8,"NM",47, 0)
  1264   SDAM2^^0^B 31432956
  1265   "BLD",1058 8,"KRN",9. 8,"NM",48, 0)
  1266   SDCO1^^0^B 32904159
  1267   "BLD",1058 8,"KRN",9. 8,"NM",49, 0)
  1268   SDCOAM^^0^ B21133832
  1269   "BLD",1058 8,"KRN",9. 8,"NM",50, 0)
  1270   SDAMC^^0^B 15498369
  1271   "BLD",1058 8,"KRN",9. 8,"NM",51, 0)
  1272   SDAMWI^^0^ B13400175
  1273   "BLD",1058 8,"KRN",9. 8,"NM",52, 0)
  1274   SDCNP0^^0^ B42608726
  1275   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDAM",20 )
  1276  
  1277   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDAM2",4 7)
  1278  
  1279   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDAM3",4 5)
  1280  
  1281   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDAMC",5 0)
  1282  
  1283   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDAMEX", 23)
  1284  
  1285   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDAMN",4 6)
  1286  
  1287   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDAMWI", 51)
  1288  
  1289   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDC",21)
  1290  
  1291   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDCNP0", 52)
  1292  
  1293   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDCO1",4 8)
  1294  
  1295   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDCOAM", 49)
  1296  
  1297   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDM",24)
  1298  
  1299   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMULT", 25)
  1300  
  1301   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXCANC ",28)
  1302  
  1303   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXCHKI ",30)
  1304  
  1305   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXCHKO ",29)
  1306  
  1307   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXCORE ",31)
  1308  
  1309   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXERRO ",32)
  1310  
  1311   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXFLAG ",42)
  1312  
  1313   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXGAPT ",33)
  1314  
  1315   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXLKRQ ",40)
  1316  
  1317   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXMAKE ",34)
  1318  
  1319   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXNS", 35)
  1320  
  1321   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXPOST ",44)
  1322  
  1323   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXPRE" ,43)
  1324  
  1325   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXSCHI ",36)
  1326  
  1327   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXSCHP ",37)
  1328  
  1329   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXSCHT ",38)
  1330  
  1331   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXTRCT ",41)
  1332  
  1333   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDMXUCAN ",39)
  1334  
  1335   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDNEXT", 18)
  1336  
  1337   "BLD",1058 8,"KRN",9. 8,"NM","B" ,"SDNEXT1" ,19)
  1338  
  1339   "BLD",1058 8,"KRN",19 ,0)
  1340   19
  1341   "BLD",1058 8,"KRN",19 ,"NM",0)
  1342   ^9.68A^6^5
  1343   "BLD",1058 8,"KRN",19 ,"NM",1,0)
  1344   SDMXFL^^0
  1345   "BLD",1058 8,"KRN",19 ,"NM",3,0)
  1346   SDMX CONVE RSION^^0
  1347   "BLD",1058 8,"KRN",19 ,"NM",4,0)
  1348   MASS CONVE RSION^^0
  1349   "BLD",1058 8,"KRN",19 ,"NM",5,0)
  1350   ORMX CONV  MENU^^0
  1351   "BLD",1058 8,"KRN",19 ,"NM",6,0)
  1352   DGMX CONVE RSION^^0
  1353   "BLD",1058 8,"KRN",19 ,"NM","B", "DGMX CONV ERSION",6)
  1354  
  1355   "BLD",1058 8,"KRN",19 ,"NM","B", "MASS CONV ERSION",4)
  1356  
  1357   "BLD",1058 8,"KRN",19 ,"NM","B", "ORMX CONV  MENU",5)
  1358  
  1359   "BLD",1058 8,"KRN",19 ,"NM","B", "SDMX CONV ERSION",3)
  1360  
  1361   "BLD",1058 8,"KRN",19 ,"NM","B", "SDMXFL",1 )
  1362  
  1363   "BLD",1058 8,"KRN",19 .1,0)
  1364   19.1
  1365   "BLD",1058 8,"KRN",19 .1,"NM",0)
  1366   ^9.68A^^
  1367   "BLD",1058 8,"KRN",10 1,0)
  1368   101
  1369   "BLD",1058 8,"KRN",10 1,"NM",0)
  1370   ^9.68A^3^3
  1371   "BLD",1058 8,"KRN",10 1,"NM",1,0 )
  1372   SD SIU TRI GGER^^0
  1373   "BLD",1058 8,"KRN",10 1,"NM",2,0 )
  1374   SDAM APPOI NTMENT EVE NTS^^2
  1375   "BLD",1058 8,"KRN",10 1,"NM",3,0 )
  1376   ORMX CONV  MENU^^0
  1377   "BLD",1058 8,"KRN",10 1,"NM","B" ,"ORMX CON V MENU",3)
  1378  
  1379   "BLD",1058 8,"KRN",10 1,"NM","B" ,"SD SIU T RIGGER",1)
  1380  
  1381   "BLD",1058 8,"KRN",10 1,"NM","B" ,"SDAM APP OINTMENT E VENTS",2)
  1382  
  1383   "BLD",1058 8,"KRN",40 9.61,0)
  1384   409.61
  1385   "BLD",1058 8,"KRN",40 9.61,"NM", 0)
  1386   ^9.68A^^
  1387   "BLD",1058 8,"KRN",77 1,0)
  1388   771
  1389   "BLD",1058 8,"KRN",77 1,"NM",0)
  1390   ^9.68A^^
  1391   "BLD",1058 8,"KRN",77 9.2,0)
  1392   779.2
  1393   "BLD",1058 8,"KRN",77 9.2,"NM",0 )
  1394   ^9.68A^3^3
  1395   "BLD",1058 8,"KRN",77 9.2,"NM",1 ,0)
  1396   SD-SIU-OUT ^^0
  1397   "BLD",1058 8,"KRN",77 9.2,"NM",2 ,0)
  1398   SD-SIU-IN^ ^0
  1399   "BLD",1058 8,"KRN",77 9.2,"NM",3 ,0)
  1400   SD-ACK-OUT ^^0
  1401   "BLD",1058 8,"KRN",77 9.2,"NM"," B","SD-ACK -OUT",3)
  1402  
  1403   "BLD",1058 8,"KRN",77 9.2,"NM"," B","SD-SIU -IN",2)
  1404  
  1405   "BLD",1058 8,"KRN",77 9.2,"NM"," B","SD-SIU -OUT",1)
  1406  
  1407   "BLD",1058 8,"KRN",87 0,0)
  1408   870
  1409   "BLD",1058 8,"KRN",87 0,"NM",0)
  1410   ^9.68A^^0
  1411   "BLD",1058 8,"KRN",89 89.51,0)
  1412   8989.51
  1413   "BLD",1058 8,"KRN",89 89.51,"NM" ,0)
  1414   ^9.68A^8^7
  1415   "BLD",1058 8,"KRN",89 89.51,"NM" ,1,0)
  1416   SDMX PROVI DER TIME^^ 0
  1417   "BLD",1058 8,"KRN",89 89.51,"NM" ,2,0)
  1418   SDMX CLINI C RO FLAG  DEFAULT^^0
  1419   "BLD",1058 8,"KRN",89 89.51,"NM" ,4,0)
  1420   SDMX MASS  ENABLED^^0
  1421   "BLD",1058 8,"KRN",89 89.51,"NM" ,5,0)
  1422   SDMX CONV  THREADS^^0
  1423   "BLD",1058 8,"KRN",89 89.51,"NM" ,6,0)
  1424   SDMX KIOSK  CHECK IN  ONLY^^0
  1425   "BLD",1058 8,"KRN",89 89.51,"NM" ,7,0)
  1426   MASS ASCII  CHARACTER  SWITCH^^0
  1427   "BLD",1058 8,"KRN",89 89.51,"NM" ,8,0)
  1428   MASS ASCII  CHAR REPL ACEMENT^^0
  1429   "BLD",1058 8,"KRN",89 89.51,"NM" ,"B","MASS  ASCII CHA R REPLACEM ENT",8)
  1430  
  1431   "BLD",1058 8,"KRN",89 89.51,"NM" ,"B","MASS  ASCII CHA RACTER SWI TCH",7)
  1432  
  1433   "BLD",1058 8,"KRN",89 89.51,"NM" ,"B","SDMX  CLINIC RO  FLAG DEFA ULT",2)
  1434  
  1435   "BLD",1058 8,"KRN",89 89.51,"NM" ,"B","SDMX  CONV THRE ADS",5)
  1436  
  1437   "BLD",1058 8,"KRN",89 89.51,"NM" ,"B","SDMX  KIOSK CHE CK IN ONLY ",6)
  1438  
  1439   "BLD",1058 8,"KRN",89 89.51,"NM" ,"B","SDMX  MASS ENAB LED",4)
  1440  
  1441   "BLD",1058 8,"KRN",89 89.51,"NM" ,"B","SDMX  PROVIDER  TIME",1)
  1442  
  1443   "BLD",1058 8,"KRN",89 89.52,0)
  1444   8989.52
  1445   "BLD",1058 8,"KRN",89 89.52,"NM" ,0)
  1446   ^9.68A^^0
  1447   "BLD",1058 8,"KRN",89 94,0)
  1448   8994
  1449   "BLD",1058 8,"KRN",89 94,"NM",0)
  1450   ^9.68A^^
  1451   "BLD",1058 8,"KRN","B ",.4,.4)
  1452  
  1453   "BLD",1058 8,"KRN","B ",.401,.40 1)
  1454  
  1455   "BLD",1058 8,"KRN","B ",.402,.40 2)
  1456  
  1457   "BLD",1058 8,"KRN","B ",.403,.40 3)
  1458  
  1459   "BLD",1058 8,"KRN","B ",.5,.5)
  1460  
  1461   "BLD",1058 8,"KRN","B ",.84,.84)
  1462  
  1463   "BLD",1058 8,"KRN","B ",3.6,3.6)
  1464  
  1465   "BLD",1058 8,"KRN","B ",3.8,3.8)
  1466  
  1467   "BLD",1058 8,"KRN","B ",9.2,9.2)
  1468  
  1469   "BLD",1058 8,"KRN","B ",9.8,9.8)
  1470  
  1471   "BLD",1058 8,"KRN","B ",19,19)
  1472  
  1473   "BLD",1058 8,"KRN","B ",19.1,19. 1)
  1474  
  1475   "BLD",1058 8,"KRN","B ",101,101)
  1476  
  1477   "BLD",1058 8,"KRN","B ",409.61,4 09.61)
  1478  
  1479   "BLD",1058 8,"KRN","B ",771,771)
  1480  
  1481   "BLD",1058 8,"KRN","B ",779.2,77 9.2)
  1482  
  1483   "BLD",1058 8,"KRN","B ",870,870)
  1484  
  1485   "BLD",1058 8,"KRN","B ",8989.51, 8989.51)
  1486  
  1487   "BLD",1058 8,"KRN","B ",8989.52, 8989.52)
  1488  
  1489   "BLD",1058 8,"KRN","B ",8994,899 4)
  1490  
  1491   "BLD",1058 8,"QDEF")
  1492   ^^^^NO^^^^ NO^^NO
  1493   "BLD",1058 8,"QUES",0 )
  1494   ^9.62^^
  1495   "BLD",1058 8,"REQB",0 )
  1496   ^9.611^8^8
  1497   "BLD",1058 8,"REQB",1 ,0)
  1498   SD*5.3*671 ^2
  1499   "BLD",1058 8,"REQB",2 ,0)
  1500   SD*5.3*627 ^2
  1501   "BLD",1058 8,"REQB",3 ,0)
  1502   SD*5.3*619 ^2
  1503   "BLD",1058 8,"REQB",4 ,0)
  1504   SD*5.3*549 ^2
  1505   "BLD",1058 8,"REQB",5 ,0)
  1506   SD*5.3*478 ^2
  1507   "BLD",1058 8,"REQB",6 ,0)
  1508   SD*5.3*380 ^2
  1509   "BLD",1058 8,"REQB",7 ,0)
  1510   SD*5.3*684 ^2
  1511   "BLD",1058 8,"REQB",8 ,0)
  1512   SD*5.3*658 ^2
  1513   "BLD",1058 8,"REQB"," B","SD*5.3 *380",6)
  1514  
  1515   "BLD",1058 8,"REQB"," B","SD*5.3 *478",5)
  1516  
  1517   "BLD",1058 8,"REQB"," B","SD*5.3 *549",4)
  1518  
  1519   "BLD",1058 8,"REQB"," B","SD*5.3 *619",3)
  1520  
  1521   "BLD",1058 8,"REQB"," B","SD*5.3 *627",2)
  1522  
  1523   "BLD",1058 8,"REQB"," B","SD*5.3 *658",8)
  1524  
  1525   "BLD",1058 8,"REQB"," B","SD*5.3 *671",1)
  1526  
  1527   "BLD",1058 8,"REQB"," B","SD*5.3 *684",7)
  1528  
  1529   "FIA",44)
  1530   HOSPITAL L OCATION
  1531   "FIA",44,0 )
  1532   ^SC(
  1533   "FIA",44,0 ,0)
  1534   44I
  1535   "FIA",44,0 ,1)
  1536   y^y^p^^^^n ^^n
  1537   "FIA",44,0 ,10)
  1538  
  1539   "FIA",44,0 ,11)
  1540  
  1541   "FIA",44,0 ,"RLRO")
  1542  
  1543   "FIA",44,0 ,"VR")
  1544   5.3^SD
  1545   "FIA",44,4 4)
  1546   1
  1547   "FIA",44,4 4,22902)
  1548  
  1549   "KRN",19,1 1808,-1)
  1550   0^1
  1551   "KRN",19,1 1808,0)
  1552   SDMXFL^Vie w/Modify M ASS Clinic  Flag^^R^^ ^^^^^^SCHE DULING
  1553   "KRN",19,1 1808,1,0)
  1554   ^19.06^2^2 ^3171108^^ ^
  1555   "KRN",19,1 1808,1,1,0 )
  1556   This optio n allows u ser to vie w or modif y MASS Cli nic Flag.
  1557   "KRN",19,1 1808,1,2,0 )
  1558   This flag  determines  if Clinic  does sche duling via  EPIC Cade nce.
  1559   "KRN",19,1 1808,25)
  1560   ASKCLIN^SD MXFLAG
  1561   "KRN",19,1 1808,99.1)
  1562   64723,4756 6
  1563   "KRN",19,1 1808,"U")
  1564   VIEW/MODIF Y MASS CLI NIC FLAG
  1565   "KRN",19,1 1809,-1)
  1566   0^5
  1567   "KRN",19,1 1809,0)
  1568   ORMX CONV  MENU^MASS  Orders Con versions^^ R^^^^^^^^O RDER ENTRY /RESULTS R EPORTING
  1569   "KRN",19,1 1809,25)
  1570   EN^ORMXCON V
  1571   "KRN",19,1 1809,"U")
  1572   MASS ORDER S CONVERSI ONS
  1573   "KRN",19,1 1810,-1)
  1574   0^4
  1575   "KRN",19,1 1810,0)
  1576   MASS CONVE RSION^Conv ersion uti lities for  the MASS  system^^M^ ^^^^^^^SCH EDULING
  1577   "KRN",19,1 1810,1,0)
  1578   ^19.06^2^2 ^3171130^^ ^^
  1579   "KRN",19,1 1810,1,1,0 )
  1580   These are  menus cont aining the  conversio n utilitie s that are  used duri ng 
  1581   "KRN",19,1 1810,1,2,0 )
  1582   the setup  for the MA SS system.
  1583   "KRN",19,1 1810,10,0)
  1584   ^19.01IP^3 ^3
  1585   "KRN",19,1 1810,10,1, 0)
  1586   11809^OR^1
  1587   "KRN",19,1 1810,10,1, "^")
  1588   ORMX CONV  MENU
  1589   "KRN",19,1 1810,10,2, 0)
  1590   11811^PT^2
  1591   "KRN",19,1 1810,10,2, "^")
  1592   DGMX CONVE RSION
  1593   "KRN",19,1 1810,10,3, 0)
  1594   11812^AP^3
  1595   "KRN",19,1 1810,10,3, "^")
  1596   SDMX CONVE RSION
  1597   "KRN",19,1 1810,99)
  1598   64618,5865 3
  1599   "KRN",19,1 1810,99.1)
  1600   64630,4825 7
  1601   "KRN",19,1 1810,"U")
  1602   CONVERSION  UTILITIES  FOR THE M
  1603   "KRN",19,1 1811,-1)
  1604   0^6
  1605   "KRN",19,1 1811,0)
  1606   DGMX CONVE RSION^MASS  Demograph ics Conver sion^^R^^^ ^^^^^REGIS TRATION
  1607   "KRN",19,1 1811,25)
  1608   ENTRY^DGMX CONV
  1609   "KRN",19,1 1811,"U")
  1610   MASS DEMOG RAPHICS CO NVERSION
  1611   "KRN",19,1 1812,-1)
  1612   0^3
  1613   "KRN",19,1 1812,0)
  1614   SDMX CONVE RSION^MASS  Future Ap pointment  Conversion ^^R^^^^^^^ ^SCHEDULIN G
  1615   "KRN",19,1 1812,1,0)
  1616   ^19.06^2^2 ^3171130^^
  1617   "KRN",19,1 1812,1,1,0 )
  1618   Extracts t he future  appointmen ts for act ive clinic sc and wil l trigger 
  1619   "KRN",19,1 1812,1,2,0 )
  1620   them to th e SD_SIU_O UT HL7 app ointment i nterface
  1621   "KRN",19,1 1812,25)
  1622   FUTAP^SDMX TRCT
  1623   "KRN",19,1 1812,"U")
  1624   MASS FUTUR E APPOINTM ENT CONVER
  1625   "KRN",101, 3,-1)
  1626   2^2
  1627   "KRN",101, 3,0)
  1628   SDAM APPOI NTMENT EVE NTS^Appoin tment Even t Driver^^ X^145^^^^^ ^^48
  1629   "KRN",101, 3,10,0)
  1630   ^101.01PA^ 37^16
  1631   "KRN",101, 3,10,22,0)
  1632   5010^^^
  1633   "KRN",101, 3,10,22,"^ ")
  1634   SD SIU TRI GGER
  1635   "KRN",101, 5010,-1)
  1636   0^1
  1637   "KRN",101, 5010,0)
  1638   SD SIU TRI GGER^SD SI U TRIGGER^ ^A^^^^^^^^
  1639   "KRN",101, 5010,20)
  1640   D MAIN^SDM XSCHT
  1641   "KRN",101, 5010,99)
  1642   64572,3393 8
  1643   "KRN",101, 5018,-1)
  1644   0^3
  1645   "KRN",101, 5018,0)
  1646   ORMX CONV  MENU^^^M^^ ^^^^^^
  1647   "KRN",101, 5018,4)
  1648   40^9
  1649   "KRN",101, 5018,10,0)
  1650   ^101.01PA^ 1^1
  1651   "KRN",101, 5018,26)
  1652   D SHOW^VAL M
  1653   "KRN",101, 5018,28)
  1654   Select Act ion
  1655   "KRN",101, 5018,99)
  1656   64650,5039 8
  1657   "KRN",779. 2,22,-1)
  1658   0^1
  1659   "KRN",779. 2,22,0)
  1660   SD-SIU-OUT
  1661   "KRN",779. 2,22,1,0)
  1662   ^779.21I^2 ^2
  1663   "KRN",779. 2,22,1,1,0 )
  1664   SIU^S12^^P ARSEMSG^SD MXSCHI^2.4
  1665   "KRN",779. 2,22,1,2,0 )
  1666   SIU^S14^^P ARSEMSG^SD MXSCHI^2.4
  1667   "KRN",779. 2,22,1,"B" ,"SIU",1)
  1668  
  1669   "KRN",779. 2,22,1,"B" ,"SIU",2)
  1670  
  1671   "KRN",779. 2,22,1,"D" ,"SIU","S1 2",2.4,1)
  1672  
  1673   "KRN",779. 2,22,1,"D" ,"SIU","S1 4",2.4,2)
  1674  
  1675   "KRN",779. 2,22,2)
  1676   SCHEDULING
  1677   "KRN",779. 2,23,-1)
  1678   0^2
  1679   "KRN",779. 2,23,0)
  1680   SD-SIU-IN^ ^^^^PARSEM SG^SDMXSCH I
  1681   "KRN",779. 2,23,1,0)
  1682   ^779.21I^4 ^4
  1683   "KRN",779. 2,23,1,1,0 )
  1684   SIU^S12^^P ARSEMSG^SD MXSCHI^2.4
  1685   "KRN",779. 2,23,1,2,0 )
  1686   SIU^S14^^P ARSEMSG^SD MXSCHI^2.4
  1687   "KRN",779. 2,23,1,3,0 )
  1688   SIU^S15^^P ARSEMSG^SD MXSCHI^2.4
  1689   "KRN",779. 2,23,1,4,0 )
  1690   SIU^S26^^P ARSEMSG^SD MXSCHI^2.4
  1691   "KRN",779. 2,23,1,"B" ,"SIU",1)
  1692  
  1693   "KRN",779. 2,23,1,"B" ,"SIU",2)
  1694  
  1695   "KRN",779. 2,23,1,"B" ,"SIU",3)
  1696  
  1697   "KRN",779. 2,23,1,"B" ,"SIU",4)
  1698  
  1699   "KRN",779. 2,23,1,"D" ,"SIU","S1 2",2.4,1)
  1700  
  1701   "KRN",779. 2,23,1,"D" ,"SIU","S1 4",2.4,2)
  1702  
  1703   "KRN",779. 2,23,1,"D" ,"SIU","S1 5",2.4,3)
  1704  
  1705   "KRN",779. 2,23,1,"D" ,"SIU","S2 6",2.4,1)
  1706  
  1707   "KRN",779. 2,23,1,"D" ,"SIU","S2 6",2.4,4)
  1708  
  1709   "KRN",779. 2,23,2)
  1710   SCHEDULING
  1711   "KRN",779. 2,27,-1)
  1712   0^3
  1713   "KRN",779. 2,27,0)
  1714   SD-ACK-OUT
  1715   "KRN",779. 2,27,1,0)
  1716   ^779.21I^1 ^1
  1717   "KRN",779. 2,27,1,1,0 )
  1718   ACK^NAK^^^ ^2.4
  1719   "KRN",779. 2,27,1,"B" ,"ACK",1)
  1720  
  1721   "KRN",779. 2,27,1,"D" ,"ACK","NA K",2.4,1)
  1722  
  1723   "KRN",779. 2,27,2)
  1724   SCHEDULING
  1725   "KRN",8989 .51,846,-1 )
  1726   0^2
  1727   "KRN",8989 .51,846,0)
  1728   SDMX CLINI C RO FLAG  DEFAULT^RE AD ONLY FL AG DEFAULT  TOGGLE^0^ ^^0
  1729   "KRN",8989 .51,846,1)
  1730   Y^^Enter n o for edit able and e nter Yes f or read-on ly.
  1731   "KRN",8989 .51,846,20 ,0)
  1732   ^^2^2^3171 130^
  1733   "KRN",8989 .51,846,20 ,1,0)
  1734   The Clinic  read-only  flag dete rmines whi ch option  should be  used if no
  1735   "KRN",8989 .51,846,20 ,2,0)
  1736   flag is se t on a cli nic.
  1737   "KRN",8989 .51,846,30 ,0)
  1738   ^8989.513I ^1^1
  1739   "KRN",8989 .51,846,30 ,1,0)
  1740   1^4.2
  1741   "KRN",8989 .51,848,-1 )
  1742   0^1
  1743   "KRN",8989 .51,848,0)
  1744   SDMX PROVI DER TIME^P ROVIDER TI ME DEFAULT  TOGGLE^0^ ^^0
  1745   "KRN",8989 .51,848,1)
  1746   N^^Please  select fro m value op tions 1, 2 , or 3.
  1747   "KRN",8989 .51,848,6)
  1748   N
  1749   "KRN",8989 .51,848,20 ,0)
  1750   ^8989.512^ 3^3^317111 7^^^^
  1751   "KRN",8989 .51,848,20 ,1,0)
  1752    1. Use SC H Appointm ent Date/T ime and AI P/AIG Dura tion
  1753   "KRN",8989 .51,848,20 ,2,0)
  1754    2. Use SC H Appointm ent Date/T ime and Du ration
  1755   "KRN",8989 .51,848,20 ,3,0)
  1756    3. Use AI P/AIG Appo intment Da te/Time an d AIP/AIG  Duration
  1757   "KRN",8989 .51,848,30 ,0)
  1758   ^8989.513I ^1^1
  1759   "KRN",8989 .51,848,30 ,1,0)
  1760   1^4.2
  1761   "KRN",8989 .51,855,-1 )
  1762   0^4
  1763   "KRN",8989 .51,855,0)
  1764   SDMX MASS  ENABLED^EN ABLE MASS  FUNCTIONAL ITY^0^^^0
  1765   "KRN",8989 .51,855,1)
  1766   Y^^Enter N o to disab le MASS an d enter Ye s to enabl e MASS
  1767   "KRN",8989 .51,855,20 ,0)
  1768   ^^2^2^3171 130^
  1769   "KRN",8989 .51,855,20 ,1,0)
  1770   Determines  if MASS f unctionali ty is enab led. Enter  No to dis able MASS  and
  1771   "KRN",8989 .51,855,20 ,2,0)
  1772   enter Yes  to enable  MASS.
  1773   "KRN",8989 .51,855,30 ,0)
  1774   ^8989.513I ^1^1
  1775   "KRN",8989 .51,855,30 ,1,0)
  1776   1^4.2
  1777   "KRN",8989 .51,857,-1 )
  1778   0^5
  1779   "KRN",8989 .51,857,0)
  1780   SDMX CONV  THREADS^AP PT CONV TH READS^0^^^ 0
  1781   "KRN",8989 .51,857,1)
  1782   N^^Enter t he number  of threads  for the a ppointment  conversio n interfac e
  1783   "KRN",8989 .51,857,20 ,0)
  1784   ^8989.512^ 2^2^317113 0^^^^
  1785   "KRN",8989 .51,857,20 ,1,0)
  1786   When trigg ering the  conversion  this will  allow mul tiple appl ication 
  1787   "KRN",8989 .51,857,20 ,2,0)
  1788   registries  to be use
  1789   "KRN",8989 .51,857,30 ,0)
  1790   ^8989.513I ^1^1
  1791   "KRN",8989 .51,857,30 ,1,0)
  1792   1^4.2
  1793   "KRN",8989 .51,860,-1 )
  1794   0^6
  1795   "KRN",8989 .51,860,0)
  1796   SDMX KIOSK  CHECK IN  ONLY^CHECK  IN TRIGGE R FROM KIO SK ONLY^0^ ^^0
  1797   "KRN",8989 .51,860,1)
  1798   Y^^Enter N o to allow  any actio n to send  check in m essages.
  1799   "KRN",8989 .51,860,20 ,0)
  1800   ^8989.512^ 2^2^318012 3^^
  1801   "KRN",8989 .51,860,20 ,1,0)
  1802   Determines  if S14 up date messa ges should  be trigge red for an y action t hat 
  1803   "KRN",8989 .51,860,20 ,2,0)
  1804   hits the a ppointment  check in  trigger.
  1805   "KRN",8989 .51,860,30 ,0)
  1806   ^8989.513I ^1^1
  1807   "KRN",8989 .51,860,30 ,1,0)
  1808   1^4.2
  1809   "KRN",8989 .51,862,-1 )
  1810   0^7
  1811   "KRN",8989 .51,862,0)
  1812   MASS ASCII  CHARACTER  SWITCH^Re place ASCI I characte rs for MAS S?^0
  1813   "KRN",8989 .51,862,1)
  1814   Y^^Enter y es if unpr intable ch aracters s hould be r eplaced
  1815   "KRN",8989 .51,862,30 ,0)
  1816   ^8989.513I ^1^1
  1817   "KRN",8989 .51,862,30 ,1,0)
  1818   1^4.2
  1819   "KRN",8989 .51,863,-1 )
  1820   0^8
  1821   "KRN",8989 .51,863,0)
  1822   MASS ASCII  CHAR REPL ACEMENT^Re placement  for ASCII  characters ^0
  1823   "KRN",8989 .51,863,1)
  1824   F^^enter a  string th at should  replace AS CII charac ters
  1825   "KRN",8989 .51,863,30 ,0)
  1826   ^8989.513I ^1^1
  1827   "KRN",8989 .51,863,30 ,1,0)
  1828   1^4.2
  1829   "MBREQ")
  1830   0
  1831   "ORD",15,1 01)
  1832   101;15;;;P RO^XPDTA;P ROF1^XPDIA ;PROE1^XPD IA;PROF2^X PDIA;;PROD EL^XPDIA
  1833   "ORD",15,1 01,0)
  1834   PROTOCOL
  1835   "ORD",18,1 9)
  1836   19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
  1837   "ORD",18,1 9,0)
  1838   OPTION
  1839   "ORD",20,8 989.51)
  1840   8989.51;20 ;;;PAR1E1^ XPDTA2;PAR 1F1^XPDIA3 ;PAR1E1^XP DIA3;PAR1F 2^XPDIA3;; PAR1DEL^XP DIA3(%)
  1841   "ORD",20,8 989.51,0)
  1842   PARAMETER  DEFINITION
  1843   "ORD",22,7 79.2)
  1844   779.2;22;1 ;;HLOAP^XP DTA1;;HLOE ^XPDIA1;;;
  1845   "ORD",22,7 79.2,0)
  1846   HLO APPLIC ATION REGI STRY
  1847   "PKG",48,- 1)
  1848   1^1
  1849   "PKG",48,0 )
  1850   SCHEDULING ^SD^APPOIN TMENTS,PRO FILES,LETT ERS,AMIS R EPORTS
  1851   "PKG",48,2 0,0)
  1852   ^9.402P^^
  1853   "PKG",48,2 2,0)
  1854   ^9.49I^1^1
  1855   "PKG",48,2 2,1,0)
  1856   5.3^305111 9^2960613
  1857   "PKG",48,2 2,1,"PAH", 1,0)
  1858   676^318060 5
  1859   "PKG",48,2 2,1,"PAH", 1,1,0)
  1860   ^^563^563^ 3180605
  1861   "PKG",48,2 2,1,"PAH", 1,1,1,0)
  1862   Descriptio n:
  1863   "PKG",48,2 2,1,"PAH", 1,1,2,0)
  1864   ---------- -- 
  1865   "PKG",48,2 2,1,"PAH", 1,1,3,0)
  1866    
  1867   "PKG",48,2 2,1,"PAH", 1,1,4,0)
  1868   The Medica l Appointm ent Schedu ling Syste m (MASS) p rogram wil l deploy a  
  1869   "PKG",48,2 2,1,"PAH", 1,1,5,0)
  1870   commercial  schedulin g applicat ion to sup port sched ulers, and  ultimatel y
  1871   "PKG",48,2 2,1,"PAH", 1,1,6,0)
  1872   our Vetera ns, within  the Chalm ers P. Wyl ie Departm ent of Vet erans 
  1873   "PKG",48,2 2,1,"PAH", 1,1,7,0)
  1874   Affairs (V A) Ambulat ory Care C enter in C olumbus, O H. This de ployment 
  1875   "PKG",48,2 2,1,"PAH", 1,1,8,0)
  1876   and integr ation will  allow the  VA to mov e from a c linic-base d scheduli ng
  1877   "PKG",48,2 2,1,"PAH", 1,1,9,0)
  1878   system to  a resource -based sch eduling sy stem, ther eby standa rdizing an
  1879   "PKG",48,2 2,1,"PAH", 1,1,10,0)
  1880   improving  scheduling  processes , providin g resource  supply ma nagement, 
  1881   "PKG",48,2 2,1,"PAH", 1,1,11,0)
  1882   and delive ring impro ved access  to care f or our Vet erans. 
  1883   "PKG",48,2 2,1,"PAH", 1,1,12,0)
  1884    
  1885   "PKG",48,2 2,1,"PAH", 1,1,13,0)
  1886   The MASS I ndefinite  Delivery/I ndefinite  Quantity ( IDIQ) cont ract 
  1887   "PKG",48,2 2,1,"PAH", 1,1,14,0)
  1888   establishe s the over arching re quirements  for the M ASS Contra ctor to 
  1889   "PKG",48,2 2,1,"PAH", 1,1,15,0)
  1890   incrementa lly captur e requirem ents, desi gn, develo p, deploy,  implement
  1891   "PKG",48,2 2,1,"PAH", 1,1,16,0)
  1892   and train  MASS acros s the VA h ealth care  enterpris e. This pr ogram 
  1893   "PKG",48,2 2,1,"PAH", 1,1,17,0)
  1894   involves i nitiation,  design, a nd executi on of a pi lot site a
  1895   "PKG",48,2 2,1,"PAH", 1,1,18,0)
  1896    
  1897   "PKG",48,2 2,1,"PAH", 1,1,19,0)
  1898   Chalmers P . Wylie VA  Ambulator y Care Cen ter (herea fter refer red to as 
  1899   "PKG",48,2 2,1,"PAH", 1,1,20,0)
  1900   the Columb us ACC and  its assoc iated Comm unity Base d Outpatie nt Clinics
  1901   "PKG",48,2 2,1,"PAH", 1,1,21,0)
  1902   to demonst rate the M ASS busine ss value,  the integr ation of M ASS within  
  1903   "PKG",48,2 2,1,"PAH", 1,1,22,0)
  1904   the VA ent erprise, t he impact  MASS will  have on va rious clin ical and 
  1905   "PKG",48,2 2,1,"PAH", 1,1,23,0)
  1906   administra tive proce sses and w orkflows,  and the ef fort neces sary for t he 
  1907   "PKG",48,2 2,1,"PAH", 1,1,24,0)
  1908   affected s takeholder s to adopt  these cha nges. 
  1909   "PKG",48,2 2,1,"PAH", 1,1,25,0)
  1910    
  1911   "PKG",48,2 2,1,"PAH", 1,1,26,0)
  1912   The enterp rise-wide  Medical Ap pointment  Scheduling  System (M ASS), 
  1913   "PKG",48,2 2,1,"PAH", 1,1,27,0)
  1914   enabled by  Cadence,  will manag e the appo intment li fecycle, i mprove 
  1915   "PKG",48,2 2,1,"PAH", 1,1,28,0)
  1916   clinical r esource ma nagement,  and inform  VHA manag ement at a ll 
  1917   "PKG",48,2 2,1,"PAH", 1,1,29,0)
  1918   organizati onal level s with rea l-time bus iness, res ource util ization an
  1919   "PKG",48,2 2,1,"PAH", 1,1,30,0)
  1920   demand, su pply, and  quality se rvice metr ics intell igence. Th e MASS 
  1921   "PKG",48,2 2,1,"PAH", 1,1,31,0)
  1922   implementa tion will  address cr itical cha llenges fo r stakehol der and 
  1923   "PKG",48,2 2,1,"PAH", 1,1,32,0)
  1924   user adopt ion across  the enter prise, sea mless inte gration wi th VistA, 
  1925   "PKG",48,2 2,1,"PAH", 1,1,33,0)
  1926   and preser ver local  autonomy w hile intro ducing nat ionally st andardized
  1927   "PKG",48,2 2,1,"PAH", 1,1,34,0)
  1928   rules and  workflows.
  1929   "PKG",48,2 2,1,"PAH", 1,1,35,0)
  1930    
  1931   "PKG",48,2 2,1,"PAH", 1,1,36,0)
  1932   The Schedu ling patch  SD*5.3*67 6 is the i nitial rel ease of th e MASS 
  1933   "PKG",48,2 2,1,"PAH", 1,1,37,0)
  1934   scheduling  integrati on develop ment for t he VistA P ilot at Co lumbus, OH .
  1935   "PKG",48,2 2,1,"PAH", 1,1,38,0)
  1936   This patch  includes  all of the  necessary  component s that wil l enable 
  1937   "PKG",48,2 2,1,"PAH", 1,1,39,0)
  1938   bidirectio nal HL7 (H ealth Leve l 7) v2 SI U (Schedul ing Messag e) 
  1939   "PKG",48,2 2,1,"PAH", 1,1,40,0)
  1940   scheduling  integrati on with MA SS.
  1941   "PKG",48,2 2,1,"PAH", 1,1,41,0)
  1942    
  1943   "PKG",48,2 2,1,"PAH", 1,1,42,0)
  1944   SD*5.3*676  patch enh ancements  include:
  1945   "PKG",48,2 2,1,"PAH", 1,1,43,0)
  1946    
  1947   "PKG",48,2 2,1,"PAH", 1,1,44,0)
  1948   1. Ability  to trigge r and buil d HL7v2 SI U messages  for any M ASS 
  1949   "PKG",48,2 2,1,"PAH", 1,1,45,0)
  1950      schedul able clini cs. 
  1951   "PKG",48,2 2,1,"PAH", 1,1,46,0)
  1952    
  1953   "PKG",48,2 2,1,"PAH", 1,1,47,0)
  1954   2. Ability  to lock d own VistA  from perfo rming acti ons on the  appointme nts 
  1955   "PKG",48,2 2,1,"PAH", 1,1,48,0)
  1956      now bei ng schedul ed in MASS .
  1957   "PKG",48,2 2,1,"PAH", 1,1,49,0)
  1958    
  1959   "PKG",48,2 2,1,"PAH", 1,1,50,0)
  1960   3. Include s a conver sion utili ty to sync  up VistA  and MASS w hen the 
  1961   "PKG",48,2 2,1,"PAH", 1,1,51,0)
  1962      system  goes live.
  1963   "PKG",48,2 2,1,"PAH", 1,1,52,0)
  1964      
  1965   "PKG",48,2 2,1,"PAH", 1,1,53,0)
  1966    
  1967   "PKG",48,2 2,1,"PAH", 1,1,54,0)
  1968   Patch Comp onents:
  1969   "PKG",48,2 2,1,"PAH", 1,1,55,0)
  1970   ---------- -------
  1971   "PKG",48,2 2,1,"PAH", 1,1,56,0)
  1972   HLO Applic ations:
  1973   "PKG",48,2 2,1,"PAH", 1,1,57,0)
  1974   SD-SIU-OUT
  1975   "PKG",48,2 2,1,"PAH", 1,1,58,0)
  1976   SD-SIU-IN
  1977   "PKG",48,2 2,1,"PAH", 1,1,59,0)
  1978   SD-ACK-OUT
  1979   "PKG",48,2 2,1,"PAH", 1,1,60,0)
  1980   HLO Logica l Links:
  1981   "PKG",48,2 2,1,"PAH", 1,1,61,0)
  1982   SD SIU OUT
  1983   "PKG",48,2 2,1,"PAH", 1,1,62,0)
  1984   SD ACK OUT
  1985   "PKG",48,2 2,1,"PAH", 1,1,63,0)
  1986    
  1987   "PKG",48,2 2,1,"PAH", 1,1,64,0)
  1988   Parameters :
  1989   "PKG",48,2 2,1,"PAH", 1,1,65,0)
  1990   SDMX CLINI C RO FLAG  DEFAULT
  1991   "PKG",48,2 2,1,"PAH", 1,1,66,0)
  1992   SDMX CONV  THREADS
  1993   "PKG",48,2 2,1,"PAH", 1,1,67,0)
  1994   SDMX MASS  ENABLED
  1995   "PKG",48,2 2,1,"PAH", 1,1,68,0)
  1996   SDMX PROVI DER TIME
  1997   "PKG",48,2 2,1,"PAH", 1,1,69,0)
  1998   SDMX KIOSK  CHECK IN  ONLY 
  1999   "PKG",48,2 2,1,"PAH", 1,1,70,0)
  2000   MASS ASCII  CHAR REPL ACEMENT 
  2001   "PKG",48,2 2,1,"PAH", 1,1,71,0)
  2002   MASS ASCII  CHARACTER  SWITCH 
  2003   "PKG",48,2 2,1,"PAH", 1,1,72,0)
  2004    
  2005   "PKG",48,2 2,1,"PAH", 1,1,73,0)
  2006   Files & Fi elds Assoc iated:
  2007   "PKG",48,2 2,1,"PAH", 1,1,74,0)
  2008    
  2009   "PKG",48,2 2,1,"PAH", 1,1,75,0)
  2010   File Name  (Number)       Field  Name (Numb er)     Ne w/Modified /Deleted
  2011   "PKG",48,2 2,1,"PAH", 1,1,76,0)
  2012   ---------- --------       ------ ---------- ---     -- ---------- --------
  2013   "PKG",48,2 2,1,"PAH", 1,1,77,0)
  2014   HOSPITAL L OCATION (4 4)  MASS C LINIC FLAG  (22902)         New
  2015   "PKG",48,2 2,1,"PAH", 1,1,78,0)
  2016    
  2017   "PKG",48,2 2,1,"PAH", 1,1,79,0)
  2018    
  2019   "PKG",48,2 2,1,"PAH", 1,1,80,0)
  2020   Forms Asso ciated:
  2021   "PKG",48,2 2,1,"PAH", 1,1,81,0)
  2022    
  2023   "PKG",48,2 2,1,"PAH", 1,1,82,0)
  2024   Form Name        File  #  New/Mo dified/Del eted
  2025   "PKG",48,2 2,1,"PAH", 1,1,83,0)
  2026   ---------        ---- --  ------ ---------- ----
  2027   "PKG",48,2 2,1,"PAH", 1,1,84,0)
  2028   N/A               N/A      N/A
  2029   "PKG",48,2 2,1,"PAH", 1,1,85,0)
  2030    
  2031   "PKG",48,2 2,1,"PAH", 1,1,86,0)
  2032    
  2033   "PKG",48,2 2,1,"PAH", 1,1,87,0)
  2034   Mail Group s Associat ed:
  2035   "PKG",48,2 2,1,"PAH", 1,1,88,0)
  2036    
  2037   "PKG",48,2 2,1,"PAH", 1,1,89,0)
  2038    
  2039   "PKG",48,2 2,1,"PAH", 1,1,90,0)
  2040   Mail Group  Name New/ Modified/D eleted
  2041   "PKG",48,2 2,1,"PAH", 1,1,91,0)
  2042   ---------- ----- ---- ---------- ------
  2043   "PKG",48,2 2,1,"PAH", 1,1,92,0)
  2044   N/A                 N /A
  2045   "PKG",48,2 2,1,"PAH", 1,1,93,0)
  2046    
  2047   "PKG",48,2 2,1,"PAH", 1,1,94,0)
  2048    
  2049   "PKG",48,2 2,1,"PAH", 1,1,95,0)
  2050   Options As sociated:
  2051   "PKG",48,2 2,1,"PAH", 1,1,96,0)
  2052    
  2053   "PKG",48,2 2,1,"PAH", 1,1,97,0)
  2054   Option Nam e            Type     New/Modifi ed/Deleted
  2055   "PKG",48,2 2,1,"PAH", 1,1,98,0)
  2056   ---------- -            ----     ---------- ----------  
  2057   "PKG",48,2 2,1,"PAH", 1,1,99,0)
  2058   MASS CONVE RSION        MENU         NEW
  2059   "PKG",48,2 2,1,"PAH", 1,1,100,0)
  2060   DGMX CONVE RSION RUN    ROUTINE      NEW
  2061   "PKG",48,2 2,1,"PAH", 1,1,101,0)
  2062   ORMX CONV  MENU  RUN    ROUTINE      NEW
  2063   "PKG",48,2 2,1,"PAH", 1,1,102,0)
  2064   SDMXFL  RU N            ROUTINE      NEW
  2065   "PKG",48,2 2,1,"PAH", 1,1,103,0)
  2066    
  2067   "PKG",48,2 2,1,"PAH", 1,1,104,0)
  2068    
  2069   "PKG",48,2 2,1,"PAH", 1,1,105,0)
  2070   SDMX CONVE RSION RUN    ROUTINE      NEW
  2071   "PKG",48,2 2,1,"PAH", 1,1,106,0)
  2072    
  2073   "PKG",48,2 2,1,"PAH", 1,1,107,0)
  2074   Protocols  Associated :
  2075   "PKG",48,2 2,1,"PAH", 1,1,108,0)
  2076    
  2077   "PKG",48,2 2,1,"PAH", 1,1,109,0)
  2078   Protocol N ame   New/ Modified/D eleted
  2079   "PKG",48,2 2,1,"PAH", 1,1,110,0)
  2080   ---------- ---   ---- ---------- ------ 
  2081   "PKG",48,2 2,1,"PAH", 1,1,111,0)
  2082   SDAM APPOI NTMENT EVE NTS Modifi ed
  2083   "PKG",48,2 2,1,"PAH", 1,1,112,0)
  2084   SD SIU TRI GGER  New
  2085   "PKG",48,2 2,1,"PAH", 1,1,113,0)
  2086    
  2087   "PKG",48,2 2,1,"PAH", 1,1,114,0)
  2088    
  2089   "PKG",48,2 2,1,"PAH", 1,1,115,0)
  2090   Security K eys Associ ated:
  2091   "PKG",48,2 2,1,"PAH", 1,1,116,0)
  2092    
  2093   "PKG",48,2 2,1,"PAH", 1,1,117,0)
  2094   Security K ey Name
  2095   "PKG",48,2 2,1,"PAH", 1,1,118,0)
  2096   ---------- -------
  2097   "PKG",48,2 2,1,"PAH", 1,1,119,0)
  2098   N/A
  2099   "PKG",48,2 2,1,"PAH", 1,1,120,0)
  2100    
  2101   "PKG",48,2 2,1,"PAH", 1,1,121,0)
  2102   Templates  Associated :
  2103   "PKG",48,2 2,1,"PAH", 1,1,122,0)
  2104    
  2105   "PKG",48,2 2,1,"PAH", 1,1,123,0)
  2106   Template N ame   Type     File N ame (Numbe r)  New/Mo dified/Del eted 
  2107   "PKG",48,2 2,1,"PAH", 1,1,124,0)
  2108   ---------- ---   ----     ------ ---------- --  ------ ---------- ----
  2109   "PKG",48,2 2,1,"PAH", 1,1,125,0)
  2110   N/A               N/A      N/A                   N/A
  2111   "PKG",48,2 2,1,"PAH", 1,1,126,0)
  2112    
  2113   "PKG",48,2 2,1,"PAH", 1,1,127,0)
  2114    
  2115   "PKG",48,2 2,1,"PAH", 1,1,128,0)
  2116   Additional  Informati on:
  2117   "PKG",48,2 2,1,"PAH", 1,1,129,0)
  2118   N/A
  2119   "PKG",48,2 2,1,"PAH", 1,1,130,0)
  2120    
  2121   "PKG",48,2 2,1,"PAH", 1,1,131,0)
  2122   New Servic e Requests  (NSRs):
  2123   "PKG",48,2 2,1,"PAH", 1,1,132,0)
  2124   ---------- ---------- --------  
  2125   "PKG",48,2 2,1,"PAH", 1,1,133,0)
  2126   N/A
  2127   "PKG",48,2 2,1,"PAH", 1,1,134,0)
  2128    
  2129   "PKG",48,2 2,1,"PAH", 1,1,135,0)
  2130    
  2131   "PKG",48,2 2,1,"PAH", 1,1,136,0)
  2132   Patient Sa fety Issue s (PSIs):
  2133   "PKG",48,2 2,1,"PAH", 1,1,137,0)
  2134   ---------- ---------- ---------
  2135   "PKG",48,2 2,1,"PAH", 1,1,138,0)
  2136   N/A
  2137   "PKG",48,2 2,1,"PAH", 1,1,139,0)
  2138    
  2139   "PKG",48,2 2,1,"PAH", 1,1,140,0)
  2140    
  2141   "PKG",48,2 2,1,"PAH", 1,1,141,0)
  2142   Defect Tra cking Syst em Ticket( s) & Overv iew:
  2143   "PKG",48,2 2,1,"PAH", 1,1,142,0)
  2144   ---------- ---------- ---------- ---------- ----
  2145   "PKG",48,2 2,1,"PAH", 1,1,143,0)
  2146   N/A
  2147   "PKG",48,2 2,1,"PAH", 1,1,144,0)
  2148    
  2149   "PKG",48,2 2,1,"PAH", 1,1,145,0)
  2150   Problem:
  2151   "PKG",48,2 2,1,"PAH", 1,1,146,0)
  2152   -------
  2153   "PKG",48,2 2,1,"PAH", 1,1,147,0)
  2154   N/A
  2155   "PKG",48,2 2,1,"PAH", 1,1,148,0)
  2156    
  2157   "PKG",48,2 2,1,"PAH", 1,1,149,0)
  2158   Resolution :
  2159   "PKG",48,2 2,1,"PAH", 1,1,150,0)
  2160   ----------
  2161   "PKG",48,2 2,1,"PAH", 1,1,151,0)
  2162   N/A
  2163   "PKG",48,2 2,1,"PAH", 1,1,152,0)
  2164    
  2165   "PKG",48,2 2,1,"PAH", 1,1,153,0)
  2166   Test Sites :
  2167   "PKG",48,2 2,1,"PAH", 1,1,154,0)
  2168   ----------
  2169   "PKG",48,2 2,1,"PAH", 1,1,155,0)
  2170   N/A
  2171   "PKG",48,2 2,1,"PAH", 1,1,156,0)
  2172    
  2173   "PKG",48,2 2,1,"PAH", 1,1,157,0)
  2174    
  2175   "PKG",48,2 2,1,"PAH", 1,1,158,0)
  2176   Software a nd Documen tation Ret rieval Ins tructions:
  2177   "PKG",48,2 2,1,"PAH", 1,1,159,0)
  2178   ---------- ---------- ---------- ---------- ---------- -- 
  2179   "PKG",48,2 2,1,"PAH", 1,1,160,0)
  2180   Software b eing relea sed as a h ost file a nd/or docu mentation  describing  
  2181   "PKG",48,2 2,1,"PAH", 1,1,161,0)
  2182   the new fu nctionalit y introduc ed by this  patch are  available .
  2183   "PKG",48,2 2,1,"PAH", 1,1,162,0)
  2184    
  2185   "PKG",48,2 2,1,"PAH", 1,1,163,0)
  2186   The prefer red method  is to ret rieve file s from dow nload. DNS        . DNS     .
  2187   "PKG",48,2 2,1,"PAH", 1,1,164,0)
  2188   This trans mits the f iles from  the first  available  server. Si tes may 
  2189   "PKG",48,2 2,1,"PAH", 1,1,165,0)
  2190   also elect  to retrie ve files d irectly fr om a speci fic server
  2191   "PKG",48,2 2,1,"PAH", 1,1,166,0)
  2192    
  2193   "PKG",48,2 2,1,"PAH", 1,1,167,0)
  2194   Sites may  retrieve t he softwar e and/or d ocumentati on directl y using 
  2195   "PKG",48,2 2,1,"PAH", 1,1,168,0)
  2196   Secure Fil e Transfer  Protocol  (SFTP) fro m the ANON YMOUS.SOFT WARE 
  2197   "PKG",48,2 2,1,"PAH", 1,1,169,0)
  2198   directory  at the fol lowing 
  2199   "PKG",48,2 2,1,"PAH", 1,1,170,0)
  2200   OI Field O ffices:
  2201   "PKG",48,2 2,1,"PAH", 1,1,171,0)
  2202    
  2203   "PKG",48,2 2,1,"PAH", 1,1,172,0)
  2204   Hines:  DN S     .URL          
  2205   "PKG",48,2 2,1,"PAH", 1,1,173,0)
  2206   Salt Lake  City:        
. URL        
  2207   "PKG",48,2 2,1,"PAH", 1,1,174,0)
  2208    
  2209   "PKG",48,2 2,1,"PAH", 1,1,175,0)
  2210   Documentat ion can al so be foun d on the V A Software  Documenta tion Libra ry 
  2211   "PKG",48,2 2,1,"PAH", 1,1,176,0)
  2212   at:
  2213   "PKG",48,2 2,1,"PAH", 1,1,177,0)
  2214   http://www . DNS     /vdl/
  2215   "PKG",48,2 2,1,"PAH", 1,1,178,0)
  2216    
  2217   "PKG",48,2 2,1,"PAH", 1,1,179,0)
  2218    
  2219   "PKG",48,2 2,1,"PAH", 1,1,180,0)
  2220   Title   Fi le Name        FTP Mo de
  2221   "PKG",48,2 2,1,"PAH", 1,1,181,0)
  2222   ---------- ---------- ---------- ---------- ---------- ---------- ---------- -
  2223   "PKG",48,2 2,1,"PAH", 1,1,182,0)
  2224    
  2225   "PKG",48,2 2,1,"PAH", 1,1,183,0)
  2226    
  2227   "PKG",48,2 2,1,"PAH", 1,1,184,0)
  2228   Patch Inst allation:
  2229   "PKG",48,2 2,1,"PAH", 1,1,185,0)
  2230    
  2231   "PKG",48,2 2,1,"PAH", 1,1,186,0)
  2232    
  2233   "PKG",48,2 2,1,"PAH", 1,1,187,0)
  2234   Pre/Post I nstallatio n Overview :
  2235   "PKG",48,2 2,1,"PAH", 1,1,188,0)
  2236   ---------- ---------- ---------- -
  2237   "PKG",48,2 2,1,"PAH", 1,1,189,0)
  2238   N/A
  2239   "PKG",48,2 2,1,"PAH", 1,1,190,0)
  2240    
  2241   "PKG",48,2 2,1,"PAH", 1,1,191,0)
  2242   Pre-Instal lation Ins tructions:
  2243   "PKG",48,2 2,1,"PAH", 1,1,192,0)
  2244   ---------- ---------- ----------
  2245   "PKG",48,2 2,1,"PAH", 1,1,193,0)
  2246   This patch  may be in stalled wi th users o n the syst em althoug h it is 
  2247   "PKG",48,2 2,1,"PAH", 1,1,194,0)
  2248   recommende d that it  be install ed during  non-peak h ours to mi nimize 
  2249   "PKG",48,2 2,1,"PAH", 1,1,195,0)
  2250   potential  disruption  to users.  This patc h should t ake less t han 5 minu tes 
  2251   "PKG",48,2 2,1,"PAH", 1,1,196,0)
  2252   to install .
  2253   "PKG",48,2 2,1,"PAH", 1,1,197,0)
  2254    
  2255   "PKG",48,2 2,1,"PAH", 1,1,198,0)
  2256   There are  no ListMan  Options t hat need t o be disab led for th is patch.
  2257   "PKG",48,2 2,1,"PAH", 1,1,199,0)
  2258    
  2259   "PKG",48,2 2,1,"PAH", 1,1,200,0)
  2260    
  2261   "PKG",48,2 2,1,"PAH", 1,1,201,0)
  2262   Installati on Instruc tions:
  2263   "PKG",48,2 2,1,"PAH", 1,1,202,0)
  2264   ---------- ---------- ------
  2265   "PKG",48,2 2,1,"PAH", 1,1,203,0)
  2266    
  2267   "PKG",48,2 2,1,"PAH", 1,1,204,0)
  2268   1.      Ch oose the P ackMan mes sage conta ining this  patch.
  2269   "PKG",48,2 2,1,"PAH", 1,1,205,0)
  2270    
  2271   "PKG",48,2 2,1,"PAH", 1,1,206,0)
  2272   2.      Ch oose the I NSTALL/CHE CK MESSAGE  PackMan o ption. 
  2273   "PKG",48,2 2,1,"PAH", 1,1,207,0)
  2274    
  2275   "PKG",48,2 2,1,"PAH", 1,1,208,0)
  2276   3.      Fr om the Ker nel Instal lation and  Distribut ion System  Menu, sel ect 
  2277   "PKG",48,2 2,1,"PAH", 1,1,209,0)
  2278   the Instal lation Men u (See Ins tall Promp ts Sample  below for  more 
  2279   "PKG",48,2 2,1,"PAH", 1,1,210,0)
  2280   detail).   From this  menu, you  may elect  to use the  following  options. 
  2281   "PKG",48,2 2,1,"PAH", 1,1,211,0)
  2282   When promp ted for th e INSTALL  NAME enter  SD*5.3*67 6:
  2283   "PKG",48,2 2,1,"PAH", 1,1,212,0)
  2284   a.      Ba ckup a Tra nsport Glo bal - This  option wi ll create  a backup 
  2285   "PKG",48,2 2,1,"PAH", 1,1,213,0)
  2286   message of  any routi nes export ed with th is patch.  It will no t backup a ny 
  2287   "PKG",48,2 2,1,"PAH", 1,1,214,0)
  2288   other chan ges such a s DDs or t emplates.
  2289   "PKG",48,2 2,1,"PAH", 1,1,215,0)
  2290   b.      Co mpare Tran sport Glob al to Curr ent System  - This op tion will 
  2291   "PKG",48,2 2,1,"PAH", 1,1,216,0)
  2292   allow you  to view al l changes  that will  be made wh en this pa tch is 
  2293   "PKG",48,2 2,1,"PAH", 1,1,217,0)
  2294   installed.   It compa res all co mponents o f this pat ch routine s, DDs, 
  2295   "PKG",48,2 2,1,"PAH", 1,1,218,0)
  2296   templates,  etc.
  2297   "PKG",48,2 2,1,"PAH", 1,1,219,0)
  2298   c.      Ve rify Check sums in Tr ansport Gl obal - Thi s option w ill allow  you 
  2299   "PKG",48,2 2,1,"PAH", 1,1,220,0)
  2300   to ensure  the integr ity of the  routines  that are i n the tran sport glob al.
  2301   "PKG",48,2 2,1,"PAH", 1,1,221,0)
  2302   4.      Fr om the Ins tallation  Menu, sele ct the Ins tall Packa ge(s) opti on 
  2303   "PKG",48,2 2,1,"PAH", 1,1,222,0)
  2304   and choose  the patch  to instal l.
  2305   "PKG",48,2 2,1,"PAH", 1,1,223,0)
  2306    
  2307   "PKG",48,2 2,1,"PAH", 1,1,224,0)
  2308   5.      Wh en prompte d 'Want KI DS to Rebu ild Menu T rees Upon  Completion  of 
  2309   "PKG",48,2 2,1,"PAH", 1,1,225,0)
  2310   Install? N O//' Press  <Enter>.
  2311   "PKG",48,2 2,1,"PAH", 1,1,226,0)
  2312    
  2313   "PKG",48,2 2,1,"PAH", 1,1,227,0)
  2314   6.      Wh en prompte d 'Want KI DS to INHI BIT LOGONs  during th e install?  
  2315   "PKG",48,2 2,1,"PAH", 1,1,228,0)
  2316   NO//'
  2317   "PKG",48,2 2,1,"PAH", 1,1,229,0)
  2318   Press <Ent er>.
  2319   "PKG",48,2 2,1,"PAH", 1,1,230,0)
  2320   7.      Wh en prompte d 'Want to  DISABLE S cheduled O ptions, Me nu Options
  2321   "PKG",48,2 2,1,"PAH", 1,1,231,0)
  2322   and Protoc ols? NO//'  
  2323   "PKG",48,2 2,1,"PAH", 1,1,232,0)
  2324   Press <Ent er>.
  2325   "PKG",48,2 2,1,"PAH", 1,1,233,0)
  2326   8.      If  prompted  'Delay Ins tall (Minu tes):  (0  - 60): 0// ' respond  0.
  2327   "PKG",48,2 2,1,"PAH", 1,1,234,0)
  2328    
  2329   "PKG",48,2 2,1,"PAH", 1,1,235,0)
  2330    
  2331   "PKG",48,2 2,1,"PAH", 1,1,236,0)
  2332   Install Pr ompts Samp le:
  2333   "PKG",48,2 2,1,"PAH", 1,1,237,0)
  2334   ---------- ---------- ------
  2335   "PKG",48,2 2,1,"PAH", 1,1,238,0)
  2336    
  2337   "PKG",48,2 2,1,"PAH", 1,1,239,0)
  2338    
  2339   "PKG",48,2 2,1,"PAH", 1,1,240,0)
  2340   VISTA>D ^X UP
  2341   "PKG",48,2 2,1,"PAH", 1,1,241,0)
  2342    
  2343   "PKG",48,2 2,1,"PAH", 1,1,242,0)
  2344   Setting up  programme r environm ent
  2345   "PKG",48,2 2,1,"PAH", 1,1,243,0)
  2346   This is a  TEST accou nt.
  2347   "PKG",48,2 2,1,"PAH", 1,1,244,0)
  2348    
  2349   "PKG",48,2 2,1,"PAH", 1,1,245,0)
  2350   Terminal T ype set to : C-VT100
  2351   "PKG",48,2 2,1,"PAH", 1,1,246,0)
  2352    
  2353   "PKG",48,2 2,1,"PAH", 1,1,247,0)
  2354   Select OPT ION NAME:  XPD LOAD D ISTRIBUTIO N       Lo ad a Distr ibution
  2355   "PKG",48,2 2,1,"PAH", 1,1,248,0)
  2356   Load a Dis tribution
  2357   "PKG",48,2 2,1,"PAH", 1,1,249,0)
  2358   Enter a Ho st File: C :\HFS\SD_5 _3_676.KID
  2359   "PKG",48,2 2,1,"PAH", 1,1,250,0)
  2360    
  2361   "PKG",48,2 2,1,"PAH", 1,1,251,0)
  2362   KIDS Distr ibution sa ved on Dec  11, 2017@ 17:30:58
  2363   "PKG",48,2 2,1,"PAH", 1,1,252,0)
  2364   Comment: S D*5.3*676  12/11/17
  2365   "PKG",48,2 2,1,"PAH", 1,1,253,0)
  2366    
  2367   "PKG",48,2 2,1,"PAH", 1,1,254,0)
  2368   This Distr ibution co ntains Tra nsport Glo bals for t he followi ng Package (s):
  2369   "PKG",48,2 2,1,"PAH", 1,1,255,0)
  2370   Build SD*5 .3*676 has  been load ed before,  here is w hen: 
  2371   "PKG",48,2 2,1,"PAH", 1,1,256,0)
  2372         SD*5 .3*676   I nstall Com pleted
  2373   "PKG",48,2 2,1,"PAH", 1,1,257,0)
  2374                       w as loaded  on Oct 05,  2017@22:2 9:55
  2375   "PKG",48,2 2,1,"PAH", 1,1,258,0)
  2376         SD*5 .3*676   I nstall Com pleted
  2377   "PKG",48,2 2,1,"PAH", 1,1,259,0)
  2378                       w as loaded  on Oct 10,  2017@16:0 3:37
  2379   "PKG",48,2 2,1,"PAH", 1,1,260,0)
  2380         SD*5 .3*676   I nstall Com pleted
  2381   "PKG",48,2 2,1,"PAH", 1,1,261,0)
  2382                       w as loaded  on Nov 15,  2017@00:1 2:36
  2383   "PKG",48,2 2,1,"PAH", 1,1,262,0)
  2384         SD*5 .3*676   I nstall Com pleted
  2385   "PKG",48,2 2,1,"PAH", 1,1,263,0)
  2386                       w as loaded  on Nov 20,  2017@14:5 9:25
  2387   "PKG",48,2 2,1,"PAH", 1,1,264,0)
  2388         SD*5 .3*676   I nstall Com pleted
  2389   "PKG",48,2 2,1,"PAH", 1,1,265,0)
  2390                       w as loaded  on Nov 20,  2017@20:4 0:22
  2391   "PKG",48,2 2,1,"PAH", 1,1,266,0)
  2392         SD*5 .3*676   I nstall Com pleted
  2393   "PKG",48,2 2,1,"PAH", 1,1,267,0)
  2394                       w as loaded  on Nov 21,  2017@15:4 0:34
  2395   "PKG",48,2 2,1,"PAH", 1,1,268,0)
  2396         SD*5 .3*676   I nstall Com pleted
  2397   "PKG",48,2 2,1,"PAH", 1,1,269,0)
  2398                       w as loaded  on Nov 30,  2017@15:0 5:44
  2399   "PKG",48,2 2,1,"PAH", 1,1,270,0)
  2400         SD*5 .3*676   I nstall Com pleted
  2401   "PKG",48,2 2,1,"PAH", 1,1,271,0)
  2402                       w as loaded  on Dec 05,  2017@16:1 6:46
  2403   "PKG",48,2 2,1,"PAH", 1,1,272,0)
  2404   OK to cont inue with  Load? NO//  YES
  2405   "PKG",48,2 2,1,"PAH", 1,1,273,0)
  2406    
  2407   "PKG",48,2 2,1,"PAH", 1,1,274,0)
  2408    
  2409   "PKG",48,2 2,1,"PAH", 1,1,275,0)
  2410   Distributi on OK!
  2411   "PKG",48,2 2,1,"PAH", 1,1,276,0)
  2412    
  2413   "PKG",48,2 2,1,"PAH", 1,1,277,0)
  2414   Want to Co ntinue wit h Load? YE S// 
  2415   "PKG",48,2 2,1,"PAH", 1,1,278,0)
  2416   Loading Di stribution ...
  2417   "PKG",48,2 2,1,"PAH", 1,1,279,0)
  2418    
  2419   "PKG",48,2 2,1,"PAH", 1,1,280,0)
  2420      SD*5.3* 676
  2421   "PKG",48,2 2,1,"PAH", 1,1,281,0)
  2422    
  2423   "PKG",48,2 2,1,"PAH", 1,1,282,0)
  2424   Use INSTAL L NAME: SD *5.3*676 t o install  this Distr ibution.
  2425   "PKG",48,2 2,1,"PAH", 1,1,283,0)
  2426    
  2427   "PKG",48,2 2,1,"PAH", 1,1,284,0)
  2428    
  2429   "PKG",48,2 2,1,"PAH", 1,1,285,0)
  2430   VISTA>D ^X UP
  2431   "PKG",48,2 2,1,"PAH", 1,1,286,0)
  2432    
  2433   "PKG",48,2 2,1,"PAH", 1,1,287,0)
  2434   Setting up  programme r environm ent
  2435   "PKG",48,2 2,1,"PAH", 1,1,288,0)
  2436    
  2437   "PKG",48,2 2,1,"PAH", 1,1,289,0)
  2438   This is a  TEST accou nt.
  2439   "PKG",48,2 2,1,"PAH", 1,1,290,0)
  2440    
  2441   "PKG",48,2 2,1,"PAH", 1,1,291,0)
  2442   Terminal T ype set to : C-VT100
  2443   "PKG",48,2 2,1,"PAH", 1,1,292,0)
  2444    
  2445   "PKG",48,2 2,1,"PAH", 1,1,293,0)
  2446   Select OPT ION NAME:  XPD INS
  2447   "PKG",48,2 2,1,"PAH", 1,1,294,0)
  2448        1   X PD INSTALL  BUILD        Install  Package(s )
  2449   "PKG",48,2 2,1,"PAH", 1,1,295,0)
  2450        2   X PD INSTALL ATION MENU        Ins tallation
  2451   "PKG",48,2 2,1,"PAH", 1,1,296,0)
  2452   CHOOSE 1-2 : 1  XPD I NSTALL BUI LD     Ins tall Packa ge(s)
  2453   "PKG",48,2 2,1,"PAH", 1,1,297,0)
  2454   Install Pa ckage(s)
  2455   "PKG",48,2 2,1,"PAH", 1,1,298,0)
  2456   Select INS TALL NAME:  SD*5.3*67 6       Lo aded from  Distributi on    
  2457   "PKG",48,2 2,1,"PAH", 1,1,299,0)
  2458   12/12/17@2 3:49
  2459   "PKG",48,2 2,1,"PAH", 1,1,300,0)
  2460   :43
  2461   "PKG",48,2 2,1,"PAH", 1,1,301,0)
  2462        => SD *5.3*676 1 2/11/17  ; Created on  Dec 11, 2 017@17:30: 58
  2463   "PKG",48,2 2,1,"PAH", 1,1,302,0)
  2464    
  2465   "PKG",48,2 2,1,"PAH", 1,1,303,0)
  2466   This Distr ibution wa s loaded o n Dec 12,  2017@23:49 :43 with h eader of 
  2467   "PKG",48,2 2,1,"PAH", 1,1,304,0)
  2468      SD*5.3* 676 12/11/ 17  ;Creat ed on Dec  11, 2017@1 7:30:58
  2469   "PKG",48,2 2,1,"PAH", 1,1,305,0)
  2470      It cons isted of t he followi ng Install (s):
  2471   "PKG",48,2 2,1,"PAH", 1,1,306,0)
  2472        SD*5. 3*676
  2473   "PKG",48,2 2,1,"PAH", 1,1,307,0)
  2474   Checking I nstall for  Package S D*5.3*676
  2475   "PKG",48,2 2,1,"PAH", 1,1,308,0)
  2476    
  2477   "PKG",48,2 2,1,"PAH", 1,1,309,0)
  2478   Install Qu estions fo r SD*5.3*6 76
  2479   "PKG",48,2 2,1,"PAH", 1,1,310,0)
  2480    
  2481   "PKG",48,2 2,1,"PAH", 1,1,311,0)
  2482   Incoming F iles:
  2483   "PKG",48,2 2,1,"PAH", 1,1,312,0)
  2484    
  2485   "PKG",48,2 2,1,"PAH", 1,1,313,0)
  2486      44         HOSPITA L LOCATION   (Partial  Definitio n)
  2487   "PKG",48,2 2,1,"PAH", 1,1,314,0)
  2488   Note:  You  already h ave the 'H OSPITAL LO CATION' Fi le.
  2489   "PKG",48,2 2,1,"PAH", 1,1,315,0)
  2490    
  2491   "PKG",48,2 2,1,"PAH", 1,1,316,0)
  2492   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install?  NO// 
  2493   "PKG",48,2 2,1,"PAH", 1,1,317,0)
  2494    
  2495   "PKG",48,2 2,1,"PAH", 1,1,318,0)
  2496    
  2497   "PKG",48,2 2,1,"PAH", 1,1,319,0)
  2498   Want KIDS  to INHIBIT  LOGONs du ring the i nstall? NO // 
  2499   "PKG",48,2 2,1,"PAH", 1,1,320,0)
  2500   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls? NO// 
  2501   "PKG",48,2 2,1,"PAH", 1,1,321,0)
  2502    
  2503   "PKG",48,2 2,1,"PAH", 1,1,322,0)
  2504   Enter the  Device you  want to p rint the I nstall mes sages.
  2505   "PKG",48,2 2,1,"PAH", 1,1,323,0)
  2506   You can qu eue the in stall by e nter a 'Q'  at the de vice promp t.
  2507   "PKG",48,2 2,1,"PAH", 1,1,324,0)
  2508   Enter a '^ ' to abort  the insta ll.
  2509   "PKG",48,2 2,1,"PAH", 1,1,325,0)
  2510    
  2511   "PKG",48,2 2,1,"PAH", 1,1,326,0)
  2512   DEVICE: HO ME//   CON SOLE
  2513   "PKG",48,2 2,1,"PAH", 1,1,327,0)
  2514    
  2515   "PKG",48,2 2,1,"PAH", 1,1,328,0)
  2516    Install S tarted for  SD*5.3*67 6 : 
  2517   "PKG",48,2 2,1,"PAH", 1,1,329,0)
  2518                   Dec 1 2, 2017@23 :51:21
  2519   "PKG",48,2 2,1,"PAH", 1,1,330,0)
  2520    
  2521   "PKG",48,2 2,1,"PAH", 1,1,331,0)
  2522   Build Dist ribution D ate: Dec 1 1, 2017
  2523   "PKG",48,2 2,1,"PAH", 1,1,332,0)
  2524    
  2525   "PKG",48,2 2,1,"PAH", 1,1,333,0)
  2526    Installin g Routines :
  2527   "PKG",48,2 2,1,"PAH", 1,1,334,0)
  2528                    Dec  12, 2017@2 3:51:22
  2529   "PKG",48,2 2,1,"PAH", 1,1,335,0)
  2530    
  2531   "PKG",48,2 2,1,"PAH", 1,1,336,0)
  2532    Installin g Data Dic tionaries:  
  2533   "PKG",48,2 2,1,"PAH", 1,1,337,0)
  2534                    Dec  12, 2017@2 3:51:22
  2535   "PKG",48,2 2,1,"PAH", 1,1,338,0)
  2536    
  2537   "PKG",48,2 2,1,"PAH", 1,1,339,0)
  2538    Installin g PACKAGE  COMPONENTS
  2539   "PKG",48,2 2,1,"PAH", 1,1,340,0)
  2540    
  2541   "PKG",48,2 2,1,"PAH", 1,1,341,0)
  2542    Installin g PROTOCOL
  2543   "PKG",48,2 2,1,"PAH", 1,1,342,0)
  2544    
  2545   "PKG",48,2 2,1,"PAH", 1,1,343,0)
  2546    Installin g OPTION
  2547   "PKG",48,2 2,1,"PAH", 1,1,344,0)
  2548    
  2549   "PKG",48,2 2,1,"PAH", 1,1,345,0)
  2550    Installin g PARAMETE R DEFINITI ON
  2551   "PKG",48,2 2,1,"PAH", 1,1,346,0)
  2552    
  2553   "PKG",48,2 2,1,"PAH", 1,1,347,0)
  2554    Installin g HLO APPL ICATION RE GISTRY
  2555   "PKG",48,2 2,1,"PAH", 1,1,348,0)
  2556                    Dec  12, 2017@2 3:51:23
  2557   "PKG",48,2 2,1,"PAH", 1,1,349,0)
  2558    
  2559   "PKG",48,2 2,1,"PAH", 1,1,350,0)
  2560    Updating  Routine fi le...
  2561   "PKG",48,2 2,1,"PAH", 1,1,351,0)
  2562    
  2563   "PKG",48,2 2,1,"PAH", 1,1,352,0)
  2564    Updating  KIDS files ...
  2565   "PKG",48,2 2,1,"PAH", 1,1,353,0)
  2566    
  2567   "PKG",48,2 2,1,"PAH", 1,1,354,0)
  2568    SD*5.3*67 6 Installe d. 
  2569   "PKG",48,2 2,1,"PAH", 1,1,355,0)
  2570                   Dec 1 2, 2017@23 :51:23
  2571   "PKG",48,2 2,1,"PAH", 1,1,356,0)
  2572    
  2573   "PKG",48,2 2,1,"PAH", 1,1,357,0)
  2574    No link t o PACKAGE  file
  2575   "PKG",48,2 2,1,"PAH", 1,1,358,0)
  2576    
  2577   "PKG",48,2 2,1,"PAH", 1,1,359,0)
  2578    NO Instal l Message  sent 
  2579   "PKG",48,2 2,1,"PAH", 1,1,360,0)
  2580    
  2581   "PKG",48,2 2,1,"PAH", 1,1,361,0)
  2582   Install Co mpleted
  2583   "PKG",48,2 2,1,"PAH", 1,1,362,0)
  2584    
  2585   "PKG",48,2 2,1,"PAH", 1,1,363,0)
  2586   VISTA>
  2587   "PKG",48,2 2,1,"PAH", 1,1,364,0)
  2588    
  2589   "PKG",48,2 2,1,"PAH", 1,1,365,0)
  2590    
  2591   "PKG",48,2 2,1,"PAH", 1,1,366,0)
  2592   Patch Back out Instru ctions:
  2593   "PKG",48,2 2,1,"PAH", 1,1,367,0)
  2594   ---------- ---------- ------
  2595   "PKG",48,2 2,1,"PAH", 1,1,368,0)
  2596   1.      Go  to MailMa n menu, ch oose optio n Read/Man age Messag es and sel ect 
  2597   "PKG",48,2 2,1,"PAH", 1,1,369,0)
  2598   the backup  message t hat was cr eating dur ing Instal lation ste p 3.c - Ba ckup
  2599   "PKG",48,2 2,1,"PAH", 1,1,370,0)
  2600   2.      Wh en prompte d 'Type <E nter> to c ontinue or  '^' to ex it:' type  '^' 
  2601   "PKG",48,2 2,1,"PAH", 1,1,371,0)
  2602   and then < Enter>
  2603   "PKG",48,2 2,1,"PAH", 1,1,372,0)
  2604   3.      Wh en prompte d 'Enter m essage act ion:' type  'Xtract P ackMan' an
  2605   "PKG",48,2 2,1,"PAH", 1,1,373,0)
  2606   then <Ente r>
  2607   "PKG",48,2 2,1,"PAH", 1,1,374,0)
  2608   4.      Th e followin g message  and the pr ompt will  display:
  2609   "PKG",48,2 2,1,"PAH", 1,1,375,0)
  2610   Warning: I nstalling  this messa ge will ca use a perm anent upda te of glob als 
  2611   "PKG",48,2 2,1,"PAH", 1,1,376,0)
  2612   and routin es.
  2613   "PKG",48,2 2,1,"PAH", 1,1,377,0)
  2614   Do you rea lly want t o do this?  NO//' typ e 'YES' an d then <En ter>
  2615   "PKG",48,2 2,1,"PAH", 1,1,378,0)
  2616   5.      Wh en prompte d: 
  2617   "PKG",48,2 2,1,"PAH", 1,1,379,0)
  2618   'Shall I p reserve th e routines  on disk i n a separa te back-up  message? 
  2619   "PKG",48,2 2,1,"PAH", 1,1,380,0)
  2620   YES//' typ e 'NO' and  then <Ent er>
  2621   "PKG",48,2 2,1,"PAH", 1,1,381,0)
  2622   6.      Th e system w ill displa y the foll owing mess age and sh ow all the  
  2623   "PKG",48,2 2,1,"PAH", 1,1,382,0)
  2624   routines t hat were u nloaded co nfirming t hat all th e routines  in the bu ild 
  2625   "PKG",48,2 2,1,"PAH", 1,1,383,0)
  2626   have been  restored t o the prio r version  (unloaded) :
  2627   "PKG",48,2 2,1,"PAH", 1,1,384,0)
  2628   'No backup  message b uilt.
  2629   "PKG",48,2 2,1,"PAH", 1,1,385,0)
  2630    ***LIST o f routines  from back up. See fu ll routine  list at t he end of  the 
  2631   "PKG",48,2 2,1,"PAH", 1,1,386,0)
  2632   document** *
  2633   "PKG",48,2 2,1,"PAH", 1,1,387,0)
  2634    
  2635   "PKG",48,2 2,1,"PAH", 1,1,388,0)
  2636   Select Pac kMan funct ion: and t hen <Enter >'
  2637   "PKG",48,2 2,1,"PAH", 1,1,389,0)
  2638   7.      ne xVerify th at all six  routines  are listed  as above  have been 
  2639   "PKG",48,2 2,1,"PAH", 1,1,390,0)
  2640   backed out :
  2641   "PKG",48,2 2,1,"PAH", 1,1,391,0)
  2642   No backup  message bu ilt.
  2643   "PKG",48,2 2,1,"PAH", 1,1,392,0)
  2644   When promp ted 'Want  KIDS to IN HIBIT LOGO Ns during  the instal l? NO//'
  2645   "PKG",48,2 2,1,"PAH", 1,1,393,0)
  2646   Press <Ent er>.
  2647   "PKG",48,2 2,1,"PAH", 1,1,394,0)
  2648   When promp ted 'Want  to DISABLE  Scheduled  Options,  Menu Optio ns, and 
  2649   "PKG",48,2 2,1,"PAH", 1,1,395,0)
  2650   Protocols?  NO//' 
  2651   "PKG",48,2 2,1,"PAH", 1,1,396,0)
  2652   Press <Ent er>.
  2653   "PKG",48,2 2,1,"PAH", 1,1,397,0)
  2654   If prompte d 'Delay I nstall (Mi nutes):  ( 0 - 60): 0 //' respon d 0.
  2655   "PKG",48,2 2,1,"PAH", 1,1,398,0)
  2656   8.      Th ere are no  globals t hat are be ing saved  off for th is patch t
  2657   "PKG",48,2 2,1,"PAH", 1,1,399,0)
  2658   restore. A ll other o bjects sho uld be man ually back ed out or  deleted 
  2659   "PKG",48,2 2,1,"PAH", 1,1,400,0)
  2660   Fileman. 
  2661   "PKG",48,2 2,1,"PAH", 1,1,401,0)
  2662   9.      De leting Fil es:
  2663   "PKG",48,2 2,1,"PAH", 1,1,402,0)
  2664   The follow ing FileMa n files sh ould be de leted unde r their re spective 
  2665   "PKG",48,2 2,1,"PAH", 1,1,403,0)
  2666   groups. To  delete th e file, op en FileMan  for the f ile specif ied. Look  for 
  2667   "PKG",48,2 2,1,"PAH", 1,1,404,0)
  2668   the name a nd once se lected ent er @ to en ter the de lete optio n.
  2669   "PKG",48,2 2,1,"PAH", 1,1,405,0)
  2670    
  2671   "PKG",48,2 2,1,"PAH", 1,1,406,0)
  2672   Example:
  2673   "PKG",48,2 2,1,"PAH", 1,1,407,0)
  2674   VA FileMan  22.2
  2675   "PKG",48,2 2,1,"PAH", 1,1,408,0)
  2676    
  2677   "PKG",48,2 2,1,"PAH", 1,1,409,0)
  2678    
  2679   "PKG",48,2 2,1,"PAH", 1,1,410,0)
  2680   Select OPT ION: 1  EN TER OR EDI T FILE ENT RIES
  2681   "PKG",48,2 2,1,"PAH", 1,1,411,0)
  2682    
  2683   "PKG",48,2 2,1,"PAH", 1,1,412,0)
  2684   Input to w hat File:  PROTOCOL//              (4498 en tries)
  2685   "PKG",48,2 2,1,"PAH", 1,1,413,0)
  2686   EDIT WHICH  FIELD: AL L//
  2687   "PKG",48,2 2,1,"PAH", 1,1,414,0)
  2688    
  2689   "PKG",48,2 2,1,"PAH", 1,1,415,0)
  2690   Select PRO TOCOL NAME : SD SIU T RIGGER        SD SIU  TRIGGER
  2691   "PKG",48,2 2,1,"PAH", 1,1,416,0)
  2692   NAME: SD S IU TRIGGER // @
  2693   "PKG",48,2 2,1,"PAH", 1,1,417,0)
  2694      SURE YO U WANT TO  DELETE THE  ENTIRE 'S D SIU TRIG GER' PROTO COL?
  2695   "PKG",48,2 2,1,"PAH", 1,1,418,0)
  2696    
  2697   "PKG",48,2 2,1,"PAH", 1,1,419,0)
  2698   10.     Mo difying fi les:
  2699   "PKG",48,2 2,1,"PAH", 1,1,420,0)
  2700   The follow ing files  can be upd ated in Fi leMan but  they are e xisting 
  2701   "PKG",48,2 2,1,"PAH", 1,1,421,0)
  2702   files. The y should n ot be dele ted. Inste ad reverti ng them ba ck will be  
  2703   "PKG",48,2 2,1,"PAH", 1,1,422,0)
  2704   the correc t approach .
  2705   "PKG",48,2 2,1,"PAH", 1,1,423,0)
  2706    
  2707   "PKG",48,2 2,1,"PAH", 1,1,424,0)
  2708   Example:
  2709   "PKG",48,2 2,1,"PAH", 1,1,425,0)
  2710    
  2711   "PKG",48,2 2,1,"PAH", 1,1,426,0)
  2712   VA FileMan  22.2
  2713   "PKG",48,2 2,1,"PAH", 1,1,427,0)
  2714    
  2715   "PKG",48,2 2,1,"PAH", 1,1,428,0)
  2716    
  2717   "PKG",48,2 2,1,"PAH", 1,1,429,0)
  2718   Select OPT ION: 1  EN TER OR EDI T FILE ENT RIES
  2719   "PKG",48,2 2,1,"PAH", 1,1,430,0)
  2720    
  2721   "PKG",48,2 2,1,"PAH", 1,1,431,0)
  2722   Input to w hat File:  PROTOCOL//              (4498 en tries)
  2723   "PKG",48,2 2,1,"PAH", 1,1,432,0)
  2724   EDIT WHICH  FIELD: AL L// item
  2725   "PKG",48,2 2,1,"PAH", 1,1,433,0)
  2726        1   I TEM    (mu ltiple)
  2727   "PKG",48,2 2,1,"PAH", 1,1,434,0)
  2728        2   I TEM TEXT
  2729   "PKG",48,2 2,1,"PAH", 1,1,435,0)
  2730   CHOOSE 1-2 : 1  ITEM   (multiple )
  2731   "PKG",48,2 2,1,"PAH", 1,1,436,0)
  2732      EDIT WH ICH ITEM S UB-FIELD:  ALL//
  2733   "PKG",48,2 2,1,"PAH", 1,1,437,0)
  2734   THEN EDIT  FIELD:
  2735   "PKG",48,2 2,1,"PAH", 1,1,438,0)
  2736    
  2737   "PKG",48,2 2,1,"PAH", 1,1,439,0)
  2738   Select PRO TOCOL NAME : SDAM APP OINTMENT E VENTS        Appointm ent Event 
  2739   "PKG",48,2 2,1,"PAH", 1,1,440,0)
  2740   Driver
  2741   "PKG",48,2 2,1,"PAH", 1,1,441,0)
  2742   Select ITE M: SD SIU  TRIGGER//  SD SIU TRI GGER        SD SIU TR IGGER
  2743   "PKG",48,2 2,1,"PAH", 1,1,442,0)
  2744            . ..OK? Yes/ /   (Yes)
  2745   "PKG",48,2 2,1,"PAH", 1,1,443,0)
  2746    
  2747   "PKG",48,2 2,1,"PAH", 1,1,444,0)
  2748     ITEM: SD  SIU TRIGG ER// @
  2749   "PKG",48,2 2,1,"PAH", 1,1,445,0)
  2750      SURE YO U WANT TO  DELETE THE  ENTIRE IT EM?
  2751   "PKG",48,2 2,1,"PAH", 1,1,446,0)
  2752    
  2753   "PKG",48,2 2,1,"PAH", 1,1,447,0)
  2754   Protocol:
  2755   "PKG",48,2 2,1,"PAH", 1,1,448,0)
  2756   SDAM APPOI NTMENT EVE NTS
  2757   "PKG",48,2 2,1,"PAH", 1,1,449,0)
  2758   1.      Re move SD SI U TRIGGER  from the I tem list
  2759   "PKG",48,2 2,1,"PAH", 1,1,450,0)
  2760    
  2761   "PKG",48,2 2,1,"PAH", 1,1,451,0)
  2762   11.     To  clean up  the item r un BACKOUT ^SDMXPOST  to clean u p the cros
  2763   "PKG",48,2 2,1,"PAH", 1,1,452,0)
  2764   references .
  2765   "PKG",48,2 2,1,"PAH", 1,1,453,0)
  2766    
  2767   "PKG",48,2 2,1,"PAH", 1,1,454,0)
  2768   VISTA>D BA CKOUT^SDMX POST
  2769   "PKG",48,2 2,1,"PAH", 1,1,455,0)
  2770    
  2771   "PKG",48,2 2,1,"PAH", 1,1,456,0)
  2772   Backup fil e Temporar y backup f ile: found ; restore  commencing ... Restor ing 
  2773   "PKG",48,2 2,1,"PAH", 1,1,457,0)
  2774   data dicti onary for  file #44.. . SD*5.3*6 76 Back ou t finished !
  2775   "PKG",48,2 2,1,"PAH", 1,1,458,0)
  2776    
  2777   "PKG",48,2 2,1,"PAH", 1,1,459,0)
  2778   VISTA>
  2779   "PKG",48,2 2,1,"PAH", 1,1,460,0)
  2780    
  2781   "PKG",48,2 2,1,"PAH", 1,1,461,0)
  2782   Post-Insta llation In structions :
  2783   "PKG",48,2 2,1,"PAH", 1,1,462,0)
  2784   ---------- ---------- ---------- -
  2785   "PKG",48,2 2,1,"PAH", 1,1,463,0)
  2786   See Techni cal Manual  for cross  reference /object co ntents ver ification
  2787   "PKG",48,2 2,1,"PAH", 1,1,464,0)
  2788    
  2789   "PKG",48,2 2,1,"PAH", 1,1,465,0)
  2790   Check list  to Verify :
  2791   "PKG",48,2 2,1,"PAH", 1,1,466,0)
  2792   1.      It em 22902 i n the hosp ital locat ion file.
  2793   "PKG",48,2 2,1,"PAH", 1,1,467,0)
  2794   2.      HL O Applicat ions
  2795   "PKG",48,2 2,1,"PAH", 1,1,468,0)
  2796   3.      HL  Logical L inks
  2797   "PKG",48,2 2,1,"PAH", 1,1,469,0)
  2798   4.      Pr otocol
  2799   "PKG",48,2 2,1,"PAH", 1,1,470,0)
  2800   5.      Pa rameters
  2801   "PKG",48,2 2,1,"PAH", 1,1,471,0)
  2802   6.      Op tions
  2803   "PKG",48,2 2,1,"PAH", 1,1,472,0)
  2804    
  2805   "PKG",48,2 2,1,"PAH", 1,1,473,0)
  2806    
  2807   "PKG",48,2 2,1,"PAH", 1,1,474,0)
  2808   Routine In formation:
  2809   "PKG",48,2 2,1,"PAH", 1,1,475,0)
  2810   ========== ==========
  2811   "PKG",48,2 2,1,"PAH", 1,1,476,0)
  2812    
  2813   "PKG",48,2 2,1,"PAH", 1,1,477,0)
  2814    
  2815   "PKG",48,2 2,1,"PAH", 1,1,478,0)
  2816   The second  line of e ach of the se routine s now look s like:
  2817   "PKG",48,2 2,1,"PAH", 1,1,479,0)
  2818    ;;5.3;Sch eduling;** [Patch Lis t]**;Aug 1 3, 1993;Bu ild 63
  2819   "PKG",48,2 2,1,"PAH", 1,1,480,0)
  2820    
  2821   "PKG",48,2 2,1,"PAH", 1,1,481,0)
  2822   The checks ums below  are new ch ecksums, a nd
  2823   "PKG",48,2 2,1,"PAH", 1,1,482,0)
  2824    
  2825   "PKG",48,2 2,1,"PAH", 1,1,483,0)
  2826    can be ch ecked with  CHECK1^XT SUMBLD.
  2827   "PKG",48,2 2,1,"PAH", 1,1,484,0)
  2828    
  2829   "PKG",48,2 2,1,"PAH", 1,1,485,0)
  2830   Routine Na me: SDAM
  2831   "PKG",48,2 2,1,"PAH", 1,1,486,0)
  2832       Before : B1000938 2   After:  B10247694   **149,17 7,76,242,3 80,676**
  2833   "PKG",48,2 2,1,"PAH", 1,1,487,0)
  2834   Routine Na me: SDAM2
  2835   "PKG",48,2 2,1,"PAH", 1,1,488,0)
  2836       Before : B3080301 8   After:  B31432956   **250,29 6,327,478, 446,627,67 6**
  2837   "PKG",48,2 2,1,"PAH", 1,1,489,0)
  2838   Routine Na me: SDAM3
  2839   "PKG",48,2 2,1,"PAH", 1,1,490,0)
  2840       Before : B1089527 5   After:  B11043233   **63,189 ,380,478,4 92,676**
  2841   "PKG",48,2 2,1,"PAH", 1,1,491,0)
  2842   Routine Na me: SDAMC
  2843   "PKG",48,2 2,1,"PAH", 1,1,492,0)
  2844       Before : B1537679 7   After:  B15498369   **20,28, 32,46,263, 414,444,47 8,
  2845   "PKG",48,2 2,1,"PAH", 1,1,493,0)
  2846                                                  538,554 ,597,592,6 76**
  2847   "PKG",48,2 2,1,"PAH", 1,1,494,0)
  2848   Routine Na me: SDAMEX
  2849   "PKG",48,2 2,1,"PAH", 1,1,495,0)
  2850       Before : B2359620 8   After:  B23902444   *676*
  2851   "PKG",48,2 2,1,"PAH", 1,1,496,0)
  2852   Routine Na me: SDAMN
  2853   "PKG",48,2 2,1,"PAH", 1,1,497,0)
  2854       Before :  B727263 7   After:   B7440404   **478,67 6**
  2855   "PKG",48,2 2,1,"PAH", 1,1,498,0)
  2856   Routine Na me: SDAMWI
  2857   "PKG",48,2 2,1,"PAH", 1,1,499,0)
  2858       Before : B1313891 3   After:  B13400175   
  2859   "PKG",48,2 2,1,"PAH", 1,1,500,0)
  2860   **63,94,24 1,250,296, 380,327,67 6**
  2861   "PKG",48,2 2,1,"PAH", 1,1,501,0)
  2862   Routine Na me: SDC
  2863   "PKG",48,2 2,1,"PAH", 1,1,502,0)
  2864       Before : B2763764 9   After:  B28386728   **15,32, 79,132,167 ,478,487,5 23,
  2865   "PKG",48,2 2,1,"PAH", 1,1,503,0)
  2866                                                  545,627 ,676**
  2867   "PKG",48,2 2,1,"PAH", 1,1,504,0)
  2868   Routine Na me: SDCO1
  2869   "PKG",48,2 2,1,"PAH", 1,1,505,0)
  2870       Before : B3253740 4   After:  B32904159   **27,132 ,149,193,2 50,296,446 ,
  2871   "PKG",48,2 2,1,"PAH", 1,1,506,0)
  2872                                                  538,627 ,676**
  2873   "PKG",48,2 2,1,"PAH", 1,1,507,0)
  2874   Routine Na me: SDCOAM
  2875   "PKG",48,2 2,1,"PAH", 1,1,508,0)
  2876       Before : B2081065 6   After:  B21133832   **1,20,2 7,66,132,6 76**
  2877   "PKG",48,2 2,1,"PAH", 1,1,509,0)
  2878   Routine Na me: SDM
  2879   "PKG",48,2 2,1,"PAH", 1,1,510,0)
  2880       Before : B3624172 3   After:  B36678428   **15,32, 38,41,44,7 9,94,167,1 68,
  2881   "PKG",48,2 2,1,"PAH", 1,1,511,0)
  2882                                                  218,223 ,250,254,2 96,380,478 ,
  2883   "PKG",48,2 2,1,"PAH", 1,1,512,0)
  2884                                                  441,619 ,676**
  2885   "PKG",48,2 2,1,"PAH", 1,1,513,0)
  2886   Routine Na me: SDMULT
  2887   "PKG",48,2 2,1,"PAH", 1,1,514,0)
  2888       Before : B1032594 3   After:  B10527012   **63,168 ,380,478,6 76**
  2889   "PKG",48,2 2,1,"PAH", 1,1,515,0)
  2890   Routine Na me: SDMXCA NC
  2891   "PKG",48,2 2,1,"PAH", 1,1,516,0)
  2892       Before :       n/ a   After:  B37363690   **676**
  2893   "PKG",48,2 2,1,"PAH", 1,1,517,0)
  2894   Routine Na me: SDMXCH KI
  2895   "PKG",48,2 2,1,"PAH", 1,1,518,0)
  2896       Before :       n/ a   After:  B15269182   **676**
  2897   "PKG",48,2 2,1,"PAH", 1,1,519,0)
  2898   Routine Na me: SDMXCH KO
  2899   "PKG",48,2 2,1,"PAH", 1,1,520,0)
  2900       Before :       n/ a   After:  B15245930   **676**
  2901   "PKG",48,2 2,1,"PAH", 1,1,521,0)
  2902   Routine Na me: SDMXCO RE
  2903   "PKG",48,2 2,1,"PAH", 1,1,522,0)
  2904       Before :       n/ a   After:  B24765165   **676**
  2905   "PKG",48,2 2,1,"PAH", 1,1,523,0)
  2906   Routine Na me: SDMXER RO
  2907   "PKG",48,2 2,1,"PAH", 1,1,524,0)
  2908       Before :       n/ a   After:   B4538024   **676**
  2909   "PKG",48,2 2,1,"PAH", 1,1,525,0)
  2910   Routine Na me: SDMXFL AG
  2911   "PKG",48,2 2,1,"PAH", 1,1,526,0)
  2912       Before :       n/ a   After:  B10435281   **676**
  2913   "PKG",48,2 2,1,"PAH", 1,1,527,0)
  2914   Routine Na me: SDMXGA PT
  2915   "PKG",48,2 2,1,"PAH", 1,1,528,0)
  2916       Before :       n/ a   After:  B27411750   **676**
  2917   "PKG",48,2 2,1,"PAH", 1,1,529,0)
  2918   Routine Na me: SDMXLK RQ
  2919   "PKG",48,2 2,1,"PAH", 1,1,530,0)
  2920       Before :       n/ a   After:  B21359925   **676**
  2921   "PKG",48,2 2,1,"PAH", 1,1,531,0)
  2922   Routine Na me: SDMXMA KE
  2923   "PKG",48,2 2,1,"PAH", 1,1,532,0)
  2924       Before :       n/ a   After:  B44182642   **676**
  2925   "PKG",48,2 2,1,"PAH", 1,1,533,0)
  2926   Routine Na me: SDMXNS
  2927   "PKG",48,2 2,1,"PAH", 1,1,534,0)
  2928       Before :       n/ a   After:   B9089731   **676**
  2929   "PKG",48,2 2,1,"PAH", 1,1,535,0)
  2930   Routine Na me: SDMXPO ST
  2931   "PKG",48,2 2,1,"PAH", 1,1,536,0)
  2932       Before :       n/ a   After:   B2034392   **676**
  2933   "PKG",48,2 2,1,"PAH", 1,1,537,0)
  2934   Routine Na me: SDMXPR E
  2935   "PKG",48,2 2,1,"PAH", 1,1,538,0)
  2936       Before :       n/ a   After:   B1473467   **676**
  2937   "PKG",48,2 2,1,"PAH", 1,1,539,0)
  2938   Routine Na me: SDMXSC HI
  2939   "PKG",48,2 2,1,"PAH", 1,1,540,0)
  2940       Before :       n/ a   After: B152446643   **676**
  2941   "PKG",48,2 2,1,"PAH", 1,1,541,0)
  2942   Routine Na me: SDMXSC HP
  2943   "PKG",48,2 2,1,"PAH", 1,1,542,0)
  2944       Before :       n/ a   After:  B68944719   **676**
  2945   "PKG",48,2 2,1,"PAH", 1,1,543,0)
  2946   Routine Na me: SDMXSC HT
  2947   "PKG",48,2 2,1,"PAH", 1,1,544,0)
  2948       Before :       n/ a   After:  B46137707   **676**
  2949   "PKG",48,2 2,1,"PAH", 1,1,545,0)
  2950   Routine Na me: SDMXTR CT
  2951   "PKG",48,2 2,1,"PAH", 1,1,546,0)
  2952       Before :       n/ a   After:  B19365757   **676**
  2953   "PKG",48,2 2,1,"PAH", 1,1,547,0)
  2954   Routine Na me: SDMXUC AN
  2955   "PKG",48,2 2,1,"PAH", 1,1,548,0)
  2956       Before :       n/ a   After:  B11140871   **676**
  2957   "PKG",48,2 2,1,"PAH", 1,1,549,0)
  2958   Routine Na me: SDNEXT
  2959   "PKG",48,2 2,1,"PAH", 1,1,550,0)
  2960       Before : B2193408 6   After:  B22402085   **41,45, 165,549,67 6**
  2961   "PKG",48,2 2,1,"PAH", 1,1,551,0)
  2962   Routine Na me: SDNEXT 1
  2963   "PKG",48,2 2,1,"PAH", 1,1,552,0)
  2964       Before :       n/ a   After:  B25894699   **676**
  2965   "PKG",48,2 2,1,"PAH", 1,1,553,0)
  2966    
  2967   "PKG",48,2 2,1,"PAH", 1,1,554,0)
  2968   Routine li st of prec eding patc hes: 492,  549, 592,  619, 627
  2969   "PKG",48,2 2,1,"PAH", 1,1,555,0)
  2970    
  2971   "PKG",48,2 2,1,"PAH", 1,1,556,0)
  2972    
  2973   "PKG",48,2 2,1,"PAH", 1,1,557,0)
  2974   ========== ========== ========== ========== ========== ========== ========== ====
  2975   "PKG",48,2 2,1,"PAH", 1,1,558,0)
  2976    
  2977   "PKG",48,2 2,1,"PAH", 1,1,559,0)
  2978   User Infor mation:  
  2979   "PKG",48,2 2,1,"PAH", 1,1,560,0)
  2980     Entered  By  :   NE EDHAM,MALC OLM      D ate Entere d  :   OCT   2,2017
  2981   "PKG",48,2 2,1,"PAH", 1,1,561,0)
  2982     Complete d By:                          D ate Comple ted:   
  2983   "PKG",48,2 2,1,"PAH", 1,1,562,0)
  2984     Released  By :                          D ate Releas ed :   
  2985   "PKG",48,2 2,1,"PAH", 1,1,563,0)
  2986   ========== ========== ========== ========== ========== ========== ========== ====
  2987   "QUES","XP F1",0)
  2988   Y
  2989   "QUES","XP F1","??")
  2990   ^D REP^XPD H
  2991   "QUES","XP F1","A")
  2992   Shall I wr ite over y our |FLAG|  File
  2993   "QUES","XP F1","B")
  2994   YES
  2995   "QUES","XP F1","M")
  2996   D XPF1^XPD IQ
  2997   "QUES","XP F2",0)
  2998   Y
  2999   "QUES","XP F2","??")
  3000   ^D DTA^XPD H
  3001   "QUES","XP F2","A")
  3002   Want my da ta |FLAG|  yours
  3003   "QUES","XP F2","B")
  3004   YES
  3005   "QUES","XP F2","M")
  3006   D XPF2^XPD IQ
  3007   "QUES","XP I1",0)
  3008   YO
  3009   "QUES","XP I1","??")
  3010   ^D INHIBIT ^XPDH
  3011   "QUES","XP I1","A")
  3012   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  3013   "QUES","XP I1","B")
  3014   NO
  3015   "QUES","XP I1","M")
  3016   D XPI1^XPD IQ
  3017   "QUES","XP M1",0)
  3018   PO^VA(200, :EM
  3019   "QUES","XP M1","??")
  3020   ^D MG^XPDH
  3021   "QUES","XP M1","A")
  3022   Enter the  Coordinato r for Mail  Group '|F LAG|'
  3023   "QUES","XP M1","B")
  3024  
  3025   "QUES","XP M1","M")
  3026   D XPM1^XPD IQ
  3027   "QUES","XP O1",0)
  3028   Y
  3029   "QUES","XP O1","??")
  3030   ^D MENU^XP DH
  3031   "QUES","XP O1","A")
  3032   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  3033   "QUES","XP O1","B")
  3034   NO
  3035   "QUES","XP O1","M")
  3036   D XPO1^XPD IQ
  3037   "QUES","XP Z1",0)
  3038   Y
  3039   "QUES","XP Z1","??")
  3040   ^D OPT^XPD H
  3041   "QUES","XP Z1","A")
  3042   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  3043   "QUES","XP Z1","B")
  3044   NO
  3045   "QUES","XP Z1","M")
  3046   D XPZ1^XPD IQ
  3047   "QUES","XP Z2",0)
  3048   Y
  3049   "QUES","XP Z2","??")
  3050   ^D RTN^XPD H
  3051   "QUES","XP Z2","A")
  3052   Want to MO VE routine s to other  CPUs
  3053   "QUES","XP Z2","B")
  3054   NO
  3055   "QUES","XP Z2","M")
  3056   D XPZ2^XPD IQ
  3057   "RTN")
  3058   32
  3059   "RTN","SDA M")
  3060   0^20^B1024 7694
  3061   "RTN","SDA M",1,0)
  3062   SDAM ;MJK/ ALB - Appt  Mgt ; 8/3 0/99 9:09a m
  3063   "RTN","SDA M",2,0)
  3064    ;;5.3;Sch eduling;** 149,177,76 ,242,380,6 76**;Aug 1 3, 1993;Bu ild 99
  3065   "RTN","SDA M",3,0)
  3066    ;
  3067   "RTN","SDA M",4,0)
  3068    D HDLKILL ^SDAMEVT
  3069   "RTN","SDA M",5,0)
  3070   EN ; -- ma in entry p oint
  3071   "RTN","SDA M",6,0)
  3072    N XQORS,V ALMEVL D E N^VALM("SD AM APPT MG T")
  3073   "RTN","SDA M",7,0)
  3074    Q
  3075   "RTN","SDA M",8,0)
  3076    ;
  3077   "RTN","SDA M",9,0)
  3078   INIT ; --  set up app t man vars
  3079   "RTN","SDA M",10,0)
  3080    K I,X,SDB EG,SDEND,S DB,XQORNOD ,SDFN,SDCL N,DA,DR,DI E,DNM,DQ,% B,SDRES
  3081   "RTN","SDA M",11,0)
  3082    S DIR(0)= "43,213",D IR("A")="S elect Pati ent name o r Clinic n ame"
  3083   "RTN","SDA M",12,0)
  3084    D ^DIR K  DIR I $D(D IRUT) S VA LMQUIT=""  G INITQ
  3085   "RTN","SDA M",13,0)
  3086    S SDY=Y
  3087   "RTN","SDA M",14,0)
  3088    I SDY["DP T(" S DFN= +SDY D 2^V ADPT I +VA DM(6) D  G :SDUP="^"  INIT
  3089   "RTN","SDA M",15,0)
  3090    . W !!,"W ARNING ",V ADM(7),!!
  3091   "RTN","SDA M",16,0)
  3092    . R "Pres s Return t o Continue  or ^ to Q uit: ",SDU P:DTIME
  3093   "RTN","SDA M",17,0)
  3094    I SDY["DP T(" S SDAM TYP="P",SD FN=+SDY D  INIT^SDAM1
  3095   "RTN","SDA M",18,0)
  3096    I SDY["SC ",$$MSG^SD MXFLAG(+Y)  G INIT      ; SD/676
  3097   "RTN","SDA M",19,0)
  3098    I SDY["SC (" S SDRES =$$CLNCK^S DUTL2(+SDY ,1) I 'SDR ES D  G IN IT
  3099   "RTN","SDA M",20,0)
  3100    . W !,?5, "Clinic MU ST be corr ected befo re continu ing."
  3101   "RTN","SDA M",21,0)
  3102    I SDY["SC (" S SDAMT YP="C",SDC LN=+SDY D  INIT^SDAM3
  3103   "RTN","SDA M",22,0)
  3104   INITQ Q
  3105   "RTN","SDA M",23,0)
  3106    ;
  3107   "RTN","SDA M",24,0)
  3108   HDR ; -- s creen head
  3109   "RTN","SDA M",25,0)
  3110    N X,SDX,S DLNX S SDL NX=2
  3111   "RTN","SDA M",26,0)
  3112    ;I SDAMTY P="P" D HD R^SDAM10 S  VALM("TM" )=5 D
  3113   "RTN","SDA M",27,0)
  3114    I SDAMTYP ="P" D HDR ^SDAM10 D
  3115   "RTN","SDA M",28,0)
  3116    .S SDX=$$ PCLINE^SDP PTEM(SDFN, DT) Q:'$L( SDX)
  3117   "RTN","SDA M",29,0)
  3118    .S VALMHD R(SDLNX)=S DX,SDLNX=3
  3119   "RTN","SDA M",30,0)
  3120    .;S VALMH DR(SDLNX)= SDX,SDLNX= 3,VALM("TM ")=6
  3121   "RTN","SDA M",31,0)
  3122    .;Increme nt Top & B ottom marg ins to all ow for add itional li ne
  3123   "RTN","SDA M",32,0)
  3124    .;S VALM( "TM")=VALM ("TM")+1
  3125   "RTN","SDA M",33,0)
  3126    .;S VALM( "BM")=VALM ("BM")+1
  3127   "RTN","SDA M",34,0)
  3128    .Q
  3129   "RTN","SDA M",35,0)
  3130    I SDAMTYP ="C" D HDR ^SDAM3
  3131   "RTN","SDA M",36,0)
  3132    S X=$P(SD AMLIST,"^" ,2)
  3133   "RTN","SDA M",37,0)
  3134    S VALMHDR (SDLNX)=X
  3135   "RTN","SDA M",38,0)
  3136    S X="* -  New GAF Re quired",VA LMHDR(SDLN X)=$$SETST R^VALM1(X, VALMHDR(SD LNX),34,30 )
  3137   "RTN","SDA M",39,0)
  3138    S VALMHDR (SDLNX)=$$ SETSTR^VAL M1($$FDATE ^VALM1(SDB EG)_" thru  "_$$FDATE ^VALM1(SDE ND),VALMHD R(SDLNX),5 9,22)
  3139   "RTN","SDA M",40,0)
  3140    Q
  3141   "RTN","SDA M",41,0)
  3142    ;
  3143   "RTN","SDA M",42,0)
  3144   FNL ; -- w hat to do  after acti on
  3145   "RTN","SDA M",43,0)
  3146    K ^TMP("S DAM",$J),^ TMP("SDAMI DX",$J),^T MP("VALMID X",$J)
  3147   "RTN","SDA M",44,0)
  3148    K SDAMCNT ,SDFLDD,SD ACNT,VALMH CNT,SDPRD, SDFN,SDCLN ,SDAMLIST, SDT,SDATA, SDBEG,SDEN D,DFN,Y,SD AMTYP,SDY, X,SDCL,Y,S DDA,VALMY
  3149   "RTN","SDA M",45,0)
  3150    Q
  3151   "RTN","SDA M",46,0)
  3152    ;
  3153   "RTN","SDA M",47,0)
  3154   BLD ; -- e ntry point  to bld li st
  3155   "RTN","SDA M",48,0)
  3156    ; input:   SDAMLIST  := list to  build
  3157   "RTN","SDA M",49,0)
  3158    D:'$D(SDA MLIST) GRO UP("ALL",. SDAMLIST)
  3159   "RTN","SDA M",50,0)
  3160    I SDAMTYP ="P" D BLD ^SDAM1
  3161   "RTN","SDA M",51,0)
  3162    I SDAMTYP ="C" D BLD ^SDAM3
  3163   "RTN","SDA M",52,0)
  3164   BLDQ Q
  3165   "RTN","SDA M",53,0)
  3166    ;
  3167   "RTN","SDA M",54,0)
  3168   LIST ; --  find and b uild
  3169   "RTN","SDA M",55,0)
  3170    ;  input:         X  := status  group
  3171   "RTN","SDA M",56,0)
  3172    ; output:  SDAMLIST  := array o f status'
  3173   "RTN","SDA M",57,0)
  3174    ;
  3175   "RTN","SDA M",58,0)
  3176    I X["CANC ELLED",$G( SDAMTYP)=" C" S VALMB CK="" W !! ,*7,"You m ust be vie wing a pat ient to li st cancell ed appoint ments." D  PAUSE^VALM 1 G LISTQ
  3177   "RTN","SDA M",59,0)
  3178    D GROUP(X ,.SDAMLIST ),BLD
  3179   "RTN","SDA M",60,0)
  3180    S VALMBCK ="R"
  3181   "RTN","SDA M",61,0)
  3182   LISTQ Q
  3183   "RTN","SDA M",62,0)
  3184    ;
  3185   "RTN","SDA M",63,0)
  3186   GROUP(GROU P,SDAMLIST ) ; -- fin d list
  3187   "RTN","SDA M",64,0)
  3188    S (I,SDAM LIST)="" F   S I=$O(S DAMLIST(I) ) Q:I=""   K SDAMLIST (I)
  3189   "RTN","SDA M",65,0)
  3190    S GROUP=+ $O(^SD(409 .62,"B",GR OUP,0))
  3191   "RTN","SDA M",66,0)
  3192    G GROUPQ: '$D(^SD(40 9.62,GROUP ,0)) S SDA MLIST=^(0)
  3193   "RTN","SDA M",67,0)
  3194    S I=$G(^S D(409.62,G ROUP,1)) S :I]"" SDAM LIST("SCR" )=I
  3195   "RTN","SDA M",68,0)
  3196    S I=0 F   S I=$O(^SD (409.63,"C ",GROUP,I) ) Q:'I  S  SDAMLIST(I )=""
  3197   "RTN","SDA M",69,0)
  3198   GROUPQ Q
  3199   "RTN","SDA M",70,0)
  3200    ;
  3201   "RTN","SDA M",71,0)
  3202   FUT ; -- c hange date  range
  3203   "RTN","SDA M",72,0)
  3204    S X1=DT,X 2=999 D C^ %DTC
  3205   "RTN","SDA M",73,0)
  3206    S SDEBG=D T,SDEND=X, X="FUTURE"  K VALMHDR
  3207   "RTN","SDA M",74,0)
  3208    D LIST
  3209   "RTN","SDA M",75,0)
  3210   FUTQ Q
  3211   "RTN","SDA M",76,0)
  3212    ;
  3213   "RTN","SDA M",77,0)
  3214   EXIT ; --  exit actio n for prot ocol
  3215   "RTN","SDA M",78,0)
  3216    I $D(VALM BCK),VALMB CK="R" D R EFRESH^VAL M S VALMBC K=$P(VALMB CK,"R")_$P (VALMBCK," R",2)
  3217   "RTN","SDA M",79,0)
  3218    Q
  3219   "RTN","SDA M",80,0)
  3220    ;
  3221   "RTN","SDA M2")
  3222   0^47^B3143 2956
  3223   "RTN","SDA M2",1,0)
  3224   SDAM2 ;ALB /MJK - App t Mgt (con t) ;JAN 15 , 2016
  3225   "RTN","SDA M2",2,0)
  3226    ;;5.3;Sch eduling;** 250,296,32 7,478,446, 627,676**; Aug 13, 19 93;Build 9 9
  3227   "RTN","SDA M2",3,0)
  3228    ;
  3229   "RTN","SDA M2",4,0)
  3230   CI ; -- pr otocol SDA M APPT CHE CK IN entr y pt
  3231   "RTN","SDA M2",5,0)
  3232    ; input:   VALMY :=  array entr ies
  3233   "RTN","SDA M2",6,0)
  3234    ;
  3235   "RTN","SDA M2",7,0)
  3236    N %,SDI,S DAT,VALMY, SDAMCIDT,S DCIACT
  3237   "RTN","SDA M2",8,0)
  3238    D SEL^VAL M2 S SDI=0 ,SDCIACT=" "
  3239   "RTN","SDA M2",9,0)
  3240    D NOW^%DT C S SDAMCI DT=$P(%,". ")_"."_$E( $P(%,".",2 )_"0000",1 ,4)
  3241   "RTN","SDA M2",10,0)
  3242    F  S SDI= $O(VALMY(S DI)) Q:'SD I  I $D(^T MP("SDAMID X",$J,SDI) ) K SDAT D
  3243   "RTN","SDA M2",11,0)
  3244    .S SDAT=^ TMP("SDAMI DX",$J,SDI )
  3245   "RTN","SDA M2",12,0)
  3246    .W !,^TMP ("SDAM",$J ,+SDAT,0)
  3247   "RTN","SDA M2",13,0)
  3248    .D:VALMCC  SELECT^VA LM10(+SDAT ,1)
  3249   "RTN","SDA M2",14,0)
  3250    .D ONE($P (SDAT,U,2) ,$P(SDAT,U ,4),$P(SDA T,U,3),$P( SDAT,U,5), 0,SDAMCIDT )
  3251   "RTN","SDA M2",15,0)
  3252    .D:VALMCC  SELECT^VA LM10(+SDAT ,0)
  3253   "RTN","SDA M2",16,0)
  3254    S VALMBCK =$S(VALMCC :"",1:"R")
  3255   "RTN","SDA M2",17,0)
  3256    Q
  3257   "RTN","SDA M2",18,0)
  3258    ;
  3259   "RTN","SDA M2",19,0)
  3260   ONE(DFN,SD CL,SDT,SDD A,SDASK,SD AMCIDT) ;  -- check i n one appt
  3261   "RTN","SDA M2",20,0)
  3262    ; input:   DFN := if n of patie nt
  3263   "RTN","SDA M2",21,0)
  3264    ;         SDCL := cl inic#
  3265   "RTN","SDA M2",22,0)
  3266    ;          SDT := ap pt d/t
  3267   "RTN","SDA M2",23,0)
  3268    ;         SDDA := if n in ^SC m ultiple or  null
  3269   "RTN","SDA M2",24,0)
  3270    ;       S DASK := as k d/t of c i always [ 1|yes or 0 |no]
  3271   "RTN","SDA M2",25,0)
  3272    ;    SDAM CIDT := ci  date/time  [optional ]
  3273   "RTN","SDA M2",26,0)
  3274    ;
  3275   "RTN","SDA M2",27,0)
  3276    I $$MSG^S DMXFLAG(SD CL) H 3 Q   ; SD/676
  3277   "RTN","SDA M2",28,0)
  3278    I $D(XRTL ) D T0^%ZO SV
  3279   "RTN","SDA M2",29,0)
  3280    S:'SDDA S DDA=$$FIND (DFN,SDT,S DCL)
  3281   "RTN","SDA M2",30,0)
  3282    I 'SDDA W  !!,*7,"Yo u cannot c heck in th is appoint ment." D P AUSE^VALM1  G ONEQ
  3283   "RTN","SDA M2",31,0)
  3284    N SDATA,S DCIHDL,X S  SDATA=SDD A_U_DFN_U_ SDT_U_SDCL ,SDCIHDL=$ $HANDLE^SD AMEVT(1)
  3285   "RTN","SDA M2",32,0)
  3286    D BEFORE^ SDAMEVT(.S DATA,DFN,S DT,SDCL,SD DA,SDCIHDL )
  3287   "RTN","SDA M2",33,0)
  3288    I '$D(^SD (409.63,"A CI",1,+SDA TA("BEFORE ","STATUS" ))) W !!,* 7,"You can not check  in this ap pointment. " D PAUSE^ VALM1 G ON EQ
  3289   "RTN","SDA M2",34,0)
  3290    ; *** mt  blocking r emoved
  3291   "RTN","SDA M2",35,0)
  3292    ;S X="EAS MTCHK" X ^ %ZOSF("TES T") I $T,$ G(EASACT)' ="W",$$MT^ EASMTCHK(D FN,"","C", SDT) D PAU SE^VALM1 G  ONEQ
  3293   "RTN","SDA M2",36,0)
  3294    I $P(SDT, ".")>DT W  !!,*7,"It  is too soo n to check  in this a ppointment ." D PAUSE ^VALM1 G O NEQ
  3295   "RTN","SDA M2",37,0)
  3296    S:'$D(^SC (SDCL,"S", 0)) ^(0)=" ^44.001DA^ ^"
  3297   "RTN","SDA M2",38,0)
  3298    S DR="",X =$G(^SC(SD CL,"S",SDT ,1,SDDA,"C "))
  3299   "RTN","SDA M2",39,0)
  3300    I +X S DR =309
  3301   "RTN","SDA M2",40,0)
  3302    ; -- alre ady co'ed
  3303   "RTN","SDA M2",41,0)
  3304    I DR="",$ P(X,U,3) D
  3305   "RTN","SDA M2",42,0)
  3306    .S DR="30 9//"
  3307   "RTN","SDA M2",43,0)
  3308    .I $P(^SC (SDCL,0),U ,24)!(SDAS K) S DR=DR _$$FTIME^V ALM1($P(X, U,3)) Q
  3309   "RTN","SDA M2",44,0)
  3310    .S DR=DR_ "//^S X="_ $P(X,U,3)
  3311   "RTN","SDA M2",45,0)
  3312    ;
  3313   "RTN","SDA M2",46,0)
  3314    I DR="",$ P(^SC(SDCL ,0),U,24)! (SDASK) S  DR="309//" _$S(SDAMCI DT:$$FTIME ^VALM1(SDA MCIDT),1:" NOW")
  3315   "RTN","SDA M2",47,0)
  3316    I DR="" S  DR="309// /"_$S(SDAM CIDT:"/"_S DAMCIDT,1: "NOW")
  3317   "RTN","SDA M2",48,0)
  3318    S DA(2)=S DCL,DA(1)= SDT,DA=SDD A,DIE="^SC ("_DA(2)_" ,""S"","_D A(1)_",1,"  D ^DIE
  3319   "RTN","SDA M2",49,0)
  3320    ;update S DEC APPOIN TMENT   ;a lb/sat 627
  3321   "RTN","SDA M2",50,0)
  3322    N SDECAPP T,SDECDT
  3323   "RTN","SDA M2",51,0)
  3324    S SDECAPP T=$$APPTGE T^SDECUTL( DFN,SDT,SD CL)
  3325   "RTN","SDA M2",52,0)
  3326    S SDECDT= $$GET1^DIQ (44.003,SD DA_","_SDT _","_SDCL_ ",",309,"I ")
  3327   "RTN","SDA M2",53,0)
  3328    D SDECCHK ^SDEC25(SD ECAPPT,SDE CDT)
  3329   "RTN","SDA M2",54,0)
  3330    ;alb/sat  627 end ad dition/mod ification
  3331   "RTN","SDA M2",55,0)
  3332    D AFTER^S DAMEVT(.SD ATA,DFN,SD T,SDCL,SDD A,SDCIHDL)
  3333   "RTN","SDA M2",56,0)
  3334    I '$P(SDA TA("AFTER" ,"STATUS") ,U,4),'$P( SDATA("BEF ORE","STAT US"),U,4)  W !?8,*7," ...appoint ment has n ot been ch ecked in"  D PAUSE^VA LM1
  3335   "RTN","SDA M2",57,0)
  3336    I SDATA(" BEFORE","S TATUS")'=S DATA("AFTE R","STATUS ") D
  3337   "RTN","SDA M2",58,0)
  3338    .I $P(SDA TA("AFTER" ,"STATUS") ,U,4),'$P( SDATA("BEF ORE","STAT US"),U,4)  W !?8,"... checked in  ",$$FTIME ^VALM1($P( SDATA("AFT ER","STATU S"),U,4))
  3339   "RTN","SDA M2",59,0)
  3340    .I $D(SDC IACT) D
  3341   "RTN","SDA M2",60,0)
  3342    ..S Y=SDA TA("AFTER" ,"STATUS") ,Y1=$P(Y,U ,4),Y=$P(Y ,U,3)
  3343   "RTN","SDA M2",61,0)
  3344    ..I $P(SD ATA("BEFOR E","STATUS "),U,3)'=Y  D UPD($$L OWER^VALM1 (Y),"STAT" ,+SDAT,1), UPD("","TI ME",+SDAT, 1)
  3345   "RTN","SDA M2",62,0)
  3346    ..I $P(SD ATA("AFTER ","STATUS" ),U,3)["CH ECKED IN"  D UPD($S($ P(Y1,".")= DT:$$TIME^ SDAM1($P(Y 1,".",2)), 1:"     ") ,"TIME",+S DAT,1)
  3347   "RTN","SDA M2",63,0)
  3348    .D EVT^SD AMEVT(.SDA TA,4,0,SDC IHDL) ; 4  := ci evt  , 0 := int eractive m ode
  3349   "RTN","SDA M2",64,0)
  3350    I $D(XRT0 ) S XRTN=" SDAM2" D T 1^%ZOSV
  3351   "RTN","SDA M2",65,0)
  3352   ONEQ K DA, DIE,DR,DQ, DE,Y,Y1 Q
  3353   "RTN","SDA M2",66,0)
  3354    ;
  3355   "RTN","SDA M2",67,0)
  3356    ;
  3357   "RTN","SDA M2",68,0)
  3358   FIND(DFN,S DT,SDCL) ;  -- return  appt ifn  for pat
  3359   "RTN","SDA M2",69,0)
  3360    ;   input :        D FN := ifn  of pat.
  3361   "RTN","SDA M2",70,0)
  3362    ;                  S DT := appt  d/t
  3363   "RTN","SDA M2",71,0)
  3364    ;                 SD CL := ifn  of clinic
  3365   "RTN","SDA M2",72,0)
  3366    ;  output : [returne d] := ifn  if pat has  appt on d ate/time
  3367   "RTN","SDA M2",73,0)
  3368    ;
  3369   "RTN","SDA M2",74,0)
  3370    N Y
  3371   "RTN","SDA M2",75,0)
  3372    S Y=0 F   S Y=$O(^SC (SDCL,"S", SDT,1,Y))  Q:'Y  I $D (^(Y,0)),D FN=+^(0),$ D(^DPT(+DF N,"S",SDT, 0)),$$VALI D(DFN,SDCL ,SDT,Y) S  CNSTLNK=$P ($G(^SC(SD CL,"S",SDT ,1,Y,"CONS ")),U) K:C NSTLNK=""  CNSTLNK Q   ;SD/478
  3373   "RTN","SDA M2",76,0)
  3374    Q Y
  3375   "RTN","SDA M2",77,0)
  3376    ;
  3377   "RTN","SDA M2",78,0)
  3378   UPD(TEXT,F LD,LINE,SA VE) ; -- u pdate data  for scree n
  3379   "RTN","SDA M2",79,0)
  3380    D FLDTEXT ^VALM10(LI NE,FLD,TEX T)
  3381   "RTN","SDA M2",80,0)
  3382    D:VALMCC  CNTRL^VALM 10(LINE,$P (VALMDDF(F LD),U,2),$ P(VALMDDF( FLD),U,3), IOINHI,IOI NORM,+$G(S AVE))
  3383   "RTN","SDA M2",81,0)
  3384    Q
  3385   "RTN","SDA M2",82,0)
  3386    ;
  3387   "RTN","SDA M2",83,0)
  3388   MAKE ; --  make appt  action
  3389   "RTN","SDA M2",84,0)
  3390    N ORACTIO N,ORVP,XQO RQUIT,SDAM ERR
  3391   "RTN","SDA M2",85,0)
  3392    D FULL^VA LM1
  3393   "RTN","SDA M2",86,0)
  3394    W !!,VALM HDR(1)
  3395   "RTN","SDA M2",87,0)
  3396    D ^SDM
  3397   "RTN","SDA M2",88,0)
  3398    I '$D(SDA MERR) D BL D^SDAM
  3399   "RTN","SDA M2",89,0)
  3400    I $D(SDAM ERR) D PAU SE^VALM1
  3401   "RTN","SDA M2",90,0)
  3402    D SDM^SDK ILL S VALM BCK="R"
  3403   "RTN","SDA M2",91,0)
  3404    Q
  3405   "RTN","SDA M2",92,0)
  3406    ;
  3407   "RTN","SDA M2",93,0)
  3408   WI ; -- wa lk-in visi t action
  3409   "RTN","SDA M2",94,0)
  3410    S VALMBCK ="R"
  3411   "RTN","SDA M2",95,0)
  3412    D FULL^VA LM1
  3413   "RTN","SDA M2",96,0)
  3414    I SDAMTYP ="P" I $$C L^SDAMWI(S DFN) D BLD ^SDAM1
  3415   "RTN","SDA M2",97,0)
  3416    I SDAMTYP ="C" I $$P T^SDAMWI(S DCLN) D BL D^SDAM3
  3417   "RTN","SDA M2",98,0)
  3418    ;evaluate  wait list  ;SD/327
  3419   "RTN","SDA M2",99,0)
  3420   EWLCHK ;ch eck if pat ient has a ny open EW L entries  (SD/372)
  3421   "RTN","SDA M2",100,0)
  3422    ;CLN expe cted as cl inic IEN
  3423   "RTN","SDA M2",101,0)
  3424    I '$D(DFN ) Q
  3425   "RTN","SDA M2",102,0)
  3426    Q:'$D(SDT )
  3427   "RTN","SDA M2",103,0)
  3428    K ^TMP($J ,"SDAMA301 "),^TMP($J ,"APPT")
  3429   "RTN","SDA M2",104,0)
  3430    N SD S SD =SDT
  3431   "RTN","SDA M2",105,0)
  3432    I '$D(SC)  S SC=+$G( CLN)
  3433   "RTN","SDA M2",106,0)
  3434    I $$MSG^S DMXFLAG(SC ) H 3 Q  ;  SD/676
  3435   "RTN","SDA M2",107,0)
  3436    K ^TMP($J ,"SDAMA301 "),^TMP($J ,"APPT")
  3437   "RTN","SDA M2",108,0)
  3438    W:$D(IOF)  @IOF D AP PT^SDWLEVA L(DFN,SD,S C)
  3439   "RTN","SDA M2",109,0)
  3440    Q:'$D(^TM P($J,"APPT "))
  3441   "RTN","SDA M2",110,0)
  3442    N SDEV D  EN^SDWLEVA L(DFN,.SDE V) I SDEV, $L(SDEV(1) )>0 D
  3443   "RTN","SDA M2",111,0)
  3444    .K ^TMP(" SDWLPL",$J ),^TMP($J, "SDWLPL")
  3445   "RTN","SDA M2",112,0)
  3446    .D INIT^S DWLPL(DFN, "M")
  3447   "RTN","SDA M2",113,0)
  3448    .Q:'$D(^T MP($J,"SDW LPL"))
  3449   "RTN","SDA M2",114,0)
  3450    .D LIST^S DWLPL("M", DFN)
  3451   "RTN","SDA M2",115,0)
  3452    .F  Q:'$D (^TMP($J," SDWLPL"))   N SDR D A NSW^SDWLEV AL(1,.SDR)  I 'SDR D  LIST^SDWLP L("M",DFN)  D
  3453   "RTN","SDA M2",116,0)
  3454    ..F  N SD R  D ANSW^ SDWLEVAL(0 ,.SDR) Q:' $D(^TMP($J ,"SDWLPL") )  I 'SDR  W !,"MUST  ENTER A RE ASON NOT T O DISPOSIT ION MATCHE D EWL ENTR Y",!
  3455   "RTN","SDA M2",117,0)
  3456    I $D(^TMP ($J,"APPT" )) N SDEV  D EN^SDWLE VAL(DFN,.S DEV) I SDE V,$L(SDEV( 1))>0 D
  3457   "RTN","SDA M2",118,0)
  3458    .Q:'$D(^T MP($J,"SDW LPL"))  D  ASKREM^SDW LEVAL S SD CTN=1 ;dis play and p rocess sel ected open  EWL entri es
  3459   "RTN","SDA M2",119,0)
  3460    .Q
  3461   "RTN","SDA M2",120,0)
  3462    Q
  3463   "RTN","SDA M2",121,0)
  3464    ;
  3465   "RTN","SDA M2",122,0)
  3466   DATE ; --  change dat e range
  3467   "RTN","SDA M2",123,0)
  3468    S VALMB=S DBEG D RAN GE^VALM11
  3469   "RTN","SDA M2",124,0)
  3470    I $S('VAL MBEG:1,SDB EG'=VALMBE G:0,1:SDEN D=VALMEND)  W !!,"Dat e range wa s not chan ged." D PA USE^VALM1  S VALMBCK= "" G DATEQ
  3471   "RTN","SDA M2",125,0)
  3472    S SDBEG=V ALMBEG,SDE ND=VALMEND
  3473   "RTN","SDA M2",126,0)
  3474    I SDAMTYP ="P" D BLD ^SDAM1
  3475   "RTN","SDA M2",127,0)
  3476    I SDAMTYP ="C" D BLD ^SDAM3
  3477   "RTN","SDA M2",128,0)
  3478    S VALMBCK ="R"
  3479   "RTN","SDA M2",129,0)
  3480   DATEQ K VA LMB,VALMBE G,VALMEND  Q
  3481   "RTN","SDA M2",130,0)
  3482    ;
  3483   "RTN","SDA M2",131,0)
  3484   INP(DFN,VD ATE) ; --  determine  inpatient  status ; d om is not  an inpatie nt appt
  3485   "RTN","SDA M2",132,0)
  3486    N SDINP,V AINDT,VADM VT
  3487   "RTN","SDA M2",133,0)
  3488    S SDINP=" ",VAINDT=V DATE D ADM ^VADPT2 G  INPQ:'VADM VT
  3489   "RTN","SDA M2",134,0)
  3490    I $P(^DG( 43,1,0),U, 21),$P($G( ^DIC(42,+$ P($G(^DGPM (VADMVT,0) ),U,6),0)) ,U,3)="D"  G INPQ
  3491   "RTN","SDA M2",135,0)
  3492    S SDINP=" I"
  3493   "RTN","SDA M2",136,0)
  3494   INPQ Q SDI NP
  3495   "RTN","SDA M2",137,0)
  3496    ;
  3497   "RTN","SDA M2",138,0)
  3498   VALID(DFN, SDCL,SDT,S DDA) ; --  return val id appt.
  3499   "RTN","SDA M2",139,0)
  3500    ; **NOTE:   For spee d consider ation the  ^SC and ^D PT nodes m ust be
  3501   "RTN","SDA M2",140,0)
  3502    ;           check to  see they  exist prio r to calli ng this en try point.
  3503   "RTN","SDA M2",141,0)
  3504    ;   input :        D FN := ifn  of pat.
  3505   "RTN","SDA M2",142,0)
  3506    ;                  S DT := appt  d/t
  3507   "RTN","SDA M2",143,0)
  3508    ;                 SD CL := ifn  of clinic
  3509   "RTN","SDA M2",144,0)
  3510    ;                 SD DA := ifn  of appt
  3511   "RTN","SDA M2",145,0)
  3512    ;  output : [returne d] := 1 fo r valid ap pt., 0 for  not valid
  3513   "RTN","SDA M2",146,0)
  3514    Q $S($P(^ SC(SDCL,"S ",SDT,1,SD DA,0),U,9) '="C":1,$P (^DPT(DFN, "S",SDT,0) ,U,2)["C": 1,1:0)
  3515   "RTN","SDA M3")
  3516   0^45^B1104 3233
  3517   "RTN","SDA M3",1,0)
  3518   SDAM3 ;MJK /ALB - App t Mgt (Cli nic) ; 4/2 1/05 12:23 pm
  3519   "RTN","SDA M3",2,0)
  3520    ;;5.3;Sch eduling;** 63,189,380 ,478,492,6 76**;Aug 1 3, 1993;Bu ild 99
  3521   "RTN","SDA M3",3,0)
  3522    ;
  3523   "RTN","SDA M3",4,0)
  3524   INIT ; --  get init c linic appt  data
  3525   "RTN","SDA M3",5,0)
  3526    ;  input:         SD CLN := ifn  of pat
  3527   "RTN","SDA M3",6,0)
  3528    ; output:   ^TMP("SD AM" := app t array
  3529   "RTN","SDA M3",7,0)
  3530    S X=$P($G (^DG(43,1, "SCLR")),U ,12),SDPRD =$S(X:X,1: 2)
  3531   "RTN","SDA M3",8,0)
  3532    S X1=DT,X 2=-SDPRD D  C^%DTC S  VALMB=X D  RANGE^VALM 11
  3533   "RTN","SDA M3",9,0)
  3534    I '$D(VAL MBEG) S VA LMQUIT=""  G INITQ
  3535   "RTN","SDA M3",10,0)
  3536    S SDBEG=V ALMBEG,SDE ND=VALMEND
  3537   "RTN","SDA M3",11,0)
  3538    D CHGCAP^ VALM("NAME ","Patient ")
  3539   "RTN","SDA M3",12,0)
  3540    S X="NO A CTION TAKE N" D LIST^ SDAM
  3541   "RTN","SDA M3",13,0)
  3542   INITQ K VA LMB,VALMBE G,VALMEND  Q
  3543   "RTN","SDA M3",14,0)
  3544    ;
  3545   "RTN","SDA M3",15,0)
  3546   BLD ; -- s can apts
  3547   "RTN","SDA M3",16,0)
  3548    N VA,SDAM DD,SDNAME, SDMAX,SDLA RGE,DFN,SD CL,BL,XC,X W,AC,AW,TC ,TW,NC,NW, SC,SW,SDT, SDDA ; don e for spee d see INIT ^SDAM10
  3549   "RTN","SDA M3",17,0)
  3550    D INIT^SD AM10
  3551   "RTN","SDA M3",18,0)
  3552    F SDT=SDB EG:0 S SDT =$O(^SC(SD CLN,"S",SD T)) Q:'SDT !($P(SDT," .",1)>SDEN D)  D
  3553   "RTN","SDA M3",19,0)
  3554    .F SDDA=0 :0 S SDDA= $O(^SC(SDC LN,"S",SDT ,1,SDDA))  Q:'SDDA  S  CNSTLNK=$ P($G(^SC(S DCLN,"S",S DT,1,SDDA, "CONS")),U ),CSTAT=""  S:CNSTLNK '="" CSTAT =$P($G(^GM R(123,CNST LNK,0)),U, 12) D  ;SD /478
  3555   "RTN","SDA M3",20,0)
  3556    ..I $D(^S C(SDCLN,"S ",SDT,1,SD DA,0)) S D FN=+^(0) D               ;SD/492
  3557   "RTN","SDA M3",21,0)
  3558    ...N NDX, DA,FND                                                    ;SD/492
  3559   "RTN","SDA M3",22,0)
  3560    ...S (FND ,NDX)=""                                                  ;SD/492
  3561   "RTN","SDA M3",23,0)
  3562    ...F  S N DX=$O(^TMP ("SDAMIDX" ,$J,NDX))  Q:NDX=""   D  Q:FND      ;SD/492
  3563   "RTN","SDA M3",24,0)
  3564    ....S DA= ^TMP("SDAM IDX",$J,ND X)                                  ;SD/492
  3565   "RTN","SDA M3",25,0)
  3566    ....I $P( DA,U,2)=DF N,$P(DA,U, 3)=SDT,$P( DA,U,4)=SD CLN S FND= 1  ;SD/492
  3567   "RTN","SDA M3",26,0)
  3568    ...Q:FND                                                            ;SD/492
  3569   "RTN","SDA M3",27,0)
  3570    ...D PID^ VADPT I $D (^DPT(DFN, "S",SDT,0) ),$$VALID^ SDAM2(DFN, SDCLN,SDT, SDDA) S SD ATA=^DPT(D FN,"S",SDT ,0),SDCL=S DCLN,SDNAM E=VA("BID" )_" "_$P($ G(^DPT(DFN ,0)),U) D: SDCLN=+SDA TA BLD1^SD AM1  ;SD/4 78,492
  3571   "RTN","SDA M3",28,0)
  3572    D NUL^SDA M10,LARGE^ SDAM10:$D( SDLARGE)
  3573   "RTN","SDA M3",29,0)
  3574    S $P(^TMP ("SDAM",$J ,0),U,4)=V ALMCNT
  3575   "RTN","SDA M3",30,0)
  3576    Q
  3577   "RTN","SDA M3",31,0)
  3578    ;
  3579   "RTN","SDA M3",32,0)
  3580   HDR ; -- l ist screen  header
  3581   "RTN","SDA M3",33,0)
  3582    ;   input :      SDC LN := ifn  of pat
  3583   "RTN","SDA M3",34,0)
  3584    ;  output :  VALMHDR () := hdr  array
  3585   "RTN","SDA M3",35,0)
  3586    ;
  3587   "RTN","SDA M3",36,0)
  3588    S VALMHDR (1)=$E($P( "Clinic: " _$G(^SC(SD CLN,0)),"^ ",1),1,45)   ;for pro per displa y of clini c name for  SD*5.3*18 9
  3589   "RTN","SDA M3",37,0)
  3590    Q
  3591   "RTN","SDA M3",38,0)
  3592    ;
  3593   "RTN","SDA M3",39,0)
  3594   CLN ; -- c hange clin ic
  3595   "RTN","SDA M3",40,0)
  3596    I $G(SDAM LIST)["CAN CELLED" S  VALMBCK=""  W !!,*7," You must b e viewing  a patient  to list ca ncelled ap pointments ." D PAUSE ^VALM1 G C LNQ
  3597   "RTN","SDA M3",41,0)
  3598    D FULL^VA LM1 S VALM BCK="R"
  3599   "RTN","SDA M3",42,0)
  3600    S X="" I  $D(XQORNOD (0)) S X=$ P($P(XQORN OD(0),U,4) ,"=",2)
  3601   "RTN","SDA M3",43,0)
  3602    W ! S DIC ="^SC(",DI C(0)=$S(X] "":"",1:"A ")_"EMQ",D IC("A")="S elect Clin ic: ",DIC( "S")="I $P (^(0),U,3) =""C"",'$G (^(""OOS"" ))"
  3603   "RTN","SDA M3",44,0)
  3604    D ^DIC K  DIC
  3605   "RTN","SDA M3",45,0)
  3606    I $$MSG^S DMXFLAG(+Y ) Q  ; SD/ 676
  3607   "RTN","SDA M3",46,0)
  3608    I Y<0 D   G CLNQ
  3609   "RTN","SDA M3",47,0)
  3610    .I SDAMTY P="C" S VA LMSG=$C(7) _"Clinic h as not bee n changed. "
  3611   "RTN","SDA M3",48,0)
  3612    .I SDAMTY P="P" S VA LMSG=$C(7) _"View of  patient re mains in a ffect."
  3613   "RTN","SDA M3",49,0)
  3614    I SDAMTYP '="C" D CH GCAP^VALM( "NAME","Pa tient") S  SDAMTYP="C "
  3615   "RTN","SDA M3",50,0)
  3616    N SDRES I  SDAMTYP=" C" S SDRES =$$CLNCK^S DUTL2(+Y,1 ) I 'SDRES  D  G CLNQ
  3617   "RTN","SDA M3",51,0)
  3618    .W !,?5," Clinic MUS T be corre cted befor e continui ng." D PAU SE^VALM1
  3619   "RTN","SDA M3",52,0)
  3620    S SDCLN=+ Y K SDFN D  BLD
  3621   "RTN","SDA M3",53,0)
  3622   CLNQ Q
  3623   "RTN","SDA M3",54,0)
  3624    ;
  3625   "RTN","SDA MC")
  3626   0^50^B1549 8369
  3627   "RTN","SDA MC",1,0)
  3628   SDAMC ;ALB /MJK - Can cel Appt A ction ; 8/ 31/05 3:02 pm  ; 12/2 6/08 12:26 pm  ; 5/25 /12 12:40p m
  3629   "RTN","SDA MC",2,0)
  3630    ;;5.3;Sch eduling;** 20,28,32,4 6,263,414, 444,478,53 8,554,597, 592,676**; Aug 13, 19 93;Build 9 9
  3631   "RTN","SDA MC",3,0)
  3632    ;
  3633   "RTN","SDA MC",4,0)
  3634    ; Referen ce/ICR 
  3635   "RTN","SDA MC",5,0)
  3636    ; ^VALM1  - 10116
  3637   "RTN","SDA MC",6,0)
  3638    ; ^VALM2  - 10119
  3639   "RTN","SDA MC",7,0)
  3640    ;
  3641   "RTN","SDA MC",8,0)
  3642   EN ; -- pr otocol SDA M APPT CAN CEL entry  pt
  3643   "RTN","SDA MC",9,0)
  3644    ; input:   VALMY :=  array entr ies
  3645   "RTN","SDA MC",10,0)
  3646    ;
  3647   "RTN","SDA MC",11,0)
  3648    N SDI,SDA T,VALMY,SD AMCIDT,CNT ,L,SDWH,SD CP,SDREM,S DSCR,SDMSG ,SCLHOLD
  3649   "RTN","SDA MC",12,0)
  3650    K ^UTILIT Y($J)
  3651   "RTN","SDA MC",13,0)
  3652    ;
  3653   "RTN","SDA MC",14,0)
  3654    ;
  3655   "RTN","SDA MC",15,0)
  3656    I '$D(DFN ),$G(SDFN) ,($G(SDAMT YP)="P") S  DFN=SDFN
  3657   "RTN","SDA MC",16,0)
  3658    ;
  3659   "RTN","SDA MC",17,0)
  3660    S VALMBCK =""
  3661   "RTN","SDA MC",18,0)
  3662    D SEL^VAL M2,CHK G E NQ:'$O(VAL MY(0))
  3663   "RTN","SDA MC",19,0)
  3664    D FULL^VA LM1 S VALM BCK="R"
  3665   "RTN","SDA MC",20,0)
  3666    S SDWH=$$ WHO,SDCP=$ S(SDWH="C" :0,1:1) G  ENQ:SDWH=- 1
  3667   "RTN","SDA MC",21,0)
  3668    S SDSCR=$ $RSN(SDWH)  G ENQ:SDS CR=-1
  3669   "RTN","SDA MC",22,0)
  3670    S (TMPD,S DREM)=$$RE M G ENQ:SD REM=-1 ;SD /478
  3671   "RTN","SDA MC",23,0)
  3672    S (SDI,CN T,L)=0
  3673   "RTN","SDA MC",24,0)
  3674    ;set L=SD I SD*5.3*5 92
  3675   "RTN","SDA MC",25,0)
  3676    F  S SDI= $O(VALMY(S DI)) Q:'SD I  I $D(^T MP("SDAMID X",$J,SDI) ) K SDAT S  SDAT=^(SD I),L=SDI W  !,^TMP("S DAM",$J,+S DAT,0) D C AN($P(SDAT ,U,2),$P(S DAT,U,3),. CNT,.L,SDW H,SDCP,SDS CR,SDREM)
  3677   "RTN","SDA MC",26,0)
  3678    I SDAMTYP ="P" D BLD ^SDAM1
  3679   "RTN","SDA MC",27,0)
  3680    I SDAMTYP ="C" D BLD ^SDAM3
  3681   "RTN","SDA MC",28,0)
  3682   ENQ Q
  3683   "RTN","SDA MC",29,0)
  3684    ;
  3685   "RTN","SDA MC",30,0)
  3686   CAN(DFN,SD T,CNT,L,SD WH,SDCP,SD SCR,SDREM)  ;
  3687   "RTN","SDA MC",31,0)
  3688    N A1,NDT, FLAG1 S ND T=SDT,FLAG 1=0
  3689   "RTN","SDA MC",32,0)
  3690    I $P($G(^ DPT(DFN,"S ",NDT,0)), U,2)["C" W  !!,"Appoi ntment alr eady cance lled" H 2  Q
  3691   "RTN","SDA MC",33,0)
  3692    ;removed  L=L\1+1 wh ich incorr ectly incr emented th e variable  L SD*5.3* 592
  3693   "RTN","SDA MC",34,0)
  3694    I $D(^DPT (DFN,"S",N DT,0)) D
  3695   "RTN","SDA MC",35,0)
  3696    . S SD0=^ (0) I $P(S D0,"^",2)' ["C" S SC= +SD0,APL=" "
  3697   "RTN","SDA MC",36,0)
  3698    . I $$MSG ^SDMXFLAG( SC) H 3 S  FLAG1=1 Q              ; SD/676
  3699   "RTN","SDA MC",37,0)
  3700    . D FLEN^ SDCNP1A S  ^UTILITY($ J,"SDCNP", L)=NDT_"^" _SC_"^"_CO V_"^"_APL_ "^^"_APL_" ^^^^^^"_SD SP D CHKSO ^SDCNP0 ;S D/478
  3701   "RTN","SDA MC",38,0)
  3702    Q:FLAG1      ; SD/67 6
  3703   "RTN","SDA MC",39,0)
  3704    ;SD*5.3*4 14 next li ne added t o set hold  variable  SCLHOLD fo r clinic p tr
  3705   "RTN","SDA MC",40,0)
  3706    S APP=1,A 1=L\1 S SC LHOLD=$P(^ UTILITY($J ,"SDCNP",A 1),U,2) D  BEGD^SDCNP 0
  3707   "RTN","SDA MC",41,0)
  3708    D MES,NOP E W ! S (C NT,L)=0 K  ^UTILITY($ J,"SDCNP")
  3709   "RTN","SDA MC",42,0)
  3710    Q
  3711   "RTN","SDA MC",43,0)
  3712   CANQ(SDFN, SDCLN) ; S D*5.3*554  - Passes i n SDFN, SD CLN
  3713   "RTN","SDA MC",44,0)
  3714    ;Wait Lis t Message
  3715   "RTN","SDA MC",45,0)
  3716    ;
  3717   "RTN","SDA MC",46,0)
  3718    I SDFN="" !(SDCLN="" ) Q  ;Chec ks to make  sure that  SDFN and  SDCLN are  set to a n on null va lue - PATC H SD*5.3*5 97
  3719   "RTN","SDA MC",47,0)
  3720    N SDOMES  S SDOMES=" " I $D(^SD WL(409.3," SC",SDCLN) ) D
  3721   "RTN","SDA MC",48,0)
  3722    .N SDWL S  SDWL="" F   S SDWL=$ O(^SDWL(40 9.3,"SC",S DCLN,SDWL) ) Q:SDWL=" "  D  Q:SD OMES
  3723   "RTN","SDA MC",49,0)
  3724    ..I $P(^S DWL(409.3, SDWL,0),U, 17)="O" I  $P(^SDWL(4 09.3,SDWL, 0),U)=$G(S DFN) D  S  SDOMES=1
  3725   "RTN","SDA MC",50,0)
  3726    ...W !,?1 ,"There ar e Wait Lis t entries  waiting fo r an Appoi ntment for  this pati ent in ",! ?1,$P(^SC( SDCLN,0),U ,1)," Clin ic.",!
  3727   "RTN","SDA MC",51,0)
  3728    W ! S DIR (0)="E" D  ^DIR W !
  3729   "RTN","SDA MC",52,0)
  3730    K SCLHOLD ,SC,COV,AP P,SDCLN
  3731   "RTN","SDA MC",53,0)
  3732    Q
  3733   "RTN","SDA MC",54,0)
  3734   MES ; -- s et error m essage
  3735   "RTN","SDA MC",55,0)
  3736    S SDMSG=" W !,""Ente r appt. nu mbers sepa rated by c ommas and/ or a range  separated "",!,""by  dashes (ie  2,4,6-9)" " H 2"
  3737   "RTN","SDA MC",56,0)
  3738    Q
  3739   "RTN","SDA MC",57,0)
  3740    ;
  3741   "RTN","SDA MC",58,0)
  3742   WHO() ;
  3743   "RTN","SDA MC",59,0)
  3744    W ! S DIR (0)="SOA^P C:PATIENT; C:CLINIC", DIR("A")=" Appointmen ts cancell ed by (P)a tient or ( C)linic: " ,DIR("B")= "Patient"
  3745   "RTN","SDA MC",60,0)
  3746    D ^DIR K  DIR
  3747   "RTN","SDA MC",61,0)
  3748    Q $S(Y="" !(Y="^"):- 1,1:Y)
  3749   "RTN","SDA MC",62,0)
  3750    ;
  3751   "RTN","SDA MC",63,0)
  3752   RSN(SDWH)  ;
  3753   "RTN","SDA MC",64,0)
  3754   RSN1 W ! S  DIC="^SD( 409.2,",DI C(0)="AEMQ ",DIC("S") ="I '$P(^( 0),U,4),"" "_$E(SDWH) _"B""[$P(^ (0),U,2)"  D ^DIC K D IC
  3755   "RTN","SDA MC",65,0)
  3756    I X["^" G  RSNQ
  3757   "RTN","SDA MC",66,0)
  3758    I Y<0 W * 7 G RSN1
  3759   "RTN","SDA MC",67,0)
  3760   RSNQ Q +Y
  3761   "RTN","SDA MC",68,0)
  3762    ;
  3763   "RTN","SDA MC",69,0)
  3764   REM() ;
  3765   "RTN","SDA MC",70,0)
  3766    W ! S DIR (0)="2.98, 17" D ^DIR  K DIR
  3767   "RTN","SDA MC",71,0)
  3768    I $E(X)=" ^" S Y=-1
  3769   "RTN","SDA MC",72,0)
  3770    Q Y
  3771   "RTN","SDA MC",73,0)
  3772    ;
  3773   "RTN","SDA MC",74,0)
  3774   NOPE ;
  3775   "RTN","SDA MC",75,0)
  3776    N SDEND,S DPAUSE
  3777   "RTN","SDA MC",76,0)
  3778    S:'CNT SD PAUSE=1
  3779   "RTN","SDA MC",77,0)
  3780    D NOPE^SD CNP1
  3781   "RTN","SDA MC",78,0)
  3782    D:$G(SDPA USE) PAUSE ^VALM1
  3783   "RTN","SDA MC",79,0)
  3784    Q
  3785   "RTN","SDA MC",80,0)
  3786    ;
  3787   "RTN","SDA MC",81,0)
  3788   CHK ; -- c heck if st atus of ap pt permits  cancellin g
  3789   "RTN","SDA MC",82,0)
  3790    N SDI S S DI=0
  3791   "RTN","SDA MC",83,0)
  3792    F  S SDI= $O(VALMY(S DI)) Q:'SD I  I $D(^T MP("SDAMID X",$J,SDI) ) K SDAT S  SDAT=^(SD I) I '$D(^ SD(409.63, "ACAN",1,+ $$STATUS^S DAM1($P(SD AT,U,2),$P (SDAT,U,3) ,+$G(^DPT( +$P(SDAT,U ,2),"S",+$ P(SDAT,U,3 ),0)),$G(^ (0))))) D
  3793   "RTN","SDA MC",84,0)
  3794    .W !,^TMP ("SDAM",$J ,+SDAT,0), !!,*7,"You  cannot ca ncel this  appointmen t."
  3795   "RTN","SDA MC",85,0)
  3796    .K VALMY( SDI) D PAU SE^VALM1
  3797   "RTN","SDA MC",86,0)
  3798    Q
  3799   "RTN","SDA MEX")
  3800   0^23^B2390 2444
  3801   "RTN","SDA MEX",1,0)
  3802   SDAMEX ;AL B/MJK,RMO  - Appointm ent Check  In/Check O ut ; 12/1/ 91
  3803   "RTN","SDA MEX",2,0)
  3804    ;;5.3;Sch eduling;*6 76*;Aug 13 , 1993;Bui ld 99
  3805   "RTN","SDA MEX",3,0)
  3806    ;
  3807   "RTN","SDA MEX",4,0)
  3808   EN ; -- ma in entry p oint
  3809   "RTN","SDA MEX",5,0)
  3810    N SDATA,S DTOT,DFN,S DACT,SDATE ,SDT,SDCL, SDDA,SDASH ,SDAMDD,SD MAX
  3811   "RTN","SDA MEX",6,0)
  3812    I '$$INIT  G ENQ
  3813   "RTN","SDA MEX",7,0)
  3814    S SDACT=$ $ASK(DT) G  ENQ:SDACT ']""
  3815   "RTN","SDA MEX",8,0)
  3816    F  Q:'$$D ATE(.SDATE )  K SDCL  D  Q:SDTOT '<SDMAX
  3817   "RTN","SDA MEX",9,0)
  3818    .F  Q:'$$ CLINIC(SDA TE,.SDCL)   K DFN D   Q:SDTOT'<S DMAX
  3819   "RTN","SDA MEX",10,0)
  3820    ..F  Q:'$ $PAT(.SDAT E,.SDCL,SD ACT,.DFN,. SDT,.SDDA)   D  Q:SDT OT'<SDMAX
  3821   "RTN","SDA MEX",11,0)
  3822    ...S SDTO T=SDTOT+$$ CK^SDAMEX1 (DFN,SDCL, SDT,SDDA,S DACT)
  3823   "RTN","SDA MEX",12,0)
  3824    W !!?5,"T otal Appoi ntments Pr ocessed: " ,SDTOT
  3825   "RTN","SDA MEX",13,0)
  3826   ENQ Q
  3827   "RTN","SDA MEX",14,0)
  3828    ;
  3829   "RTN","SDA MEX",15,0)
  3830   INIT() ; - - set up v ars
  3831   "RTN","SDA MEX",16,0)
  3832    S SDTOT=0 ,SDMAX=999 9,$P(SDASH ,"_",IOM)= "",SDAMDD= $P(^DD(2.9 8,3,0),U,3 )
  3833   "RTN","SDA MEX",17,0)
  3834    Q 1
  3835   "RTN","SDA MEX",18,0)
  3836    ;
  3837   "RTN","SDA MEX",19,0)
  3838   ASK(SDDT)  ; -- selec t appt CI  or CO
  3839   "RTN","SDA MEX",20,0)
  3840    N DIR,DIR UT,DTOUT,D UOUT,Y
  3841   "RTN","SDA MEX",21,0)
  3842    S DIR(0)= "SB^CI:Che ck In;CO:C heck Out"
  3843   "RTN","SDA MEX",22,0)
  3844    S DIR("A" )="Select  Appointmen t Check In  or Check  Out"
  3845   "RTN","SDA MEX",23,0)
  3846    S:$G(SDDT ) DIR("B") =$S($$REQ^ SDM1A(SDDT )="CO":"Ch eck Out",1 :"Check In ")
  3847   "RTN","SDA MEX",24,0)
  3848    W ! D ^DI R S:$D(DIR UT) Y=""
  3849   "RTN","SDA MEX",25,0)
  3850    Q $G(Y)
  3851   "RTN","SDA MEX",26,0)
  3852    ;
  3853   "RTN","SDA MEX",27,0)
  3854   DATE(SDATE ) ; -- get  appt date
  3855   "RTN","SDA MEX",28,0)
  3856    ;    inpu t: none
  3857   "RTN","SDA MEX",29,0)
  3858    ;   outpu t: SDATE : = appt dat e selected
  3859   "RTN","SDA MEX",30,0)
  3860    ; returne d: date se lected [1  := yes | 0  := no]
  3861   "RTN","SDA MEX",31,0)
  3862    ;
  3863   "RTN","SDA MEX",32,0)
  3864    S DIR(0)= "DO^:"_DT_ ":EPX",DIR ("A")=$S($ D(SDATE):" Next ",1:" ")_"Appoin tment Date "
  3865   "RTN","SDA MEX",33,0)
  3866    S:'$D(SDA TE) DIR("B ")="TODAY"
  3867   "RTN","SDA MEX",34,0)
  3868    W ! D ^DI R K DIR S  SDATE=Y
  3869   "RTN","SDA MEX",35,0)
  3870    Q $S($D(D IRUT):0,Y: 1,1:0)
  3871   "RTN","SDA MEX",36,0)
  3872    ;
  3873   "RTN","SDA MEX",37,0)
  3874   CLINIC(SDA TE,SDCL) ;  -- get cl inic
  3875   "RTN","SDA MEX",38,0)
  3876    ;    inpu t: SDATE : = appt dat e selected
  3877   "RTN","SDA MEX",39,0)
  3878    ;   outpu t: SDCL :=  ifn of se lected cli nic
  3879   "RTN","SDA MEX",40,0)
  3880    ; returne d: clinic  selected [ 1 := yes |  0 := no]
  3881   "RTN","SDA MEX",41,0)
  3882    ;
  3883   "RTN","SDA MEX",42,0)
  3884    N X,Y,SDD EF
  3885   "RTN","SDA MEX",43,0)
  3886   CL W !,$S( $D(SDCL):" Next",1:"S elect")_"  Clinic: "
  3887   "RTN","SDA MEX",44,0)
  3888    S SDDEF=$ S($P($O(^S C(+$G(^DIS V(DUZ,"^SC (")),"S",S DATE)),"." )=SDATE:+$ G(^DISV(DU Z,"^SC(")) ,1:0)
  3889   "RTN","SDA MEX",45,0)
  3890    I '$D(SDC L),$G(^SC( SDDEF,0))] "" W $P(^( 0),U)_"//  "
  3891   "RTN","SDA MEX",46,0)
  3892    R X:DTIME
  3893   "RTN","SDA MEX",47,0)
  3894    I X="",SD DEF,'$D(SD CL) S X="` "_SDDEF
  3895   "RTN","SDA MEX",48,0)
  3896    I "^"[X S  SDCL=0 G  CLINICQ
  3897   "RTN","SDA MEX",49,0)
  3898    S:X?1" "1 N.N X="`"_ $E(X,2,99)
  3899   "RTN","SDA MEX",50,0)
  3900    S DIC(0)= "NEMQ",DIC ="^SC("
  3901   "RTN","SDA MEX",51,0)
  3902    S DIC("S" )="I $P(^( 0),U,3)["" C"",$P($O( ^(""S"",SD ATE)),""." ")=SDATE"
  3903   "RTN","SDA MEX",52,0)
  3904    D ^DIC K  DIC G CL:Y <1 S SDCL= +Y
  3905   "RTN","SDA MEX",53,0)
  3906    I $$MSG^S DMXFLAG(+Y ) G CL      ; SD/676
  3907   "RTN","SDA MEX",54,0)
  3908   CLINICQ Q  SDCL>0
  3909   "RTN","SDA MEX",55,0)
  3910    ;
  3911   "RTN","SDA MEX",56,0)
  3912   PAT(SDATE, SDCL,SDACT ,DFN,SDT,S DDA) ; --  ask for pa ts & get a ppt
  3913   "RTN","SDA MEX",57,0)
  3914    ;    inpu t: SDATE : = appt dat e
  3915   "RTN","SDA MEX",58,0)
  3916    ;             SDCL : = ifn of c linic
  3917   "RTN","SDA MEX",59,0)
  3918    ;            SDACT : = action C I or CO
  3919   "RTN","SDA MEX",60,0)
  3920    ;   outpu t:   DFN 
  3921   "RTN","SDA MEX",61,0)
  3922    ;              SDT : = appt dat e/time
  3923   "RTN","SDA MEX",62,0)
  3924    ;             SDDA : = ifn of ^ sc multipl e
  3925   "RTN","SDA MEX",63,0)
  3926    ; returne d: appt se lected [1  := yes | 0  := no]
  3927   "RTN","SDA MEX",64,0)
  3928    ;
  3929   "RTN","SDA MEX",65,0)
  3930    N X,SDCNT ,SDLCNT,SD APPT
  3931   "RTN","SDA MEX",66,0)
  3932   PT W !,SDA SH S (SDDA ,SDT)=0
  3933   "RTN","SDA MEX",67,0)
  3934    W !!,$S($ D(DFN):"Ne xt",1:"Sel ect")_" Pa tient: " R  X:DTIME G  PATQ:"^"[ X
  3935   "RTN","SDA MEX",68,0)
  3936    IF X["?"  D PTHLP(SD CL,SDATE)  G PT
  3937   "RTN","SDA MEX",69,0)
  3938    D RT S DI C="^DPT(", DIC(0)="QE M" D ^DIC  K DIC G PT :Y<1
  3939   "RTN","SDA MEX",70,0)
  3940    S DFN=+Y
  3941   "RTN","SDA MEX",71,0)
  3942    S (SDLCNT ,SDCNT)=$$ LIST(.DFN, .SDCL,.SDA TE,.SDAPPT )
  3943   "RTN","SDA MEX",72,0)
  3944    I 'SDCNT  W !?7,"o   No appoint ments for  this patie nt.",*7 G  PT
  3945   "RTN","SDA MEX",73,0)
  3946    I SDCNT>1  D  G PT:' SDCNT
  3947   "RTN","SDA MEX",74,0)
  3948    .S DIR(0) ="N^1:"_SD CNT,SDCNT= 0,DIR("A") ="Select A ppointment " D ^DIR K  DIR S SDC NT=+Y
  3949   "RTN","SDA MEX",75,0)
  3950    I $D(SDAP PT(SDCNT))  D  G PT:' SDDA
  3951   "RTN","SDA MEX",76,0)
  3952    .S SDT=+S DAPPT(SDCN T),SDDA=+$ P(SDAPPT(S DCNT),U,2) ,SDATA=$G( ^DPT(DFN," S",SDT,0))
  3953   "RTN","SDA MEX",77,0)
  3954    .I SDLCNT >1 W ! D P RT
  3955   "RTN","SDA MEX",78,0)
  3956    .I 'SDDA  K SDAPPT W  !?7,"o  T his appoin tment cann ot be chec ked ",$S(S DACT="CO": "out",1:"i n"),".",*7
  3957   "RTN","SDA MEX",79,0)
  3958   PATQ Q SDD A>0
  3959   "RTN","SDA MEX",80,0)
  3960    ;
  3961   "RTN","SDA MEX",81,0)
  3962   LIST(DFN,S DCL,SDATE, SDAPPT) ;
  3963   "RTN","SDA MEX",82,0)
  3964    ;    inpu t: DFN
  3965   "RTN","SDA MEX",83,0)
  3966    ;              SDCL  := ifn of  clinic
  3967   "RTN","SDA MEX",84,0)
  3968    ;             SDATE  := appt da te ; SDCL  := ifn of  clinic
  3969   "RTN","SDA MEX",85,0)
  3970    ;   outpu t  SDAPPT  := array o f choices  (appt d/t  ^ multiple  ifn)
  3971   "RTN","SDA MEX",86,0)
  3972    ; returne d: count o f appts fo r date
  3973   "RTN","SDA MEX",87,0)
  3974    ;
  3975   "RTN","SDA MEX",88,0)
  3976    N SDCNT
  3977   "RTN","SDA MEX",89,0)
  3978    W !!?5,"C linic",?30 ,"Appointm ent Date/T ime",?55," Status"
  3979   "RTN","SDA MEX",90,0)
  3980    W !?5,"-- ----",?30, "--------- ---------- --",?55,"- -----"
  3981   "RTN","SDA MEX",91,0)
  3982    S SDT=SDA TE,DATE=0, SDCNT=0
  3983   "RTN","SDA MEX",92,0)
  3984    F  S SDT= $O(^DPT(DF N,"S",SDT) ) Q:'SDT!( SDT>(SDATE _".2359"))   I $D(^(S DT,0)) S S DATA=^(0)  I SDCL=+SD ATA D
  3985   "RTN","SDA MEX",93,0)
  3986    .S SDCNT= SDCNT+1,SD APPT(SDCNT )=SDT_U_+$ $FIND^SDAM 2(DFN,SDT, SDCL)
  3987   "RTN","SDA MEX",94,0)
  3988    .D PRT
  3989   "RTN","SDA MEX",95,0)
  3990   LISTQ Q SD CNT
  3991   "RTN","SDA MEX",96,0)
  3992    ;
  3993   "RTN","SDA MEX",97,0)
  3994   PRT W !?1, SDCNT,?5,$ E($P($G(^S C(SDCL,0)) ,U),1,25), ?30,$$FTIM E^VALM1(SD T),?55,$P( $$STATUS^S DAM1(DFN,S DT,SDCL,SD ATA,SDDA), ";",3)
  3995   "RTN","SDA MEX",98,0)
  3996    Q
  3997   "RTN","SDA MEX",99,0)
  3998    ;
  3999   "RTN","SDA MEX",100,0 )
  4000   RT ; -- is  this a rt  rec
  4001   "RTN","SDA MEX",101,0 )
  4002    N C
  4003   "RTN","SDA MEX",102,0 )
  4004    I X?.N1"/ "1N.ANP S  C=$$CHAR($ E(X,1,$L(X )-1)) I C] "",C=$E(X, $L(X)),$D( ^RT(+$P(X, "/",2),0)) ,$P(^(0),U ,9) S X="` "_+$P(^(0) ,U,9)
  4005   "RTN","SDA MEX",103,0 )
  4006    Q
  4007   "RTN","SDA MEX",104,0 )
  4008   CHAR(X) ;  -- char ch ecksum for  code 39
  4009   "RTN","SDA MEX",105,0 )
  4010    N C,Z,I,Y
  4011   "RTN","SDA MEX",106,0 )
  4012    S C="",Z= "012345678 9ABCDEFGHI JKLMNOPQRS TUVWXYZ-.  $/+%"
  4013   "RTN","SDA MEX",107,0 )
  4014    F I=1:1:$ L(X) S Y=$ F(Z,$E(X,I ))-2 Q:Y<0   S C=C+Y
  4015   "RTN","SDA MEX",108,0 )
  4016    Q $S(Y'<0 :$E(Z,(C#4 3)+1),1:"" )
  4017   "RTN","SDA MEX",109,0 )
  4018    ;
  4019   "RTN","SDA MEX",110,0 )
  4020   PTHLP(SDCL ,START) ;
  4021   "RTN","SDA MEX",111,0 )
  4022    N END,SDT ,SDDA,SDAT A,SDCNT,X, DFN,SDESC, VA
  4023   "RTN","SDA MEX",112,0 )
  4024    S END=STA RT+.2359,S DCNT=0,SDE SC=0
  4025   "RTN","SDA MEX",113,0 )
  4026    W !,"The  following  appointmen ts are lis ted for th e clinic o n the sele cted date: "
  4027   "RTN","SDA MEX",114,0 )
  4028    F SDT=STA RT:0 S SDT =$O(^SC(SD CL,"S",SDT )) Q:'SDT! (SDT>END)   D  Q:SDES C
  4029   "RTN","SDA MEX",115,0 )
  4030    .S SDDA=0  F  S SDDA =$O(^SC(SD CL,"S",SDT ,1,SDDA))  Q:'SDDA  S  X=^SC(SDC L,"S",SDT, 1,SDDA,0)  D  Q:SDESC
  4031   "RTN","SDA MEX",116,0 )
  4032    ..S DFN=+ X,SDATA=$G (^DPT(DFN, "S",SDT,0) )
  4033   "RTN","SDA MEX",117,0 )
  4034    ..I SDCL= +SDATA,$$V ALID^SDAM2 (DFN,SDCL, SDT,SDDA)  S SDCNT=SD CNT+1 D PI D^VADPT6 D
  4035   "RTN","SDA MEX",118,0 )
  4036    ...W !,$E ($P($G(^DP T(DFN,0)), U),1,20),? 21,VA("BID "),?30,$$F TIME^VALM1 (SDT),?55, $P($$STATU S^SDAM1(DF N,SDT,SDCL ,SDATA,SDD A),";",3)
  4037   "RTN","SDA MEX",119,0 )
  4038    ...I '(SD CNT#20) S  DIR(0)="E"  D ^DIR K  DIR S SDES C='Y
  4039   "RTN","SDA MEX",120,0 )
  4040    I SDCNT=0  W !!?5,". ..There ar e no appoi ntments fo r this cli nic on thi s date.",* 7
  4041   "RTN","SDA MEX",121,0 )
  4042    Q
  4043   "RTN","SDA MN")
  4044   0^46^B7440 404
  4045   "RTN","SDA MN",1,0)
  4046   SDAMN ;ALB /MJK - No- Show Appt  Action ; 2 /4/92
  4047   "RTN","SDA MN",2,0)
  4048    ;;5.3;Sch eduling;** 478,676**; Aug 13, 19 93;Build 9 9
  4049   "RTN","SDA MN",3,0)
  4050    ;
  4051   "RTN","SDA MN",4,0)
  4052   EN ; -- pr otocol SDA M APPT NO- SHOW entry  pt
  4053   "RTN","SDA MN",5,0)
  4054    ; input:   VALMY :=  array entr ies
  4055   "RTN","SDA MN",6,0)
  4056    ;
  4057   "RTN","SDA MN",7,0)
  4058    N VALMY,S DI,SDAT,SD TIME,SDNSA CT,DFN,SDC L,SDT,SDST B,SDSTA,SD STOP
  4059   "RTN","SDA MN",8,0)
  4060    S VALMBCK ="",(SDNSA CT,SDSTOP) =0
  4061   "RTN","SDA MN",9,0)
  4062    D SEL^VAL M2 G ENQ:' $O(VALMY(0 ))
  4063   "RTN","SDA MN",10,0)
  4064    D FULL^VA LM1 S VALM BCK="R",SD I=0
  4065   "RTN","SDA MN",11,0)
  4066    F  S SDI= $O(VALMY(S DI)) Q:'SD I  I $D(^T MP("SDAMID X",$J,SDI) ) K SDAT S  SDAT=^(SD I) D  Q:SD STOP
  4067   "RTN","SDA MN",12,0)
  4068    .D NOW^%D TC S SDTIM E=%
  4069   "RTN","SDA MN",13,0)
  4070    .W !,^TMP ("SDAM",$J ,+SDAT,0), !
  4071   "RTN","SDA MN",14,0)
  4072    .S DFN=+$ P(SDAT,U,2 ),SDT=+$P( SDAT,U,3), SDCL=+$P(S DAT,U,4)
  4073   "RTN","SDA MN",15,0)
  4074    .S SDSTB= $$STATUS^S DAM1(DFN,S DT,SDCL,$G (^DPT(DFN, "S",SDT,0) )) ; befor e status
  4075   "RTN","SDA MN",16,0)
  4076    .Q:'$$CHK
  4077   "RTN","SDA MN",17,0)
  4078    .I $$MSG^ SDMXFLAG(S DCL) H 3 Q   ; SD/676
  4079   "RTN","SDA MN",18,0)
  4080    .S SDSTOP =$$NS(DFN, SDT,SDCL,S DTIME,.SDN SACT)
  4081   "RTN","SDA MN",19,0)
  4082    .S SDSTA= $$STATUS^S DAM1(DFN,S DT,SDCL,$G (^DPT(DFN, "S",SDT,0) )) ; after  status
  4083   "RTN","SDA MN",20,0)
  4084    .I 'SDNSA CT,'$$UPD( SDSTB,SDST A,SDAT,$G( CNSTLNK))  S SDNSACT= 2
  4085   "RTN","SDA MN",21,0)
  4086    ; values  for SDNSAC T :   0 =  no re-buil d
  4087   "RTN","SDA MN",22,0)
  4088    ;                          1 =  re-build b ecause of  re-book
  4089   "RTN","SDA MN",23,0)
  4090    ;                          2 =  re-build b ecause aft er not for  list
  4091   "RTN","SDA MN",24,0)
  4092    I SDNSACT ,SDAMTYP=" P" D BLD^S DAM1
  4093   "RTN","SDA MN",25,0)
  4094    I SDNSACT ,SDAMTYP=" C" D BLD^S DAM3
  4095   "RTN","SDA MN",26,0)
  4096   ENQ Q
  4097   "RTN","SDA MN",27,0)
  4098    ;
  4099   "RTN","SDA MN",28,0)
  4100   NS(DFN,SDT ,SC,SDTIME ,SDNSACT)  ; execute  no-show co de
  4101   "RTN","SDA MN",29,0)
  4102    ; input:    DFN := p t file ifn
  4103   "RTN","SDA MN",30,0)
  4104    ;           SDT := d /t of appt
  4105   "RTN","SDA MN",31,0)
  4106    ;            SC := c linic ifn
  4107   "RTN","SDA MN",32,0)
  4108    ;       S DTIME := n ow
  4109   "RTN","SDA MN",33,0)
  4110    ;      SD NSACT := n s processi ng flag
  4111   "RTN","SDA MN",34,0)
  4112    ;     [re turn] := d id user up arrow [ 0| no , 1|yes ]
  4113   "RTN","SDA MN",35,0)
  4114    ;
  4115   "RTN","SDA MN",36,0)
  4116    N SDI,SDC P,SDYES,SD INP,SDLT1, SDLT,SDDT, SDMSG,A,L, I,SDV1,SDC L
  4117   "RTN","SDA MN",37,0)
  4118    K ^UTILIT Y($J)
  4119   "RTN","SDA MN",38,0)
  4120    D LO^DGUT L S SDLT1= "",SDYES=" ",SDDT=DT, I=SDT,SDT= $P(I,".")
  4121   "RTN","SDA MN",39,0)
  4122    S SDMSG="  DOES NOT  HAVE A NO- SHOW LETTE R ASSIGNED  TO IT!"
  4123   "RTN","SDA MN",40,0)
  4124    S SDV1=$O (^DG(40.8, 0)) D DIV^ SDUTL I $T  S SDV1=$P ($G(^SC(SC ,0)),U,15)
  4125   "RTN","SDA MN",41,0)
  4126    D EN1^SDN ,73^SDN,PA USE^VALM1
  4127   "RTN","SDA MN",42,0)
  4128   NSQ Q 'Y
  4129   "RTN","SDA MN",43,0)
  4130    ;
  4131   "RTN","SDA MN",44,0)
  4132   CHK() ; --  check if  status of  appt permi ts no-show
  4133   "RTN","SDA MN",45,0)
  4134    N SDOK S  SDOK=1
  4135   "RTN","SDA MN",46,0)
  4136    I '$D(^SD (409.63,"A NS",1,+SDS TB)) S SDO K=0,X="You  cannot ex ecute no-s how proces sing for t his appoin tment."
  4137   "RTN","SDA MN",47,0)
  4138    I SDOK,SD T>SDTIME S  SDOK=1,X= "It is too  soon to n o-show thi s appointm ent."
  4139   "RTN","SDA MN",48,0)
  4140    I 'SDOK W  !!,*7,X K  VALMY(SDI ) D PAUSE^ VALM1
  4141   "RTN","SDA MN",49,0)
  4142    Q SDOK
  4143   "RTN","SDA MN",50,0)
  4144    ;
  4145   "RTN","SDA MN",51,0)
  4146   UPD(BEFORE ,AFTER,SDA T,CNST) ;  can just t he 1 displ ay line be  changed w /o re-buil d
  4147   "RTN","SDA MN",52,0)
  4148    ; input:    BEFORE : = before s tatus info  in $$STAT US format
  4149   "RTN","SDA MN",53,0)
  4150    ;            AFTER : = after      "     "    "     "       "
  4151   "RTN","SDA MN",54,0)
  4152    ;             SDAT : = selected  VALMY ent ry's data
  4153   "RTN","SDA MN",55,0)
  4154    ;             CNST : = consult  status (nu ll, consul t link ien )
  4155   "RTN","SDA MN",56,0)
  4156    N Y S Y=0
  4157   "RTN","SDA MN",57,0)
  4158    I +BEFORE =+AFTER S  Y=1 G UPDQ
  4159   "RTN","SDA MN",58,0)
  4160    I $D(SDAM LIST(+AFTE R)) S Y=1  I $D(SDAML IST("SCR") ) X SDAMLI ST("SCR")  S Y=$T
  4161   "RTN","SDA MN",59,0)
  4162    I 'Y,$P(S DAMLIST,U) ="ALL" S Y =1
  4163   "RTN","SDA MN",60,0)
  4164    I Y D
  4165   "RTN","SDA MN",61,0)
  4166    . S ^TMP( "SDAM",$J, +SDAT,0)=$ $SETFLD^VA LM1($P(AFT ER,";",3), ^TMP("SDAM ",$J,+SDAT ,0),"STAT" )
  4167   "RTN","SDA MN",62,0)
  4168    . I '$G(C NST) S ^TM P("SDAM",$ J,+SDAT,0) =$$SETFLD^ VALM1("     ",^TMP("S DAM",$J,+S DAT,0),"CO NSULT")
  4169   "RTN","SDA MN",63,0)
  4170   UPDQ Q Y
  4171   "RTN","SDA MWI")
  4172   0^51^B1340 0175
  4173   "RTN","SDA MWI",1,0)
  4174   SDAMWI ;AL B/MJK - Un scheduled  Appointmen ts ; 5/3/0 5 5:50pm
  4175   "RTN","SDA MWI",2,0)
  4176    ;;5.3;Sch eduling;** 63,94,241, 250,296,38 0,327,676* *;Aug 13,  1993;Build  99
  4177   "RTN","SDA MWI",3,0)
  4178    ;
  4179   "RTN","SDA MWI",4,0)
  4180   EN(DFN,SC)  ; -- main  entry poi nt
  4181   "RTN","SDA MWI",5,0)
  4182    ;    inpu t: DFN ; S C := clini c#
  4183   "RTN","SDA MWI",6,0)
  4184    ; returne d: success  or fail : = 1/0
  4185   "RTN","SDA MWI",7,0)
  4186    ;
  4187   "RTN","SDA MWI",8,0)
  4188    N SDY,SDA PTYP,SDRE, SDRE1,SDIN ,SDSL,SDD, SDALLE,SDA TD,SDDECOD ,SDEC,SDEM P,SDOEL,SD PL,SDRT,SD SC,SDTTM,C OLLAT,SDX, SDSTART,OR DER,SDREP, SDDA,SDCL
  4189   "RTN","SDA MWI",9,0)
  4190    D 2^VADPT  I +VADM(6 ) W !!?5,* 7,"o  Pati ent has di ed!" D PAU SE^VALM1 S  SDY=0 G E NQ
  4191   "RTN","SDA MWI",10,0)
  4192    S SDCL=SC ,SDSL=$S($ D(^SC(SC," SL")):+^(" SL"),1:"") ,SDD=0
  4193   "RTN","SDA MWI",11,0)
  4194    K SDRE,SD IN,SDRE1
  4195   "RTN","SDA MWI",12,0)
  4196    I $D(^SC( SC,"I")) S  Y=^("I"), SDIN=+Y,SD RE=+$P(Y,U ,2),SDRE1= $$FDATE^VA LM1(SDRE)
  4197   "RTN","SDA MWI",13,0)
  4198    I $D(SDIN ),SDIN,SDI N'>DT,SDRE ,SDRE>DT W  !!?5,*7," o  Clinic  is inactiv e from ",$ $FTIME^VAL M1(SDIN),"  to "_SDRE 1 D PAUSE^ VALM1 S SD Y=0 G ENQ
  4199   "RTN","SDA MWI",14,0)
  4200    I $D(SDIN ),SDIN,SDI N'>DT,'SDR E W !!?5,* 7,"o  Clin ic is inac tive as of  ",$$FTIME ^VALM1(SDI N) D PAUSE ^VALM1 S S DY=0 G ENQ
  4201   "RTN","SDA MWI",15,0)
  4202    N SDRES S  SDRES=$$C LNCK^SDUTL 2(SC,1)
  4203   "RTN","SDA MWI",16,0)
  4204    I 'SDRES  W !,?5,*7, "o  Clinic  MUST be c orrected b efore cont inuing." D  PAUSE^VAL M1 S SDY=0  G ENQ
  4205   "RTN","SDA MWI",17,0)
  4206    I '$$TIME (.DFN,.SC, .SDT) D WL ^SDM1(SC)  S SDY=0 G  ENQ ;SD/32 7
  4207   "RTN","SDA MWI",18,0)
  4208    S Y=SDT D  ^SDM4 I X ="^" S SDY =0 G ENQ
  4209   "RTN","SDA MWI",19,0)
  4210    ; ** SD*5 .3*250 MT  Blocking c heck remov ed
  4211   "RTN","SDA MWI",20,0)
  4212    ;S X="EAS MTCHK" X ^ %ZOSF("TES T") I $T N  EASACT S  EASACT="W"  I $$MT^EA SMTCHK(DFN ,+$G(SDAPT YP),EASACT ) D PAUSE^ VALM1 S SD Y=0 G ENQ
  4213   "RTN","SDA MWI",21,0)
  4214    ;-- get s ub-categor y for appo intment ty pe
  4215   "RTN","SDA MWI",22,0)
  4216    S SDXSCAT =$$SUB^DGS AUTL(SDAPT YP,2,"")
  4217   "RTN","SDA MWI",23,0)
  4218    S SDY=$$M AKE^SDAMWI 1(DFN,SDCL ,SDT)
  4219   "RTN","SDA MWI",24,0)
  4220    K SDXSCAT
  4221   "RTN","SDA MWI",25,0)
  4222   ENQ D KVAR ^VADPT
  4223   "RTN","SDA MWI",26,0)
  4224    Q SDY
  4225   "RTN","SDA MWI",27,0)
  4226    ;
  4227   "RTN","SDA MWI",28,0)
  4228   TIME(DFN,S C,SDT) ; - - get appt  date/time
  4229   "RTN","SDA MWI",29,0)
  4230    ;    inpu t: DFN ; S C := clini c#
  4231   "RTN","SDA MWI",30,0)
  4232    ;   outpu t: SDT :=  date/time  of wi appt
  4233   "RTN","SDA MWI",31,0)
  4234    ; returne d: success  or fail : = 1/0
  4235   "RTN","SDA MWI",32,0)
  4236    ;
  4237   "RTN","SDA MWI",33,0)
  4238    N SDY,%DT
  4239   "RTN","SDA MWI",34,0)
  4240   ASK R !!," APPOINTMEN T TIME: NO W// ",X:DT IME S X=$$ UPPER^VALM 1(X)
  4241   "RTN","SDA MWI",35,0)
  4242    I X["^"!( '$T) S SDY =0 G TIMEQ
  4243   "RTN","SDA MWI",36,0)
  4244    I X?.E1"? " D  G ASK
  4245   "RTN","SDA MWI",37,0)
  4246    .W !,"  E nter a tim e or date@ time for t he appoint ment or re turn for ' NOW'."
  4247   "RTN","SDA MWI",38,0)
  4248    .W !,"The  date must  be today  or earlier ."
  4249   "RTN","SDA MWI",39,0)
  4250    S:X=""!(X ="N")!(X=" NO") X="NO W"
  4251   "RTN","SDA MWI",40,0)
  4252    I X'="NOW ",X'["@" S  X="T@"_X
  4253   "RTN","SDA MWI",41,0)
  4254    S %DT="TE P",%DT(0)= -(DT+1) D  ^%DT G ASK :Y<0 S SDT =Y
  4255   "RTN","SDA MWI",42,0)
  4256    G:'$$CANC HK(.SC,.SD T) ASK
  4257   "RTN","SDA MWI",43,0)
  4258    I $D(^DPT (DFN,"S",S DT,0)) W ! ?5,*7,"o   Patient al ready has  an appt on  ",$$FTIME ^VALM1(SDT ) G ASK
  4259   "RTN","SDA MWI",44,0)
  4260    S SDY=1
  4261   "RTN","SDA MWI",45,0)
  4262   TIMEQ Q SD Y
  4263   "RTN","SDA MWI",46,0)
  4264    ;
  4265   "RTN","SDA MWI",47,0)
  4266   CANCHK(SC, SDT) ; --  is clinic  cancelled  for date
  4267   "RTN","SDA MWI",48,0)
  4268    ;    inpu t: SC := c linic# ; S DT := date /time of w i appt
  4269   "RTN","SDA MWI",49,0)
  4270    ; returne d: success  or fail : = 1/0
  4271   "RTN","SDA MWI",50,0)
  4272    ;
  4273   "RTN","SDA MWI",51,0)
  4274    N SDY
  4275   "RTN","SDA MWI",52,0)
  4276    S SDY=1
  4277   "RTN","SDA MWI",53,0)
  4278    I $D(^SC( SC,"ST",$P (SDT,".")) ),'$D(^SC( SC,"ST",$P (SDT,"."), "CAN")) G  CANCHKQ
  4279   "RTN","SDA MWI",54,0)
  4280    I $D(^SC( SC,"ST",$P (SDT,"."), "CAN")),$G (^SC(SC,"S T",$P(SDT, "."),1))[" CANCEL" W  !?5,*7,"o   This date 's clinic  has been c ancelled!"  S SDY=0 G  CANCHKQ
  4281   "RTN","SDA MWI",55,0)
  4282    I $D(^SC( SC,"ST",$P (SDT,"."), "CAN")),$G (^SC(SC,"S T",$P(SDT, "."),1))'[ "CANCEL" W  !?5,*7,"o   Warning:  Part of t his day's  clinic has  been canc elled!" G  CANCHKQ
  4283   "RTN","SDA MWI",56,0)
  4284    S SDY=$$A VAIL(.SC,. SDT)
  4285   "RTN","SDA MWI",57,0)
  4286   CANCHKQ Q  SDY
  4287   "RTN","SDA MWI",58,0)
  4288    ;
  4289   "RTN","SDA MWI",59,0)
  4290   AVAIL(SC,S DT) ; -- d oes clinic  meet
  4291   "RTN","SDA MWI",60,0)
  4292    ;    inpu t: SC := c linic# ; S DT := date /time of w i appt
  4293   "RTN","SDA MWI",61,0)
  4294    ; returne d: success  or fail : = 1/0
  4295   "RTN","SDA MWI",62,0)
  4296    ;
  4297   "RTN","SDA MWI",63,0)
  4298    N SDY
  4299   "RTN","SDA MWI",64,0)
  4300    S X=$P(SD T,".") D D OW^SDM0
  4301   "RTN","SDA MWI",65,0)
  4302    I $D(^SC( SC,"T"_Y))  S Z=$O(^S C(SC,"T"_Y ,DT)) I Z' ="",$D(^SC (SC,"T"_Y, Z,1)),^(1) ]"" S SDY= 1 G AVAILQ
  4303   "RTN","SDA MWI",66,0)
  4304    W !?5,*7, "o  Clinic  does not  meet on th is date!"  S SDY=0
  4305   "RTN","SDA MWI",67,0)
  4306   AVAILQ Q S DY
  4307   "RTN","SDA MWI",68,0)
  4308    ;
  4309   "RTN","SDA MWI",69,0)
  4310   CL(DFN) ;  -- make wi  appt
  4311   "RTN","SDA MWI",70,0)
  4312    ;    inpu t: DFN
  4313   "RTN","SDA MWI",71,0)
  4314    ; returne d: success  or fail : = 1/0
  4315   "RTN","SDA MWI",72,0)
  4316    ;
  4317   "RTN","SDA MWI",73,0)
  4318   CL1 S DIC= "^SC(",DIC (0)="AEMQ" ,DIC("A")= "Select Cl inic: ",DI C("S")="I  $P(^(0),U, 3)=""C"",' $G(^(""OOS ""))"
  4319   "RTN","SDA MWI",74,0)
  4320    D ^DIC K  DIC
  4321   "RTN","SDA MWI",75,0)
  4322    I Y<0 S S DY=0 G CLQ
  4323   "RTN","SDA MWI",76,0)
  4324    I $$MSG^S DMXFLAG(+Y ) G CL1      ; SD/676
  4325   "RTN","SDA MWI",77,0)
  4326    S SC=+Y S  SDY=$$EN( .DFN,.SC)
  4327   "RTN","SDA MWI",78,0)
  4328   CLQ Q SDY
  4329   "RTN","SDA MWI",79,0)
  4330    ;
  4331   "RTN","SDA MWI",80,0)
  4332   PT(SC) ;
  4333   "RTN","SDA MWI",81,0)
  4334    ;    inpu t:  SC :=  clinic#
  4335   "RTN","SDA MWI",82,0)
  4336    ; returne d: success  or fail : = 1/0
  4337   "RTN","SDA MWI",83,0)
  4338    ;
  4339   "RTN","SDA MWI",84,0)
  4340    S DIC="^D PT(",DIC(0 )="AEMQ",D IC("A")="S elect Pati ent: "
  4341   "RTN","SDA MWI",85,0)
  4342    D ^DIC K  DIC
  4343   "RTN","SDA MWI",86,0)
  4344    I Y<0 S S DY=0 G PTQ
  4345   "RTN","SDA MWI",87,0)
  4346    S DFN=+Y  S SDY=$$EN (.DFN,.SC)
  4347   "RTN","SDA MWI",88,0)
  4348   PTQ Q SDY
  4349   "RTN","SDA MWI",89,0)
  4350    ;
  4351   "RTN","SDC ")
  4352   0^21^B2815 0691
  4353   "RTN","SDC ",1,0)
  4354   SDC ;MAN/G RR,ALB/LDB  - CANCEL  A CLINIC'S  AVAILABIL ITY ;JAN 1 5, 2016;20 18-05-04 1 4:59:07;8. 3;6LDfWQz0 tdz8xu+65B Vjvc89CGfD Q3aABDY3G8 3OFHU=
  4355   "RTN","SDC ",2,0)
  4356    ;;5.3;Sch eduling;** 15,32,79,1 32,167,478 ,487,523,5 45,627,684 ,676**;Aug  13, 1993; Build 99
  4357   "RTN","SDC ",3,0)
  4358    N SDATA,S DCNHDL ; f or evt dvr
  4359   "RTN","SDC ",4,0)
  4360   SDC1 K SDL T,SDCP S N OAP="" D L O^DGUTL
  4361   "RTN","SDC ",5,0)
  4362    S DIC=44, DIC(0)="ME QA",DIC("S ")="I $P(^ (0),""^"", 3)=""C"",' $G(^(""OOS ""))",DIC( "A")="Sele ct CLINIC  NAME: " D  ^DIC K DIC ("S"),DIC( "A") G:'$D (^SC(+Y,"S L")) END^S DC0
  4363   "RTN","SDC ",6,0)
  4364    S SC=+Y,S L=^("SL")    ;NAKED R EFERNCE -  ^SC(IFN,"S L")  ; SD/ 676 - Move  naked glo bal refere nce.
  4365   "RTN","SDC ",7,0)
  4366    I $$MSG^S DMXFLAG(+Y ) Q                         ; SD /676
  4367   "RTN","SDC ",8,0)
  4368    S %DT="AE XF",%DT("A ")="CANCEL  '"_$P(Y,U ,2)_"' FOR  WHAT DATE : " D ^%DT  K %DT G:Y <0 END^SDC 0
  4369   "RTN","SDC ",9,0)
  4370    S (SD,CDA TE)=Y,%=$P (SL,U,6),S I=$S(%="": 4,%<3:4,%: %,1:4),%=$ P(SL,U,3), STARTDAY=$ S($L(%):%, 1:8) D NOW ^%DTC S SD TIME=%
  4371   "RTN","SDC ",10,0)
  4372    K SDRE,SD IN,SDRE1 I  $D(^SC(SC ,"I")) S S DIN=+^("I" ),SDRE=+$P (^("I"),"^ ",2),Y=SDR E D:Y DTS^ SDUTL S SD RE1=$S(SDR E:" to "_Y ,1:"")
  4373   "RTN","SDC ",11,0)
  4374    I $S('$D( SDIN):0,SD IN'>0!(SDI N>SD):0,SD RE'>SD&(SD RE):0,1:1)  W !,*7,"C linic is i nactive ", $S('SDRE:" as of ",1: "from ") S  Y=SDIN D  DTS^SDUTL  W Y,SDRE1  G SDC1
  4375   "RTN","SDC ",12,0)
  4376    I '$D(^SC (SC,"ST",S D,1)) S DH ="" D B S  ^SC(SC,"ST ",SD,1)=$P ("SU^MO^TU ^WE^TH^FR^ SA",U,DOW+ 1)_" "_$E( SD,6,7)_$J ("",SI+SI- 6)_DH,^(0) =SD G N
  4377   "RTN","SDC ",13,0)
  4378    I ^(1)["C ANCELLED"  W !,"APPOI NTMENTS HA VE ALREADY  BEEN CANC ELLED",!,* 7 S ANS="N ",SDTIME=" *",SDV1=$S ($P(^SC(SC ,0),"^",15 ):$P(^(0), "^",15),1: +$O(^DG(40 .8,0))) K  SDX G ASKL ^SDC0 ;NAK ED REFEREN CE - ^SC(I FN,"ST",Da te,1)
  4379   "RTN","SDC ",14,0)
  4380   N I '$F(^S C(SC,"ST", SD,1),"[")  W !,*7,"C LINIC DOES  NOT MEET  ON THAT DA Y" G SDC1  ; SD*5.3*6 84 - Remov e KILL on  "ST" (PATT ERN) node
  4381   "RTN","SDC ",15,0)
  4382    I $O(^SC( SC,"S",SD) )\1-SD W * 7,!?5,"NO  APPOINTMEN TS SCHEDUL ED" S NOAP =1 G W
  4383   "RTN","SDC ",16,0)
  4384    W !,"FIRS T, I'LL LI ST THE EXI STING APPO INTMENTS", !
  4385   "RTN","SDC ",17,0)
  4386    K DUOUT,D TOUT D ^SD C1 I $D(DU OUT)!$D(DT OUT) D END ^SDC0 Q
  4387   "RTN","SDC ",18,0)
  4388    I ^SC(SC, "ST",SD,1) ["X" G ^SD C2
  4389   "RTN","SDC ",19,0)
  4390   W S DH=0,% ="" W !,"W ANT TO CAN CEL THE WH OLE DAY" D  YN^DICN I  '% W !,"R EPLY YES ( Y) OR NO ( N)" G W
  4391   "RTN","SDC ",20,0)
  4392    I %=1 G W P:$$COED^S DC4(SC,SD, SD+.2359,1 ),ALL
  4393   "RTN","SDC ",21,0)
  4394    Q:%<1
  4395   "RTN","SDC ",22,0)
  4396   WP S %=""  W !,"WANT  TO CANCEL  PART OF TH E DAY" D Y N^DICN I ' % W !,"REP LY YES (Y)  OR NO (N) " G WP
  4397   "RTN","SDC ",23,0)
  4398    Q:(%-1)
  4399   "RTN","SDC ",24,0)
  4400   F R !,"STA RTING TIME : ",X:DTIM E Q:U[X  D  TC^SDC2 G  F:Y<0 S F R=Y,ST=%
  4401   "RTN","SDC ",25,0)
  4402   T R !,"END ING TIME:  ",X:DTIME  Q:U[X  D T C^SDC2 G T :Y<0 S SDH TO=X,TO=Y  I TO'>FR W  !,"Ending  time must  be greate r than sta rting time ",*7 G T
  4403   "RTN","SDC ",26,0)
  4404    I $$COED^ SDC4(SC,FR ,TO,1) K F R,SDHTO,TO ,ST W ! G  F
  4405   "RTN","SDC ",27,0)
  4406   ROPT R !," Reason for  cancellat ion:  ",I: DTIME I I? 1"?".E W ! ,"YOU MAY  ENTER A ME SSAGE CONC ERNING THE  CANCELLAT ION HERE"  G ROPT
  4407   "RTN","SDC ",28,0)
  4408    N CANREM  S CANREM=I
  4409   "RTN","SDC ",29,0)
  4410    Q:I["^"   I '$D(^SC( SC,"SDCAN" ,0)) S ^SC (SC,"SDCAN ",0)="^44. 05D^"_FR_" ^1" G SKIP
  4411   "RTN","SDC ",30,0)
  4412    S A=^SC(S C,"SDCAN", 0),SDCNT=$ P(A,"^",4) ,^SC(SC,"S DCAN",0)=$ P(A,"^",1, 2)_"^"_FR_ "^"_(SDCNT +1)
  4413   "RTN","SDC ",31,0)
  4414   SKIP S ^SC (SC,"SDCAN ",FR,0)=FR _"^"_SDHTO
  4415   "RTN","SDC ",32,0)
  4416    S NOAP=$S ($O(^SC(SC ,"S",(FR-. 0001)))'>0 :1,$O(^SC( SC,"S",(FR -.0001)))> TO:1,1:0)  I 'NOAP S  NOAP=$S($O (^SC(SC,"S ",+$O(^SC( SC,"S",(FR -.0001))), 0))="MES": 1,1:0)
  4417   "RTN","SDC ",33,0)
  4418    S ^SC(SC, "S",FR,0)= FR,^("MES" )="CANCELL ED UNTIL " _X_$S(I?.P :"",1:" (" _I_")") D  S S I=^(1) ,I=I_$J("" ,%-$L(I)), Y=""
  4419   "RTN","SDC ",34,0)
  4420    F X=0:2:%  S DH=$E(I ,X+SI+SI), P=$S(X<ST: DH_$E(I,X+ 1+SI+SI),X =%:$S(Y="[ ":Y,1:DH)_ $E(I,X+1+S I+SI),1:$S (Y="["&(X= ST):"]",1: "X")_"X"), Y=$S(DH="] ":"",DH="[ ":DH,1:Y), I=$E(I,1,X -1+SI+SI)_ P_$E(I,X+2 +SI+SI,999 )
  4421   "RTN","SDC ",35,0)
  4422    S:'$F(I," [") I5=$F( I,"X"),I=$ E(I,1,(I5- 2))_"["_$E (I,I5,999)  K I5
  4423   "RTN","SDC ",36,0)
  4424    S DH=0,^( 1)=I,FR=FR -.0001 G C  ;NAKED RE FERENCE -  ^SC(IFN,"S T",Date,1)
  4425   "RTN","SDC ",37,0)
  4426   S S ^("CAN ")=^SC(SC, "ST",SD,1)  Q
  4427   "RTN","SDC ",38,0)
  4428   ALL N CANR EM
  4429   "RTN","SDC ",39,0)
  4430    W !,"Reas on for can cellation:  " R CANRE M:DTIME I  $L(CANREM) >160!($L(C ANREM)<3)  W !,*7,"Re ason must  be between  3 to 160  characters  long",! G  ALL
  4431   "RTN","SDC ",40,0)
  4432    D S S ^(1 )="   "_$E (SD,6,7)_"     **CANC ELLED**",F R=SD,TO=SD +.9 ;NAKED  REFERENCE  - ^SC(IFN ,"ST",Date ,1)
  4433   "RTN","SDC ",41,0)
  4434   C S FR=$O( ^SC(SC,"S" ,FR)) I FR <1!(FR'<TO ) W !!,"CA NCELLED!   " K SDX G  CHKEND^SDC 0
  4435   "RTN","SDC ",42,0)
  4436    N TDH,TMP D,DIE,DR,N ODE
  4437   "RTN","SDC ",43,0)
  4438    F I=0:0 S  I=$O(^SC( SC,"S",FR, 1,I)) Q:I' >0  D
  4439   "RTN","SDC ",44,0)
  4440    . I '$D(^ SC(SC,"S", FR,1,I,0))  I $D(^("C ")) S J=FR ,J2=I D DE LETE^SDC1  K J,J2 Q   ;SD*5.3*54 5 delete c orrupt nod e
  4441   "RTN","SDC ",45,0)
  4442    . I '+$G( ^SC(SC,"S" ,FR,1,I,0) ) S J=FR,J 2=I D DELE TE^SDC1 K  J,J2 Q  ;S D*5.3*545  if DFN is  missing de lete recor d
  4443   "RTN","SDC ",46,0)
  4444    . S DFN=+ ^SC(SC,"S" ,FR,1,I,0) ,SDCNHDL=$ $HANDLE^SD AMEVT(1)
  4445   "RTN","SDC ",47,0)
  4446    . D BEFOR E^SDAMEVT( .SDATA,DFN ,FR,SC,I,S DCNHDL)
  4447   "RTN","SDC ",48,0)
  4448    . S $P(^S C(SC,"S",F R,1,I,0)," ^",9)="C"
  4449   "RTN","SDC ",49,0)
  4450    . S:$D(^D PT(DFN,"S" ,FR,0)) NO DE=^(0)  ; added SD/5 23
  4451   "RTN","SDC ",50,0)
  4452    . Q:$P(NO DE,U,1)'=S C                   ; added SD/5 23
  4453   "RTN","SDC ",51,0)
  4454    . S ^DPT( "ASDCN",SC ,FR,DFN)=" "
  4455   "RTN","SDC ",52,0)
  4456    . S SDSC= SC,SDTTM=F R,SDPL=I,T DH=DH,TMPD =CANREM D  CANCEL^SDC NSLT S DH= TDH ;SD/47 8
  4457   "RTN","SDC ",53,0)
  4458    . I $D(^D PT(DFN,"S" ,FR,0)),$P (^(0),"^", 2)'["C" S  $P(^(0),"^ ",2)="C",$ P(^(0),"^" ,12)=DUZ,$ P(^(0),"^" ,14)=SDTIM E,DH=DH+1, TDH=DH,DIE ="^DPT(DFN ,"_"""S""" _",",DR="1 7///^S X=C ANREM",DA= FR D ^DIE  S DH=TDH D  MORE
  4459   "RTN","SDC ",54,0)
  4460    . D SDEC^ SDCNP0(DFN ,FR,SC,"C" ,"",$G(CAN REM),SDTIM E,DUZ)   ; alb/sat 62 7
  4461   "RTN","SDC ",55,0)
  4462    G C
  4463   "RTN","SDC ",56,0)
  4464   B S X=SD D  DOW^SDM0  S DOW=Y,SS =+$O(^SC(S C,"T"_Y,X) ) I $D(^(S S,1)),^(1) ]"" S DH=^ (1),DO=X+1 ,DA(1)=SC
  4465   "RTN","SDC ",57,0)
  4466    Q
  4467   "RTN","SDC ",58,0)
  4468   MORE I $D( ^SC("ARAD" ,SC,FR,DFN )) S ^(DFN )="N"
  4469   "RTN","SDC ",59,0)
  4470    S SDIV=$S ($P(^SC(SC ,0),"^",15 )]"":$P(^( 0),"^",15) ,1:" 1"),S DV1=$S(SDI V:SDIV,1:+ $O(^DG(40. 8,0))) I $ D(^DPT("AS DPSD","C", SDIV,SC,FR ,DFN)) K ^ (DFN)
  4471   "RTN","SDC ",60,0)
  4472    S SDH=DH, SDTTM=FR,S DSC=SC,SDP L=I,SDRT=" D" D RT^SD UTL
  4473   "RTN","SDC ",61,0)
  4474    S DH=SDH  K SDH D CK 1,EVT
  4475   "RTN","SDC ",62,0)
  4476    K SD1,SDI V,SDPL,SDR T,SDSC,SDT TM,SDX Q
  4477   "RTN","SDC ",63,0)
  4478   CK1 S SDX= 0 F SD1=FR \1:0 S SD1 =$O(^DPT(D FN,"S",SD1 )) Q:'SD1! ((SD1\1)'= (FR\1))  I  $P(^(SD1, 0),"^",2)' ["C",$P(^( 0),"^",2)' ["N" S SDX =1 Q
  4479   "RTN","SDC ",64,0)
  4480    Q:SDX  F  SD1=2,4 I  $D(^SC("AA S",SD1,FR\ 1,DFN)) S  SDX=1 Q
  4481   "RTN","SDC ",65,0)
  4482    Q:SDX  IF  $D(^SCE(+ $$EXAE^SDO E(DFN,FR\1 ,FR\1),0))  S SDX=1
  4483   "RTN","SDC ",66,0)
  4484    Q:SDX  K  ^DPT("ASDP SD","B",SD IV,FR\1,DF N) Q
  4485   "RTN","SDC ",67,0)
  4486   EVT ; -- s eparate ta g if need  to NEW var s
  4487   "RTN","SDC ",68,0)
  4488    N FR,I,SD TIME,DH,SC
  4489   "RTN","SDC ",69,0)
  4490    D CANCEL^ SDAMEVT(.S DATA,DFN,S DTTM,SDSC, SDPL,0,SDC NHDL) K SD ATA,SDCNHD L
  4491   "RTN","SDC ",70,0)
  4492    Q
  4493   "RTN","SDC ",71,0)
  4494    q  ;;#eor #
  4495   "RTN","SDC NP0")
  4496   0^52^B4260 8726
  4497   "RTN","SDC NP0",1,0)
  4498   SDCNP0 ;AL B/LDB - CA NCEL APPT.  FOR A PAT IENT ;MAR  15, 2017;2 018-06-05  12:06:33;8 .3;+mR7u8Y OlUBbLv4cm a3I0xj0sVI oxNQvJ1I/4 yaVjhs=
  4499   "RTN","SDC NP0",2,0)
  4500    ;;5.3;Sch eduling;** 132,167,47 8,517,572, 592,627,65 8,676**;Au g 13, 1993 ;Build 99
  4501   "RTN","SDC NP0",3,0)
  4502    ;
  4503   "RTN","SDC NP0",4,0)
  4504    ; Referen ce/ICR
  4505   "RTN","SDC NP0",5,0)
  4506    ; ^VALM1  - 10116
  4507   "RTN","SDC NP0",6,0)
  4508    ;
  4509   "RTN","SDC NP0",7,0)
  4510   EN2 D WAIT ^DICD S ND T=HDT/1,L= 0 F J=1:1  S NDT=$O(^ DPT(DFN,"S ",NDT)) Q: NDT'>0!(SD PV&(NDT'<S DTM))  S S D0=^(NDT,0 ) I $P(SD0 ,"^",2)'[" C" S SC=+S D0,L=L\1+1 ,APL="" D  FLEN^SDCNP 1A S ^UTIL ITY($J,"SD CNP",L)=ND T_"^"_SC_" ^"_COV_"^" _APL_"^^"_ APL D CHKS O
  4511   "RTN","SDC NP0",8,0)
  4512   WH1 G:L'>0  NO S (SDC TRL,SDCTR) =0,APP=""  N SDITEM W :'SDERR @I OF
  4513   "RTN","SDC NP0",9,0)
  4514    W ! F Z=0 :0 S Z=$O( ^UTILITY($ J,"SDCNP", Z)) Q:Z'>0   S SDITEM =$J($S(Z\1 =Z:"("_$J( Z,2)_") ", 1:""),5) D   Q:SDCTRL
  4515   "RTN","SDC NP0",10,0)
  4516    .I SDITEM ["(" W !,S DITEM S HL DCSND=""
  4517   "RTN","SDC NP0",11,0)
  4518    .I SDITEM '["(" W SD ITEM
  4519   "RTN","SDC NP0",12,0)
  4520    .S AT=$S( $P(^(Z),"^ ",2)'?.N:1 ,1:0),Y=$P ($P(^(Z)," ^"),".") D  DT^SDM0 S  X=$P(^(Z) ,"^"),^(Z, "CNT")=""  X ^DD("FUN C",2,1) W  " ",$J(X,8 ) D MORE W :AT ! Q:SD CTRL
  4521   "RTN","SDC NP0",13,0)
  4522    S:SDERR S DCTRL=1 I  Z>0 G:SDCT RL&(APP']" ") NOPE^SD CNP1 G:SDC TRL DEL
  4523   "RTN","SDC NP0",14,0)
  4524    D WH G NO PE^SDCNP1: APP']"",DE L
  4525   "RTN","SDC NP0",15,0)
  4526   WH W !!,"S ELECT APPO INTMENTS T O BE CANCE LLED" W:Z> 0 " OR HIT  RETURN TO  CONTINUE  DISPLAY" R  ": ",APP: DTIME I '$ T!(APP="^" ) S SDCTRL =1,APP=""  Q
  4527   "RTN","SDC NP0",16,0)
  4528    S SDMSG=" W !,""Ente r appt. nu mbers sepa rated by c ommas and/ or a range  separated "",!,""by  dashes (ie  2,4,6-9)" " H 2" I A PP["?" X S DMSG G WH
  4529   "RTN","SDC NP0",17,0)
  4530    S SDCTRL= $S(APP']"" :0,1:1) Q
  4531   "RTN","SDC NP0",18,0)
  4532   DEL S SDER R=0 F J=1: 1 S SDDH=$ P(APP,",", J) Q:SDDH' ]""  D MTC H^SDCNP1
  4533   "RTN","SDC NP0",19,0)
  4534    G:SDERR W H1
  4535   "RTN","SDC NP0",20,0)
  4536   DEL1 F J=1 :1 S SDDH= $P(APP,"," ,J) Q:SDDH ']""  S SD DI=$P(SDDH ,"-"),SDDM =$P(SDDH," -",2) D CK K^SDCNP1A  Q:SDERR  D  CKK1^SDCN P1A Q:SDER R  Q:'SDDI   F A1=SDD I:1:$S(SDD M:SDDM,1:S DDI) D BEG D
  4537   "RTN","SDC NP0",21,0)
  4538    G:SDERR W H1 G NOPE^ SDCNP1
  4539   "RTN","SDC NP0",22,0)
  4540   BEGD S (SD ,S)=$P(^UT ILITY($J," SDCNP",A1) ,"^",1),I= $P(^UTILIT Y($J,"SDCN P",A1),"^" ,2)
  4541   "RTN","SDC NP0",23,0)
  4542    S SL=^SC( I,"SL"),X= $P(SL,U,3) ,STARTDAY= $S($L(X):X ,1:8),SB=S TARTDAY-1/ 100,X=$P(S L,U,6),HSI =$S(X:X,1: 4),SI=$S(X ="":4,X<3: 4,X:X,1:4) ,STR="#@!$ * XXWVUTSR QPONMLKJIH GFEDCBA012 3456789jkl mnopqrstuv wxyz",SDDI F=$S(HSI<3 :8/HSI,1:2 ) K Y
  4543   "RTN","SDC NP0",24,0)
  4544    I $$CODT^ SDCOU(DFN, +^UTILITY( $J,"SDCNP" ,A1),+$P(^ (A1),U,2))  W !,*7,"> >> Appoint ment #",A1 ," has a c heck out d ate and ca nnot be ca ncelled."  Q
  4545   "RTN","SDC NP0",25,0)
  4546    D PROT^SD CNP1A Q:(S DPRT=1)!($ $MSG^SDMXF LAG(I))  D  CAN S $P( ^UTILITY($ J,"SDCNP", A1),"^",4) ="*** JUST  CANCELLED  ***" Q
  4547   "RTN","SDC NP0",26,0)
  4548   CAN Q:$P(^ UTILITY($J ,"SDCNP",A 1),"^",4)[ "JUST CANC ELLED"  S  CNT=CNT+1, DIV=$S($P( ^SC(I,0)," ^",15)]"": " "_$P(^(0 ),"^",15), 1:" 1") I  $D(^DPT("A SDPSD","C" ,DIV,I,S,D FN)) K ^(D FN)
  4549   "RTN","SDC NP0",27,0)
  4550    N SDATA,S DCPHDL,SDN OW,SDCLI S  SDCPHDL=$ $HANDLE^SD AMEVT(1) D  BEFORE^SD AMEVT(.SDA TA,DFN,S,I ,"",SDCPHD L)
  4551   "RTN","SDC NP0",28,0)
  4552    S SDCLI=I  ;changed  variable n ame I to S DCLI(Hospi tal locati on file IE N) as the  value of I  is manipu lated by ^ DIE SD*5.3 *592
  4553   "RTN","SDC NP0",29,0)
  4554    S:'$D(^DP T(DFN,"S", 0)) ^(0)=" ^2.98P^^"  I $D(SDREM ) S DIE="^ DPT("_DFN_ ",""S"",", (DA,Y)=S,D A(1)=DFN,D R="17///^S  X="_""""" _SDREM_""" "" D ^DIE  K DIE,DR
  4555   "RTN","SDC NP0",30,0)
  4556    S ^DPT("A SDCN",SDCL I,DA,DA(1) )=$S(SDWH[ "P":1,1:"" ) K DA
  4557   "RTN","SDC NP0",31,0)
  4558    ;removed  rounding l ogic for t ime and ch anged dire ct global  writes to  fileman ca ll SD*5.3* 592
  4559   "RTN","SDC NP0",32,0)
  4560    D NOW^%DT C S SDNOW= %,DIE="^DP T("_DFN_", ""S"",",DA =S,DA(1)=D FN,DR="3// /^S X=SDWH ;14////^S  X=DUZ;15// /^S X=SDNO W;16////^S  X=SDSCR"  D ^DIE K D IE,DR,DA
  4561   "RTN","SDC NP0",33,0)
  4562    S (DA,Y)= 0 F X=0:0  S X=+$O(^S C(SDCLI,"S ",S,1,X))  Q:'$D(^(X, 0))  D C Q :Y&(DA)
  4563   "RTN","SDC NP0",34,0)
  4564    D SDEC(DF N,S,SDCLI, SDWH,SDSCR ,SDREM,SDN OW,DUZ,"1" ) ;update  SDEC APPOI NTMENT   / alb/sat  S D/627 /alb /jsm 658 a dd passing  flag to i ndicate ca lled from  here
  4565   "RTN","SDC NP0",35,0)
  4566    I $D(^DPT ("ASDPSD", "B",DIV,S\ 1,DFN)) D  CK1
  4567   "RTN","SDC NP0",36,0)
  4568    Q:'Y  S S L=$P(^SC(S DCLI,"S",S ,1,Y,0),U, 2) I DA,'$ D(^("OB"))  K ^SC(SDC LI,"S",S,1 ,DA,"OB")
  4569   "RTN","SDC NP0",37,0)
  4570    S SDDA=DA ,SDTTM=S,S DRT="D",SD PL=Y,SDSC= SDCLI D RT ^SDUTL D C ANCEL^SDCN SLT S Y=SD PL,S=SDTTM ,SDCLI=SDS C,DA=SDDA  K SDDA ;SD /478
  4571   "RTN","SDC NP0",38,0)
  4572    S SDNODE= ^SC(SDCLI, "S",S,1,Y, 0),^SC("AR AD",SDCLI, S,DFN)="N" ,TLNK=$P($ G(^SC(SDCL I,"S",S,1, Y,"CONS")) ,U) K ^SC( SDCLI,"S", S,1,Y) K:$ O(^SC(SDCL I,"S",S,0) )'>0 ^SC(S DCLI,"S",S ,0) D CLRK ^SDCNP1  ; SD/478
  4573   "RTN","SDC NP0",39,0)
  4574    K:TLNK'=" " ^SC("AWA S1",TLNK), TLNK ;SD/4 78
  4575   "RTN","SDC NP0",40,0)
  4576    ;S SDNODE =^SC(I,"S" ,S,1,Y,0), ^SC("ARAD" ,I,S,DFN)= "N" S DA(2 )=I,DA(1)= S,DA=Y,DIK ="^SC("_DA (2)_",""S" ","_DA(1)_ ",1," D ^D IK K:$O(^S C(I,"S",S, 0))'>0 ^SC (I,"S",S,0 ) D CLRK^S DCNP1 ;SD/ 478
  4577   "RTN","SDC NP0",41,0)
  4578    D EVT
  4579   "RTN","SDC NP0",42,0)
  4580    Q:'$D(^SC (SDCLI,"ST ",SD\1,1))
  4581   "RTN","SDC NP0",43,0)
  4582   EN01 S S=^ SC(SDCLI," ST",SD\1,1 ),Y=SD#1-S B*100,ST=Y #1*SI\.6+( Y\1*SI),SS =SL*HSI/60
  4583   "RTN","SDC NP0",44,0)
  4584    I Y'<1 F  I=ST+ST:SD DIF S Y=$E (STR,$F(ST R,$E(S,I+1 ))) Q:Y=""   S S=$E(S ,1,I)_Y_$E (S,I+2,999 ),SS=SS-1  Q:SS'>0
  4585   "RTN","SDC NP0",45,0)
  4586    S ^(1)=S  Q  ;NAKED  REFERENCE  - ^SC(IFN, "ST",Date, 1)
  4587   "RTN","SDC NP0",46,0)
  4588   C I +^SC(S DCLI,"S",S ,1,X,0)=DF N S Y=X Q   ;changed  variable n ame I to S DCLI SD*5. 3*592
  4589   "RTN","SDC NP0",47,0)
  4590    Q:'$D(^(" OB"))!DA   S:^("OB")? 1"O".E DA= X Q
  4591   "RTN","SDC NP0",48,0)
  4592   NO W !,"NO  ",$S('SDP V:"PENDING ",1:"PREVI OUS")," AP POINTMENTS ",*7,*7,*7
  4593   "RTN","SDC NP0",49,0)
  4594    D END^SDC NP G RD^SD CNP
  4595   "RTN","SDC NP0",50,0)
  4596    Q
  4597   "RTN","SDC NP0",51,0)
  4598   CHKSO S CO V=$S($P(^D PT(DFN,"S" ,NDT,0),"^ ",11)=1:"  (COLLATERA L) ",1:"")  F SDJ=3,4 ,5 I $P(^D PT(DFN,"S" ,NDT,0),"^ ",SDJ)]""  S L=L+.1,^ UTILITY($J ,"SDCNP",L )=$P(^(0), "^",SDJ)_" ^"_$S(SDJ= 3:"LAB",SD J=4:"XRAY" ,1:"EKG")_ "^0^0"
  4599   "RTN","SDC NP0",52,0)
  4600    Q
  4601   "RTN","SDC NP0",53,0)
  4602   MORE S SDC TR=SDCTR+2  I AT W ?4 1,$P(^UTIL ITY($J,"SD CNP",Z),"^ ",2) G OVR
  4603   "RTN","SDC NP0",54,0)
  4604    W " ",$S( $P(^UTILIT Y($J,"SDCN P",Z),"^", 4)?.N:"("_ $P(^(Z),"^ ",4)_" MIN ) ",1:$P(^ (Z),"^",4) )," ",$S($ D(^SC($P(^ (Z),"^",2) ,0)):$P(^( 0),"^",1), 1:"DELETED  CLINIC"), $P(^UTILIT Y($J,"SDCN P",Z),"^", 3) ;SD/478
  4605   "RTN","SDC NP0",55,0)
  4606    N CSND,CS DT,CSSD,CO NSULT,Y
  4607   "RTN","SDC NP0",56,0)
  4608    S CSND=^U TILITY($J, "SDCNP",Z) ,CSDT=$P(C SND,U),CSS D=$P(CSND, U,2),HLDCS ND=CSND S  CONSULT=$$ CONSULT(CS SD,CSDT) I  +$G(CONSU LT) S Y=$P (^GMR(123, CONSULT,0) ,U) D DD^% DT W !?5," CONSULT ", Y,"/ ",CON SULT
  4609   "RTN","SDC NP0",57,0)
  4610    D STATUS( $X>55)
  4611   "RTN","SDC NP0",58,0)
  4612   OVR ;Follo wing code  added SD/5 17
  4613   "RTN","SDC NP0",59,0)
  4614    I '$D(CSN D) I $G(HL DCSND) I ( ($P(HLDCSN D,U,4)="") !($P(HLDCS ND,U,6)="" )) D
  4615   "RTN","SDC NP0",60,0)
  4616    .W !!,"** ********** ********** ********** ********** ********** ********** ********"
  4617   "RTN","SDC NP0",61,0)
  4618    .W !,"* W ARNING: Th ere is a d ata incons istency or  data corr uption pro blem  *"
  4619   "RTN","SDC NP0",62,0)
  4620    .W !,"* w ith the ab ove appoin tment.  Co rrective a ction need s to be ta ken.  *"
  4621   "RTN","SDC NP0",63,0)
  4622    .W !,"* P lease canc el the app ointment a bove.  If  it is a va lid appoin tment,*"
  4623   "RTN","SDC NP0",64,0)
  4624    .W !,"* i t will hav e to be re -entered v ia Appoint ment Manag ement.           *"
  4625   "RTN","SDC NP0",65,0)
  4626    .W !,"*** ********** ********** ********** ********** ********** ********** *******"
  4627   "RTN","SDC NP0",66,0)
  4628    .S SDCTR= 21
  4629   "RTN","SDC NP0",67,0)
  4630    .K HLDCSN D
  4631   "RTN","SDC NP0",68,0)
  4632    ;
  4633   "RTN","SDC NP0",69,0)
  4634    I SDCTR>2 0,$O(^UTIL ITY($J,"SD CNP",Z)) S  (SDCTRL,S DCTR)=0 W  *7 D WH W: 'SDCTRL @I OF
  4635   "RTN","SDC NP0",70,0)
  4636    Q
  4637   "RTN","SDC NP0",71,0)
  4638    ;
  4639   "RTN","SDC NP0",72,0)
  4640   CONSULT(CS SD,CSDT) ;
  4641   "RTN","SDC NP0",73,0)
  4642    N CSI S C ONSULT=""
  4643   "RTN","SDC NP0",74,0)
  4644    S CSI=0 F   S CSI=$O (^SC(CSSD, "S",CSDT,1 ,CSI)) Q:' +CSI  I $P ($G(^SC(CS SD,"S",CSD T,1,CSI,0) ),U)=DFN S  CONSULT=$ P($G(^SC(C SSD,"S",CS DT,1,CSI," CONS")),U)  Q  ;SD/47 8
  4645   "RTN","SDC NP0",75,0)
  4646    Q CONSULT
  4647   "RTN","SDC NP0",76,0)
  4648   CK1 S SDX= 0 F SD1=S\ 1:0 S SD1= $O(^DPT(DF N,"S",SD1) ) Q:'SD1!( (SD1\1)'=( S\1))  I $ P(^(SD1,0) ,"^",2)'[" C",$P(^(0) ,"^",2)'[" N" S SDX=1  Q
  4649   "RTN","SDC NP0",77,0)
  4650    Q:SDX  F  SD1=2,4 I  $D(^SC("AA S",SD1,S\1 ,DFN)) S S DX=1 Q
  4651   "RTN","SDC NP0",78,0)
  4652    Q:SDX  IF  $D(^SCE(+ $$EXAE^SDO E(DFN,S\1, S\1),0)) S  SDX=1
  4653   "RTN","SDC NP0",79,0)
  4654    Q:SDX  K  ^DPT("ASDP SD","B",DI V,S\1,DFN)  Q
  4655   "RTN","SDC NP0",80,0)
  4656    ;
  4657   "RTN","SDC NP0",81,0)
  4658   SDEC(DFN,S ,SDCLI,SDW H,SDSCR,SD REM,SDNOW, SDDUZ,SDF)  ;update S DEC APPOIN TMENT   /a lb/sat  SD /627
  4659   "RTN","SDC NP0",82,0)
  4660    N SDECAPP T
  4661   "RTN","SDC NP0",83,0)
  4662    S SDECAPP T=$$APPTGE T^SDECUTL( DFN,S,SDCL I)
  4663   "RTN","SDC NP0",84,0)
  4664    D:+SDECAP PT SDECCAN ^SDEC08(SD ECAPPT,SDW H,SDSCR,SD REM,SDNOW, $S($G(SDDU Z)'="":SDD UZ,1:DUZ), "0"_$G(SDF ,0))  ;alb /jsm 658 a dd flag to  indicate  called fro m SDAM APP T CANCEL
  4665   "RTN","SDC NP0",85,0)
  4666    Q
  4667   "RTN","SDC NP0",86,0)
  4668    ;end addi tion/modif ication  / alb/sat  S D/627
  4669   "RTN","SDC NP0",87,0)
  4670    ;
  4671   "RTN","SDC NP0",88,0)
  4672   STATUS(LF)  ;
  4673   "RTN","SDC NP0",89,0)
  4674    W:LF !
  4675   "RTN","SDC NP0",90,0)
  4676    W ?55,"(" ,$E($$LOWE R^VALM1($P ($$STATUS^ SDAM1(DFN, +^UTILITY( $J,"SDCNP" ,Z),+$P(^( Z),U,2),$G (^DPT(DFN, "S",+^(Z), 0))),";",3 )),1,23)," )"
  4677   "RTN","SDC NP0",91,0)
  4678    W:'LF !
  4679   "RTN","SDC NP0",92,0)
  4680    Q
  4681   "RTN","SDC NP0",93,0)
  4682    ;
  4683   "RTN","SDC NP0",94,0)
  4684   EVT ; -- s eparate ta g if need  to NEW var s
  4685   "RTN","SDC NP0",95,0)
  4686    N I,STR,S S,SL,SD,SB ,SI,HSI,J, APP,S,A1,S TARTDAY,CN T,DIV,SDER R,SDDIF
  4687   "RTN","SDC NP0",96,0)
  4688    D CANCEL^ SDAMEVT(.S DATA,DFN,S DTTM,SDSC, SDPL,0,SDC PHDL)
  4689   "RTN","SDC NP0",97,0)
  4690    Q
  4691   "RTN","SDC NP0",98,0)
  4692    q  ;;#eor #
  4693   "RTN","SDC O1")
  4694   0^48^B3290 4159
  4695   "RTN","SDC O1",1,0)
  4696   SDCO1 ;ALB /RMO - App ointment -  Check Out  ;JAN 15,  2016
  4697   "RTN","SDC O1",2,0)
  4698    ;;5.3;Sch eduling;** 27,132,149 ,193,250,2 96,446,538 ,627,676** ;08/13/93; Build 99
  4699   "RTN","SDC O1",3,0)
  4700    ;
  4701   "RTN","SDC O1",4,0)
  4702    ;check ou t if sd/36 9 is relea sed before  446!!!
  4703   "RTN","SDC O1",5,0)
  4704    ;
  4705   "RTN","SDC O1",6,0)
  4706   EN ;Entry  point for  SDCO APPT  CHECK OUT  protocol
  4707   "RTN","SDC O1",7,0)
  4708    N SDCOALB F,SDCOAP,S DCOBG,SDCO DT,VALMY
  4709   "RTN","SDC O1",8,0)
  4710    S VALMBCK =""
  4711   "RTN","SDC O1",9,0)
  4712    D EN^VALM 2(XQORNOD( 0))
  4713   "RTN","SDC O1",10,0)
  4714    D FULL^VA LM1
  4715   "RTN","SDC O1",11,0)
  4716    S SDCOAP= 0 D NOW^%D TC S SDCOD T=$P(%,"." )_"."_$E($ P(%,".",2) _"0000",1, 4)
  4717   "RTN","SDC O1",12,0)
  4718    F  S SDCO AP=$O(VALM Y(SDCOAP))  Q:'SDCOAP   D
  4719   "RTN","SDC O1",13,0)
  4720    .I $D(^TM P("SDAMIDX ",$J,SDCOA P)) K SDAT  S SDAT=^( SDCOAP) D
  4721   "RTN","SDC O1",14,0)
  4722    ..W !!,^T MP("SDAM", $J,+SDAT,0 )
  4723   "RTN","SDC O1",15,0)
  4724    ..I $$CHK ^SDCOU(SDC OAP) D CO( +$P(SDAT," ^",2),+$P( SDAT,"^",3 ),+$P(SDAT ,"^",4),+$ P(SDAT,"^" ,5),0,SDCO DT,"CO",+S DAT,.SDCOA LBF)
  4725   "RTN","SDC O1",16,0)
  4726    I $G(SDCO ALBF) S SD COBG=VALMB G W ! D BL D^SDAM S:$ D(@VALMAR@ (SDCOBG,0) ) VALMBG=S DCOBG
  4727   "RTN","SDC O1",17,0)
  4728    S VALMBCK ="R"
  4729   "RTN","SDC O1",18,0)
  4730    K SDAT
  4731   "RTN","SDC O1",19,0)
  4732    Q
  4733   "RTN","SDC O1",20,0)
  4734    ;
  4735   "RTN","SDC O1",21,0)
  4736   CO(DFN,SDT ,SDCL,SDDA ,SDASK,SDC ODT,SDCOAC T,SDLNE,SD COALBF) ;A ppt Check  Out
  4737   "RTN","SDC O1",22,0)
  4738    ; Input   -- DFN       Patient  file IEN
  4739   "RTN","SDC O1",23,0)
  4740    ;            SDT       Appointm ent Date/T ime
  4741   "RTN","SDC O1",24,0)
  4742    ;            SDCL      Hospital  Location  file IEN f or Appt
  4743   "RTN","SDC O1",25,0)
  4744    ;            SDDA      IEN in ^ SC multipl e or null  [Optional]
  4745   "RTN","SDC O1",26,0)
  4746    ;            SDASK     Ask Chec k Out Date /Time      [Optional]
  4747   "RTN","SDC O1",27,0)
  4748    ;            SDCODT    Date/Tim e of Check  Out       [Optional]
  4749   "RTN","SDC O1",28,0)
  4750    ;            SDCOACT   Appt Mgm t Check Ou t Action   [Optional]
  4751   "RTN","SDC O1",29,0)
  4752    ;            SDLNE     Appt Mgm t Line Num ber        [Optional]
  4753   "RTN","SDC O1",30,0)
  4754    ; Output  -- SDCOALB F Re-build  Appt Mgmt  List
  4755   "RTN","SDC O1",31,0)
  4756    I $$MSG^S DMXFLAG(SD CL) H 3 Q   ; SD/676
  4757   "RTN","SDC O1",32,0)
  4758    I $D(XRTL ) D T0^%ZO SV
  4759   "RTN","SDC O1",33,0)
  4760    N SDCOQUI T,SDOE,SDA TA,SDECAPP T
  4761   "RTN","SDC O1",34,0)
  4762    S:'SDDA S DDA=$$FIND ^SDAM2(DFN ,SDT,SDCL)
  4763   "RTN","SDC O1",35,0)
  4764    I 'SDDA W  !!,*7,">> > You cann ot check o ut this ap pointment. " D PAUSE^ VALM1 G CO Q
  4765   "RTN","SDC O1",36,0)
  4766    S SDATA=$ G(^DPT(DFN ,"S",SDT,0 ))
  4767   "RTN","SDC O1",37,0)
  4768    ; ** MT B locking re moved
  4769   "RTN","SDC O1",38,0)
  4770    ;S X="EAS MTCHK" X ^ %ZOSF("TES T") I $T,$ G(EASACT)' ="W",$$MT^ EASMTCHK(D FN,$P($G(S DATA),U,16 ),"C",$G(S DT)) D PAU SE^VALM1 G  COQ
  4771   "RTN","SDC O1",39,0)
  4772    ;
  4773   "RTN","SDC O1",40,0)
  4774    ;-- if ne w encounte r, pass to  PCE
  4775   "RTN","SDC O1",41,0)
  4776    I $$NEW^S DPCE(SDT)  D  S VALMB CK="R",SDC OALBF=1 G  COQ
  4777   "RTN","SDC O1",42,0)
  4778    . N SDCOE D
  4779   "RTN","SDC O1",43,0)
  4780    . S SDOE= $$GETAPT^S DVSIT2(DFN ,SDT,SDCL)
  4781   "RTN","SDC O1",44,0)
  4782    . ;
  4783   "RTN","SDC O1",45,0)
  4784    . ; -- ha s appt alr eady been  checked ou t
  4785   "RTN","SDC O1",46,0)
  4786    . S SDCOE D=$$CHK($T R($$STATUS ^SDAM1(DFN ,SDT,SDCL, SDATA,SDDA ),";","^") )
  4787   "RTN","SDC O1",47,0)
  4788    . ;
  4789   "RTN","SDC O1",48,0)
  4790    . ; -- if  not check ed out the n do inter view proce ss
  4791   "RTN","SDC O1",49,0)
  4792    . IF '$$C ODT^SDCOU( DFN,SDT,SD CL) D
  4793   "RTN","SDC O1",50,0)
  4794    . . N SDC OMKF,SDTRE S
  4795   "RTN","SDC O1",51,0)
  4796    . . ;
  4797   "RTN","SDC O1",52,0)
  4798    . . ; --  first, che ck if shou ld make fo llow-up ap pt
  4799   "RTN","SDC O1",53,0)
  4800    . . IF $G (SDCOACT)= "CO",'SDCO ED D
  4801   "RTN","SDC O1",54,0)
  4802    . . . N S DCOMKF
  4803   "RTN","SDC O1",55,0)
  4804    . . . D M C^SDCO5(SD OE,1,.SDCO MKF,.SDCOQ UIT) Q:$D( SDCOQUIT)
  4805   "RTN","SDC O1",56,0)
  4806    . . . ;
  4807   "RTN","SDC O1",57,0)
  4808    . . . ; - - Set flag  to re-bui ld appoint ment list
  4809   "RTN","SDC O1",58,0)
  4810    . . . IF  $G(SDCOMKF ) S SDCOAL BF=1
  4811   "RTN","SDC O1",59,0)
  4812    . . ;
  4813   "RTN","SDC O1",60,0)
  4814    . . ; --  c/o interv iew if use r didn't q uit
  4815   "RTN","SDC O1",61,0)
  4816    . . I '$D (SDCOQUIT) ,'SDCOED D
  4817   "RTN","SDC O1",62,0)
  4818    . . . N S DAPTYP
  4819   "RTN","SDC O1",63,0)
  4820    . . . S S DTRES=$$IN TV^PXAPI(" INTV","SD" ,"PIMS",$P ($G(^SCE(+ SDOE,0)),U ,5),$P($G( ^SCE(+SDOE ,0)),U,4), DFN)
  4821   "RTN","SDC O1",64,0)
  4822    . . . Q:S DTRES<0
  4823   "RTN","SDC O1",65,0)
  4824    . . . ;up date SDEC  APPOINTMEN T - alb/sa t 627
  4825   "RTN","SDC O1",66,0)
  4826    . . . S S DECAPPT=$$ APPTGET^SD ECUTL(DFN, SDT,SDCL)   ;get SDEC  APPOINTME NT ien
  4827   "RTN","SDC O1",67,0)
  4828    . . . I S DECAPPT=""  D SDEC^SD AMWI1 S SD ECAPPT=$$A PPTGET^SDE CUTL(DFN,S DT,SDCL)
  4829   "RTN","SDC O1",68,0)
  4830    . . . D C O1^SDEC25B (SDECAPPT, $S($G(SDCO DT)="":$E( $$NOW^XLFD T,1,12),1: SDCODT),+S DOE)
  4831   "RTN","SDC O1",69,0)
  4832    . . . ;
  4833   "RTN","SDC O1",70,0)
  4834    . . . ; - - ask user  if they w ant to see  c/o scree n
  4835   "RTN","SDC O1",71,0)
  4836    . . . S S DGAFC=$$AS K^SDCO6
  4837   "RTN","SDC O1",72,0)
  4838    . . . I ' SDGAFC D
  4839   "RTN","SDC O1",73,0)
  4840    . . . .N  SDELIG
  4841   "RTN","SDC O1",74,0)
  4842    . . . .S  SDELIG=$$E LSTAT^SDUT L2(DFN)
  4843   "RTN","SDC O1",75,0)
  4844    . . . .I  $$MHCLIN^S DUTL2(SDCL ),'($$COLL AT^SDUTL2( SDELIG)!$P (SDATA,U,1 1)) D
  4845   "RTN","SDC O1",76,0)
  4846    . . . . . I $$NEWGAF ^SDUTL2(DF N) D
  4847   "RTN","SDC O1",77,0)
  4848    . . . . .  .I '$$GAF CM^SDUTL2( ) S SDGAFC =1
  4849   "RTN","SDC O1",78,0)
  4850    . . .I SD GAFC D EN^ SDCO(SDOE, ,1)
  4851   "RTN","SDC O1",79,0)
  4852    . ;
  4853   "RTN","SDC O1",80,0)
  4854    . ; -- if  already c hecked out  then show  c/o scree n
  4855   "RTN","SDC O1",81,0)
  4856    . E  D EN ^SDCO(SDOE ,,1)
  4857   "RTN","SDC O1",82,0)
  4858    ;
  4859   "RTN","SDC O1",83,0)
  4860    ; -- view  if old en counters
  4861   "RTN","SDC O1",84,0)
  4862    S SDOE=$$ GETAPT^SDV SIT2(DFN,S DT,SDCL)
  4863   "RTN","SDC O1",85,0)
  4864    D EN^SDCO (SDOE,,1)
  4865   "RTN","SDC O1",86,0)
  4866    ;
  4867   "RTN","SDC O1",87,0)
  4868   COQ K % D  EWLCHK Q
  4869   "RTN","SDC O1",88,0)
  4870    Q
  4871   "RTN","SDC O1",89,0)
  4872   EWLCHK ;ch eck if pat ient has a ny open EW L entries  (SD/372)
  4873   "RTN","SDC O1",90,0)
  4874    ;get appo intment
  4875   "RTN","SDC O1",91,0)
  4876    ;
  4877   "RTN","SDC O1",92,0)
  4878    K ^TMP($J ,"SDAMA301 "),^TMP($J ,"APPT")
  4879   "RTN","SDC O1",93,0)
  4880    W:$D(IOF)  @IOF D AP PT^SDWLEVA L(DFN,SDT, SDCL)
  4881   "RTN","SDC O1",94,0)
  4882    Q:'$D(^TM P($J,"APPT "))
  4883   "RTN","SDC O1",95,0)
  4884    N SDEV D  EN^SDWLEVA L(DFN,.SDE V) I SDEV, $L(SDEV(1) )>0 D
  4885   "RTN","SDC O1",96,0)
  4886    .K ^TMP(" SDWLPL",$J ),^TMP($J, "SDWLPL")
  4887   "RTN","SDC O1",97,0)
  4888    .D INIT^S DWLPL(DFN, "M")
  4889   "RTN","SDC O1",98,0)
  4890    .Q:'$D(^T MP($J,"SDW LPL"))
  4891   "RTN","SDC O1",99,0)
  4892    .D LIST^S DWLPL("M", DFN)
  4893   "RTN","SDC O1",100,0)
  4894    .F  Q:'$D (^TMP($J," SDWLPL"))   N SDR D A NSW^SDWLEV AL(1,.SDR)  I 'SDR D  LIST^SDWLP L("M",DFN)  D
  4895   "RTN","SDC O1",101,0)
  4896    ..F  N SD R  D ANSW^ SDWLEVAL(0 ,.SDR) Q:' $D(^TMP($J ,"SDWLPL") )  I 'SDR  W !!,"MUST  ACCEPT OR  ENTER A R EASON NOT  TO DISPOSI TION MATCH ED EWL ENT RY",!
  4897   "RTN","SDC O1",102,0)
  4898    ..Q
  4899   "RTN","SDC O1",103,0)
  4900    .Q
  4901   "RTN","SDC O1",104,0)
  4902    Q
  4903   "RTN","SDC O1",105,0)
  4904    ;
  4905   "RTN","SDC O1",106,0)
  4906   BEFORE(SDA TA,DFN,SDT ,SDCL,SDDA ,SDHDL) ;  -- event d river befo re ; not u sed
  4907   "RTN","SDC O1",107,0)
  4908    S SDATA=S DDA_"^"_DF N_"^"_SDT_ "^"_SDCL,S DHDL=$$HAN DLE^SDAMEV T(1)
  4909   "RTN","SDC O1",108,0)
  4910    D BEFORE^ SDAMEVT(.S DATA,DFN,S DT,SDCL,SD DA,SDHDL)
  4911   "RTN","SDC O1",109,0)
  4912    Q
  4913   "RTN","SDC O1",110,0)
  4914    ;
  4915   "RTN","SDC O1",111,0)
  4916   AFTER(SDAT A,DFN,SDT, SDCL,SDDA, SDHDL,SDLN E) ; -- ev ent driver  after ; n ot used
  4917   "RTN","SDC O1",112,0)
  4918    D AFTER^S DAMEVT(.SD ATA,DFN,SD T,SDCL,SDD A,SDHDL)
  4919   "RTN","SDC O1",113,0)
  4920    D:$G(SDLN E) UPD(DFN ,SDT,SDCL, SDLNE,SDAT A("BEFORE" ,"STATUS") ,SDATA("AF TER","STAT US"))
  4921   "RTN","SDC O1",114,0)
  4922    D EVT^SDA MEVT(.SDAT A,5,0,SDHD L)
  4923   "RTN","SDC O1",115,0)
  4924    Q
  4925   "RTN","SDC O1",116,0)
  4926    ;
  4927   "RTN","SDC O1",117,0)
  4928   UPD(DFN,SD T,SDCL,SDL NE,SDSTB,S DSTA) ; --  update ap pt mgmt sc reen ; use d by AFTER  but AFTER  is not us ed
  4929   "RTN","SDC O1",118,0)
  4930    N SDAMBOL D
  4931   "RTN","SDC O1",119,0)
  4932    I $P(SDST B,"^",3)'= $P(SDSTA," ^",3) D UP D^SDAM2($$ LOWER^VALM 1($P(SDSTA ,"^",3))," STAT",SDLN E),UPD^SDA M2("","TIM E",SDLNE)  S SDAMBOLD (DFN,SDT,S DCL)=""
  4933   "RTN","SDC O1",120,0)
  4934    I $P(SDST A,"^",3)[" CHECKED OU T",$P($P(S DSTA,"^",5 ),".")=DT  D UPD^SDAM 2($$TIME^S DAM1($P($P (SDSTA,"^" ,5),".",2) ),"TIME",S DLNE)
  4935   "RTN","SDC O1",121,0)
  4936    Q
  4937   "RTN","SDC O1",122,0)
  4938    ;
  4939   "RTN","SDC O1",123,0)
  4940   ELIG(DFN,S DT,SDCL,SD DA) ; -- u pdate elig  if blank
  4941   "RTN","SDC O1",124,0)
  4942    N X,DR
  4943   "RTN","SDC O1",125,0)
  4944    I $P(^SC( SDCL,"S",S DT,1,SDDA, 0),U,10)=" " D
  4945   "RTN","SDC O1",126,0)
  4946    .S X=+$G( ^DPT(DFN,. 36)),X=$S( '$D(^DIC(8 ,X,0)):"", $P(^(0),U, 4)=6:"",1: X)
  4947   "RTN","SDC O1",127,0)
  4948    .I X]"" S  DR="30/// /^S X="_X  D DIE(SDCL ,SDT,SDDA, DR)
  4949   "RTN","SDC O1",128,0)
  4950    Q
  4951   "RTN","SDC O1",129,0)
  4952    ;
  4953   "RTN","SDC O1",130,0)
  4954   CHK(SDSTB)  ; -- is a ppointment  checked o ut
  4955   "RTN","SDC O1",131,0)
  4956    N Y
  4957   "RTN","SDC O1",132,0)
  4958    I "^2^8^1 2^"[("^"_+ SDSTB_"^") ,$P(SDSTB, "^",3)["CH ECKED OUT"  S Y=1
  4959   "RTN","SDC O1",133,0)
  4960    Q +$G(Y)
  4961   "RTN","SDC O1",134,0)
  4962    ;
  4963   "RTN","SDC O1",135,0)
  4964   DT(DFN,SDT ,SDCL,SDDA ,SDASK,SDC ODT,SDCOQU IT) ;Updat e Check Ou t Date
  4965   "RTN","SDC O1",136,0)
  4966    N %DT,DR, SDCIDT,X
  4967   "RTN","SDC O1",137,0)
  4968    S:'$D(^SC (SDCL,"S", 0)) ^(0)=" ^44.001DA^ ^"
  4969   "RTN","SDC O1",138,0)
  4970    S DR="",S DCIDT=$P($ G(^SC(SDCL ,"S",SDT,1 ,SDDA,"C") ),"^"),X=$ P($G(^("C" )),"^",3)
  4971   "RTN","SDC O1",139,0)
  4972    I X G DTQ :'SDASK  S  DR="303R"
  4973   "RTN","SDC O1",140,0)
  4974    I DR="",$ P(^SC(SDCL ,0),U,24), $$REQ^SDM1 A(SDT)="CO " S DR="30 3R//"_$S($ G(SDCODT): $$FTIME^VA LM1($S(SDC ODT<SDCIDT :SDCIDT,1: SDCODT)),1 :"NOW")
  4975   "RTN","SDC O1",141,0)
  4976    I DR="" S  DR="303R/ //"_$S($G( SDCODT):"/ "_$S(SDCOD T<SDCIDT:S DCIDT,1:SD CODT),1:"N OW")
  4977   "RTN","SDC O1",142,0)
  4978    S DR="S S DCOQUIT="" "";"_DR_"; K SDCOQUIT "
  4979   "RTN","SDC O1",143,0)
  4980    D DIE(SDC L,SDT,SDDA ,DR)
  4981   "RTN","SDC O1",144,0)
  4982   DTQ Q
  4983   "RTN","SDC O1",145,0)
  4984    ;
  4985   "RTN","SDC O1",146,0)
  4986   DIE(SDCL,S DT,SDDA,DR ) ; -- upd ate appt d ata in ^SC
  4987   "RTN","SDC O1",147,0)
  4988    N DA,DIE
  4989   "RTN","SDC O1",148,0)
  4990    S DA(2)=S DCL,DA(1)= SDT,DA=SDD A,DIE="^SC ("_DA(2)_" ,""S"","_D A(1)_",1,"
  4991   "RTN","SDC O1",149,0)
  4992    D ^DIE K  DQ,DE
  4993   "RTN","SDC O1",150,0)
  4994   DIEQ Q
  4995   "RTN","SDC OAM")
  4996   0^49^B2113 3832
  4997   "RTN","SDC OAM",1,0)
  4998   SDCOAM ;AL B/RMO - Ap pt Mgmt Ac tions - Ch eck Out; 1 1 FEB 1993  10:00 am
  4999   "RTN","SDC OAM",2,0)
  5000    ;;5.3;Sch eduling;** 1,20,27,66 ,132,676** ;08/13/93; Build 99
  5001   "RTN","SDC OAM",3,0)
  5002    ;
  5003   "RTN","SDC OAM",4,0)
  5004   CO(SDCOACT ,SDCOACTD)  ;Check Ou t Classifi cation, Pr ovider and  Diagnosis
  5005   "RTN","SDC OAM",5,0)
  5006    ;                 Ac tions on A ppt Mgmt
  5007   "RTN","SDC OAM",6,0)
  5008    N DFN,SDC L,SDCOAP,S DDA,SDOE,S DT,VALMY
  5009   "RTN","SDC OAM",7,0)
  5010    S VALMBCK =""
  5011   "RTN","SDC OAM",8,0)
  5012    D EN^VALM 2(XQORNOD( 0))
  5013   "RTN","SDC OAM",9,0)
  5014    D FULL^VA LM1
  5015   "RTN","SDC OAM",10,0)
  5016    S SDCOAP= 0
  5017   "RTN","SDC OAM",11,0)
  5018    F  S SDCO AP=$O(VALM Y(SDCOAP))  Q:'SDCOAP   D
  5019   "RTN","SDC OAM",12,0)
  5020    .I $D(^TM P("SDAMIDX ",$J,SDCOA P)) K SDAT  S SDAT=^( SDCOAP) D
  5021   "RTN","SDC OAM",13,0)
  5022    ..W !!,^T MP("SDAM", $J,+SDAT,0 )
  5023   "RTN","SDC OAM",14,0)
  5024    ..S DFN=+ $P(SDAT,"^ ",2),SDT=+ $P(SDAT,"^ ",3),SDCL= +$P(SDAT," ^",4),SDDA =$$FIND^SD AM2(DFN,SD T,SDCL)
  5025   "RTN","SDC OAM",15,0)
  5026    ..S SDOE= +$P($G(^DP T(DFN,"S", SDT,0)),"^ ",20)
  5027   "RTN","SDC OAM",16,0)
  5028    ..I 'SDOE !('$$CODT^ SDCOU(DFN, SDT,SDCL))  W !!,*7," >>> The ap pointment  must have  a check ou t date/tim e to updat e ",SDCOAC TD,"." D P AUSE^VALM1  Q
  5029   "RTN","SDC OAM",17,0)
  5030    ..D ACT(S DCOACT,SDO E,DFN,SDT, SDCL,SDDA, +SDAT)
  5031   "RTN","SDC OAM",18,0)
  5032    S VALMBCK ="R"
  5033   "RTN","SDC OAM",19,0)
  5034    K SDAT
  5035   "RTN","SDC OAM",20,0)
  5036   COQ Q
  5037   "RTN","SDC OAM",21,0)
  5038    ;
  5039   "RTN","SDC OAM",22,0)
  5040   ACT(SDCOAC T,SDOE,DFN ,SDT,SDCL, SDDA,SDLNE ) ; -- Che ck Out Act ions
  5041   "RTN","SDC OAM",23,0)
  5042    N SDCOMF, SDCOQUIT,S DHL,SDVISI T,SDATA,SD HDL
  5043   "RTN","SDC OAM",24,0)
  5044    ;
  5045   "RTN","SDC OAM",25,0)
  5046    S SDVISIT =+$P($G(^S CE(+SDOE,0 )),U,5)
  5047   "RTN","SDC OAM",26,0)
  5048    ;
  5049   "RTN","SDC OAM",27,0)
  5050    ; -- quit  if not ok  to edit
  5051   "RTN","SDC OAM",28,0)
  5052    IF '$$EDI TOK^SDCO3( $G(SDOE),1 ) G ACTQ
  5053   "RTN","SDC OAM",29,0)
  5054    ;
  5055   "RTN","SDC OAM",30,0)
  5056    ; -- set  pce action  parameter
  5057   "RTN","SDC OAM",31,0)
  5058    S SDPXACT =""
  5059   "RTN","SDC OAM",32,0)
  5060    I $G(SDCO ACT)="CL"  S SDPXACT= "SCC"
  5061   "RTN","SDC OAM",33,0)
  5062    I $G(SDCO ACT)="PR"  S SDPXACT= "PRV"
  5063   "RTN","SDC OAM",34,0)
  5064    I $G(SDCO ACT)="DX"  S SDPXACT= "POV"
  5065   "RTN","SDC OAM",35,0)
  5066    I $G(SDCO ACT)="CPT"  S SDPXACT ="CPT"
  5067   "RTN","SDC OAM",36,0)
  5068    ;
  5069   "RTN","SDC OAM",37,0)
  5070    ; -- quit  if no act ion set
  5071   "RTN","SDC OAM",38,0)
  5072    IF SDPXAC T="" G ACT Q
  5073   "RTN","SDC OAM",39,0)
  5074    ;
  5075   "RTN","SDC OAM",40,0)
  5076    ; -- do p ce intervi ew then re build appt  list
  5077   "RTN","SDC OAM",41,0)
  5078    S X=$$INT V^PXAPI(SD PXACT,"SD" ,"PIMS",.S DVISIT,.SD HL,DFN)
  5079   "RTN","SDC OAM",42,0)
  5080    D BLD^SDA M
  5081   "RTN","SDC OAM",43,0)
  5082   ACTQ Q
  5083   "RTN","SDC OAM",44,0)
  5084    ;
  5085   "RTN","SDC OAM",45,0)
  5086   PD ;Entry  point for  SDAM PATIE NT DEMOGRA PHICS prot ocol
  5087   "RTN","SDC OAM",46,0)
  5088    N SDCOAP, VALMY
  5089   "RTN","SDC OAM",47,0)
  5090    S VALMBCK =""
  5091   "RTN","SDC OAM",48,0)
  5092    D FULL^VA LM1
  5093   "RTN","SDC OAM",49,0)
  5094    I SDAMTYP ="P" W !!, VALMHDR(1) ,! D DEM(S DFN)
  5095   "RTN","SDC OAM",50,0)
  5096    I SDAMTYP ="C" D
  5097   "RTN","SDC OAM",51,0)
  5098    .D EN^VAL M2(XQORNOD (0))
  5099   "RTN","SDC OAM",52,0)
  5100    .S SDCOAP =0 F  S SD COAP=$O(VA LMY(SDCOAP )) Q:'SDCO AP  D
  5101   "RTN","SDC OAM",53,0)
  5102    ..I $D(^T MP("SDAMID X",$J,SDCO AP)) K SDA T S SDAT=^ (SDCOAP) D
  5103   "RTN","SDC OAM",54,0)
  5104    ...W !!,^ TMP("SDAM" ,$J,+SDAT, 0),!
  5105   "RTN","SDC OAM",55,0)
  5106    ...D DEM( +$P(SDAT," ^",2))
  5107   "RTN","SDC OAM",56,0)
  5108    S VALMBCK ="R"
  5109   "RTN","SDC OAM",57,0)
  5110   PDQ Q
  5111   "RTN","SDC OAM",58,0)
  5112    ;
  5113   "RTN","SDC OAM",59,0)
  5114   DEM(DFN) ; Demographi cs
  5115   "RTN","SDC OAM",60,0)
  5116    D QUES^DG RPU1(DFN," ADD")
  5117   "RTN","SDC OAM",61,0)
  5118    Q
  5119   "RTN","SDC OAM",62,0)
  5120    ;
  5121   "RTN","SDC OAM",63,0)
  5122   DC ;Entry  point for  SDAM DISCH ARGE CLINI C protocol
  5123   "RTN","SDC OAM",64,0)
  5124    N SDCOAP, VALMY
  5125   "RTN","SDC OAM",65,0)
  5126    S VALMBCK =""
  5127   "RTN","SDC OAM",66,0)
  5128    D FULL^VA LM1
  5129   "RTN","SDC OAM",67,0)
  5130    I SDAMTYP ="P" W !!, VALMHDR(1) ,! D DIS(S DFN)
  5131   "RTN","SDC OAM",68,0)
  5132    I SDAMTYP ="C" D
  5133   "RTN","SDC OAM",69,0)
  5134    .D EN^VAL M2(XQORNOD (0))
  5135   "RTN","SDC OAM",70,0)
  5136    .S SDCOAP =0 F  S SD COAP=$O(VA LMY(SDCOAP )) Q:'SDCO AP  D
  5137   "RTN","SDC OAM",71,0)
  5138    ..I $D(^T MP("SDAMID X",$J,SDCO AP)) K SDA T S SDAT=^ (SDCOAP) D
  5139   "RTN","SDC OAM",72,0)
  5140    ...W !!,^ TMP("SDAM" ,$J,+SDAT, 0),!
  5141   "RTN","SDC OAM",73,0)
  5142    ...D DIS( +$P(SDAT," ^",2),$P(S DAT,"^",4) )
  5143   "RTN","SDC OAM",74,0)
  5144    S VALMBCK ="R"
  5145   "RTN","SDC OAM",75,0)
  5146   DCQ Q
  5147   "RTN","SDC OAM",76,0)
  5148    ;
  5149   "RTN","SDC OAM",77,0)
  5150   DIS(SDFN,S DCLN) ;Dis charge fro m Clinic
  5151   "RTN","SDC OAM",78,0)
  5152    N SDAMERR
  5153   "RTN","SDC OAM",79,0)
  5154    D ^SDCD
  5155   "RTN","SDC OAM",80,0)
  5156    I $D(SDAM ERR) D PAU SE^VALM1
  5157   "RTN","SDC OAM",81,0)
  5158    Q
  5159   "RTN","SDC OAM",82,0)
  5160    ;
  5161   "RTN","SDC OAM",83,0)
  5162   DEL ;Entry  point for  SDAM DELE TE CHECK O UT protoco l
  5163   "RTN","SDC OAM",84,0)
  5164    I '$D(^XU SEC("SD SU PERVISOR", DUZ)) W !! ,*7,">>> Y ou must ha ve the 'SD  SUPERVISO R' key to  delete an  appointmen t check ou t." D PAUS E^VALM1 S  VALMBCK="R " G DELQ
  5165   "RTN","SDC OAM",85,0)
  5166    N DFN,SDC L,SDCOAP,S DDA,SDOE,S DT,VALMY,V ALSTP
  5167   "RTN","SDC OAM",86,0)
  5168    S VALMBCK ="",VALSTP ="" ;VALST P is used  in scdxhld r to ident ify delete s
  5169   "RTN","SDC OAM",87,0)
  5170    D EN^VALM 2(XQORNOD( 0))
  5171   "RTN","SDC OAM",88,0)
  5172    D FULL^VA LM1
  5173   "RTN","SDC OAM",89,0)
  5174    S SDCOAP= 0
  5175   "RTN","SDC OAM",90,0)
  5176    F  S SDCO AP=$O(VALM Y(SDCOAP))  Q:'SDCOAP   D
  5177   "RTN","SDC OAM",91,0)
  5178    .I $D(^TM P("SDAMIDX ",$J,SDCOA P)) K SDAT  S SDAT=^( SDCOAP) D
  5179   "RTN","SDC OAM",92,0)
  5180    ..W !!,^T MP("SDAM", $J,+SDAT,0 )
  5181   "RTN","SDC OAM",93,0)
  5182    ..S DFN=+ $P(SDAT,"^ ",2),SDT=+ $P(SDAT,"^ ",3),SDCL= +$P(SDAT," ^",4),SDDA =$$FIND^SD AM2(DFN,SD T,SDCL)
  5183   "RTN","SDC OAM",94,0)
  5184    ..S SDOE= +$P($G(^DP T(DFN,"S", SDT,0)),"^ ",20)
  5185   "RTN","SDC OAM",95,0)
  5186    ..I 'SDOE !('$$CODT^ SDCOU(DFN, SDT,SDCL))  W !!,*7," >>> The ap pointment  must have  a check ou t date/tim e to delet e." D PAUS E^VALM1 Q
  5187   "RTN","SDC OAM",96,0)
  5188    ..I $$MSG ^SDMXFLAG( SDCL) H 3  Q  ; SD/67 6
  5189   "RTN","SDC OAM",97,0)
  5190    ..I '$$AS K Q
  5191   "RTN","SDC OAM",98,0)
  5192    ..N SDATA ,SDELHDL
  5193   "RTN","SDC OAM",99,0)
  5194    ..IF '$$E DITOK^SDCO 3(SDOE,1)  Q
  5195   "RTN","SDC OAM",100,0 )
  5196    ..S SDELH DL=$$HANDL E^SDAMEVT( 1)
  5197   "RTN","SDC OAM",101,0 )
  5198    ..D EN^SD CODEL(SDOE ,1,SDELHDL ),PAUSE^VA LM1
  5199   "RTN","SDC OAM",102,0 )
  5200    ..D BLD^S DAM
  5201   "RTN","SDC OAM",103,0 )
  5202    ..S SDOE= $$GETAPT^S DVSIT2(DFN ,SDT,SDCL)
  5203   "RTN","SDC OAM",104,0 )
  5204    S VALMBCK ="R"
  5205   "RTN","SDC OAM",105,0 )
  5206    K SDAT
  5207   "RTN","SDC OAM",106,0 )
  5208   DELQ Q
  5209   "RTN","SDC OAM",107,0 )
  5210    ;
  5211   "RTN","SDC OAM",108,0 )
  5212   ASK() ;Ask  if user i s sure the y want to  delete the  check out
  5213   "RTN","SDC OAM",109,0 )
  5214    N DIR,DTO UT,DUOUT,Y
  5215   "RTN","SDC OAM",110,0 )
  5216    W !!,*7," >>> Deleti ng the app ointment c heck out w ill also d elete any  check out  related",! ?4,"inform ation.  Th is informa tion may i nclude cla ssificatio ns, proced ures,",!?4 ,"provider s and diag noses."
  5217   "RTN","SDC OAM",111,0 )
  5218    S DIR("A" )="Are you  sure you  want to de lete the a ppointment  check out "
  5219   "RTN","SDC OAM",112,0 )
  5220    S DIR("B" )="NO",DIR (0)="Y" W  ! D ^DIR
  5221   "RTN","SDC OAM",113,0 )
  5222    Q +$G(Y)
  5223   "RTN","SDM ")
  5224   0^24^B3667 8428
  5225   "RTN","SDM ",1,0)
  5226   SDM ;SF/GF T,ALB/BOK  - MAKE AN  APPOINTMEN T ; 22 Jul  2016  4:3 3 PM
  5227   "RTN","SDM ",2,0)
  5228    ;;5.3;Sch eduling;** 15,32,38,4 1,44,79,94 ,167,168,2 18,223,250 ,254,296,3 80,478,441 ,619,676** ;Aug 13, 1 993;Build  99
  5229   "RTN","SDM ",3,0)
  5230    ;                                               If de fined...
  5231   "RTN","SDM ",4,0)
  5232    ; appt mg t vars:  S DFN := DFN  of patien t....will  not be ask ed
  5233   "RTN","SDM ",5,0)
  5234    ;                 SD CLN := ifn  of clinic .....will  not be ask ed    
  5235   "RTN","SDM ",6,0)
  5236    ;               SDAM ERR := ret urned if e rror occur s
  5237   "RTN","SDM ",7,0)
  5238    ; 
  5239   "RTN","SDM ",8,0)
  5240    ; Referen ce to LANG DEL^DGRPE  supported  by DBIA #6 405
  5241   "RTN","SDM ",9,0)
  5242    ; Referen ce to ^DPT (DFN,.207)  supported  by DBIA # 6406
  5243   "RTN","SDM ",10,0)
  5244    ;
  5245   "RTN","SDM ",11,0)
  5246    S:'$D(SDM M) SDMM=0
  5247   "RTN","SDM ",12,0)
  5248   EN1 L  W ! ! D I^SDUT L I '$D(SD CLN) S DIC ="^SC(",DI C(0)="AEMZ Q",DIC("A" )="Select  CLINIC: ", DIC("S")=" I $P(^(0), U,3)=""C"" ,'$G(^(""O OS""))" D  ^DIC K DIC  G:Y<0!'$D (^("SL"))  END
  5249   "RTN","SDM ",13,0)
  5250    N SDRES S :$D(SDCLN)  Y=+SDCLN  S SDRES=$$ CLNCK^SDUT L2(+Y,1)
  5251   "RTN","SDM ",14,0)
  5252    I 'SDRES  W !,?5,"Cl inic MUST  be correct ed before  continuing ." G END:$ D(SDCLN),S DM
  5253   "RTN","SDM ",15,0)
  5254    I $$MSG^S DMXFLAG(+Y ) G END:$D (SDCLN),SD M          ;SD/676
  5255   "RTN","SDM ",16,0)
  5256    K SDAPTYP ,SDIN,SDRE ,SDXXX S:$ D(SDCLN) Y =+SDCLN
  5257   "RTN","SDM ",17,0)
  5258    S TMPYCLN C=Y,STPCOD =$P($G(^SC (+TMPYCLNC ,0)),U,7)  ;SD/478
  5259   "RTN","SDM ",18,0)
  5260    I $D(^SC( +Y,"I")) S  SDIN=+^(" I"),SDRE=+ $P(^("I"), U,2)
  5261   "RTN","SDM ",19,0)
  5262    K SDINA I  $D(SDIN), SDIN S SDI NA=SDIN K  SDIN
  5263   "RTN","SDM ",20,0)
  5264    I $D(SD), $D(SC),+Y' =+SC K SD
  5265   "RTN","SDM ",21,0)
  5266    S SL=$G(^ SC(+Y,"SL" )),X=$P(SL ,U,3),STAR TDAY=$S($L (X):X,1:8) ,SC=Y,SB=S TARTDAY-1/ 100,X=$P(S L,U,6),HSI =$S(X=1:X, X:X,1:4),S I=$S(X="": 4,X<3:4,X: X,1:4),STR ="#@!$* XX WVUTSRQPON MLKJIHGFED CBA0123456 789jklmnop qrstuvwxyz ",SDDIF=$S (HSI<3:8/H SI,1:2) K  Y
  5267   "RTN","SDM ",22,0)
  5268    I $D(^SC( +SC,"SDPRO T")),$P(^( "SDPROT"), U)="Y",'$D (^SC(+SC," SDPRIV",DU Z)) W !,*7 ,"Access t o ",$$CNAM (+SC)," is  prohibite d!",!,"Onl y users wi th a speci al code ma y access t his clinic .",*7 S:$D (SDCLN) SD AMERR="" G  END:$D(SD CLN),SDM
  5269   "RTN","SDM ",23,0)
  5270    D CS^SDM1 A S SDW="" ,WY="Y"
  5271   "RTN","SDM ",24,0)
  5272    I '$D(ORA CTION),'$D (SDFN) S ( DIC,DIE)=" ^DPT(",DIC (0)="AQZME " D ^DIC S  DFN=+Y G: Y<0 END:$D (SDCLN),^S DM0:X[U,SD M
  5273   "RTN","SDM ",25,0)
  5274    S:$D(SDFN ) DFN=SDFN
  5275   "RTN","SDM ",26,0)
  5276    I $D(^DPT (DFN,.35)) ,$P(^(.35) ,U)]"" W ! ?10,*7,"PA TIENT HAS  DIED." S:$ D(SDFN) SD AMERR="" G  END:$D(SD FN),SDM
  5277   "RTN","SDM ",27,0)
  5278    D ^SDM4 I  $S('$D(CO LLAT):1,CO LLAT=7:1,1 :0) G:$D(S DCLN) END  G SDM
  5279   "RTN","SDM ",28,0)
  5280    ;-- get s ub-categor y for appo intment ty pe
  5281   "RTN","SDM ",29,0)
  5282    S SDXSCAT =$$SUB^DGS AUTL(SDAPT YP,2,"")
  5283   "RTN","SDM ",30,0)
  5284    K SDXXX D  EN G END: $D(SDCLN), SDM
  5285   "RTN","SDM ",31,0)
  5286   EN K SDMLT 1 W:$P(VAE L(9),U,2)] "" !!,?15, "MEANS TES T STATUS:  ",$P(VAEL( 9),U,2),!
  5287   "RTN","SDM ",32,0)
  5288    ; *** sck , mt block ing remove d
  5289   "RTN","SDM ",33,0)
  5290    ;S X="EAS MTCHK" X ^ %ZOSF("TES T") I $T,$ $MT^EASMTC HK(DFN,+$G (SDAPTYP), "M") S SDA MERR="" Q
  5291   "RTN","SDM ",34,0)
  5292    S Y=DFN,Y (0)=^DPT(D FN,0) I VA DM(7)]"" W  !?3,*7,VA DM(7)
  5293   "RTN","SDM ",35,0)
  5294    I $D(^DGS (41.1,"B", DFN)) F I= 0:0 S I=$O (^DGS(41.1 ,"B",DFN,I )) Q:I'>0   I $P(^DGS (41.1,I,0) ,U,2)'<DT& ('$P(^DGS( 41.1,I,0), U,13)) W ! ,"SCHEDULE D FOR ADMI SSION ON "  S Y=$P(^( 0),U,2) D  DT^SDM0
  5295   "RTN","SDM ",36,0)
  5296   PEND S %=" " W:$O(^DP T(DFN,"S", DT))'>DT ! ,"NO PENDI NG APPOINT MENTS"
  5297   "RTN","SDM ",37,0)
  5298    I $O(^DPT (DFN,"S",D T))>DT D   G END:%<0, HELP:'%
  5299   "RTN","SDM ",38,0)
  5300    .S %=1 W  !,"DISPLAY  PENDING A PPOINTMENT S:"
  5301   "RTN","SDM ",39,0)
  5302    .D YN^DIC N
  5303   "RTN","SDM ",40,0)
  5304    .I %Y["^"  S SDMLT1= 1
  5305   "RTN","SDM ",41,0)
  5306    D:%=1
  5307   "RTN","SDM ",42,0)
  5308    .N DX,DY, SDXY,SDEND  S SDXY="S  DX=$X,DY= 0"_$S($L($ G(^%ZOSF(" XY"))):" " _^("XY"),1 :"") X SDX Y
  5309   "RTN","SDM ",43,0)
  5310    .S CN=1
  5311   "RTN","SDM ",44,0)
  5312    .F Y=DT:0  S Y=$O(^D PT(DFN,"S" ,Y)) Q:Y'> 0  I "I"[$ P(^(Y,0),U ,2) X:(($Y +4)>IOSL)  "D OUT^SDU TL X SDXY"  Q:$G(SDEN D)  D CHKS O W:$X>9 !  W CN,".", ?4 D DT^SD M0 W ?23 S  DA=+SSC W  SDLN,$S($ D(^SC(DA,0 )):$P(^(0) ,U),1:"DEL ETED CLINI C "),COV,"   ",SDAT16  D
  5313   "RTN","SDM ",45,0)
  5314    ..S CNIEN =0 F  S CN IEN=$O(^SC (+SSC,"S", HY,1,CNIEN )) Q:'+CNI EN  S CNPA T=$P($G(^S C(+SSC,"S" ,HY,1,CNIE N,0)),U) I  CNPAT=DFN  W:+$G(^SC (+SSC,"S", HY,1,CNIEN ,"CONS"))  " Consult  Appt." S C N=CN+1 Q   ;SD/478
  5315   "RTN","SDM ",46,0)
  5316    ;Prompt f or ETHNICI TY if no v alue on fi le
  5317   "RTN","SDM ",47,0)
  5318    I '$O(^DP T(DFN,.06, 0)) D
  5319   "RTN","SDM ",48,0)
  5320    .S DA=DFN ,DR="6ETHN ICITY",DIE ="^DPT("
  5321   "RTN","SDM ",49,0)
  5322    .S DR(2,2 .06)=".01E THNICITY"
  5323   "RTN","SDM ",50,0)
  5324    .D ^DIE K  DR
  5325   "RTN","SDM ",51,0)
  5326    ;Prompt f or RACE if  no value  on file
  5327   "RTN","SDM ",52,0)
  5328    I '$O(^DP T(DFN,.02, 0)) D
  5329   "RTN","SDM ",53,0)
  5330    .S DA=DFN ,DR="2RACE ",DIE="^DP T("
  5331   "RTN","SDM ",54,0)
  5332    .S DR(2,2 .02)=".01R ACE"
  5333   "RTN","SDM ",55,0)
  5334    .D ^DIE K  DR
  5335   "RTN","SDM ",56,0)
  5336    ;Prompt f or Languag e if no va lue on fil e ;*///*
  5337   "RTN","SDM ",57,0)
  5338    I '$O(^DP T(DFN,.207 ,0)) D
  5339   "RTN","SDM ",58,0)
  5340    .S DA=DFN ,DIE="^DPT (",DR="7LA NGUAGE DAT E/TIME;",D R(2,2.07)= ".02//ENGL ISH"
  5341   "RTN","SDM ",59,0)
  5342    .D ^DIE K  DR
  5343   "RTN","SDM ",60,0)
  5344    .D LANGDE L^DGRPE ;  check if n o language  entered
  5345   "RTN","SDM ",61,0)
  5346    I $S('$D( ^DPT(DFN,. 11)):1,$P( ^(.11),U)= "":1,1:0)  N FLG S FL G(1)=1 D E N^DGREGAED (DFN,.FLG)
  5347   "RTN","SDM ",62,0)
  5348    Q:$D(SDXX X)
  5349   "RTN","SDM ",63,0)
  5350   E S Y=$P(S L,U,5)
  5351   "RTN","SDM ",64,0)
  5352    S SDW=""  I $D(^DPT( DFN,.1)) S  SDW=^(.1)  W !,"NOTE  - PATIENT  IS NOW IN  WARD "_SD W
  5353   "RTN","SDM ",65,0)
  5354    Q:$D(SDXX X)
  5355   "RTN","SDM ",66,0)
  5356   EN2 F X=0: 0 S X=$O(^ DPT(DFN,"D E",X)) Q:' $D(^(+X,0) )  I ^(0)- SC=0!'(^(0 )-Y) F XX= 0:0 S XX=$ O(^DPT(DFN ,"DE",X,1, XX)) Q:XX< 1  S SDDIS =$P(^(XX,0 ),U,3) I ' SDDIS D:'$ D(SDMULT)  A^SDCNSLT  G ^SDM0
  5357   "RTN","SDM ",67,0)
  5358    I '$D(^SC (+Y,0)) S  Y=+SC
  5359   "RTN","SDM ",68,0)
  5360    S Y=$P(^S C(Y,0),U)
  5361   "RTN","SDM ",69,0)
  5362    ; SCRESTA  = Array o f pt's tea ms causing  restricte d consults
  5363   "RTN","SDM ",70,0)
  5364    N SCRESTA
  5365   "RTN","SDM ",71,0)
  5366    S SCREST= $$RESTPT^S CAPMCU4(DF N,DT,"SCRE STA")
  5367   "RTN","SDM ",72,0)
  5368    IF SCREST  D
  5369   "RTN","SDM ",73,0)
  5370    .N SCTM
  5371   "RTN","SDM ",74,0)
  5372    . S SCCLN M=Y
  5373   "RTN","SDM ",75,0)
  5374    . W !,?5, "Patient h as restric ted consul ts due to  team assig nment(s):"
  5375   "RTN","SDM ",76,0)
  5376    .S SCTM=0
  5377   "RTN","SDM ",77,0)
  5378    .F  S SCT M=$O(SCRES TA(SCTM))  Q:'SCTM  W  !,?10,SCR ESTA(SCTM)
  5379   "RTN","SDM ",78,0)
  5380    IF SCREST &'$G(SCOKC ONS) D  Q
  5381   "RTN","SDM ",79,0)
  5382    .W !,?5," This patie nt may onl y be given  appointme nts and en rolled in  clinics vi a"
  5383   "RTN","SDM ",80,0)
  5384    .W !,?15, "Make Cons ult Appoin tment Opti on, and"
  5385   "RTN","SDM ",81,0)
  5386    .W !,?15, "Edit Clin ic Enrollm ent Data o ption"
  5387   "RTN","SDM ",82,0)
  5388    D:$G(SCRE ST) MAIL^S CMCCON(DFN ,.SCCLNM,2 ,DT,"SCRES TA")
  5389   "RTN","SDM ",83,0)
  5390    K DR,SCRE ST,SCCLNM
  5391   "RTN","SDM ",84,0)
  5392    D:'$D(SDM ULT) ^SDCN SLT ;SD/47 8
  5393   "RTN","SDM ",85,0)
  5394    G ^SDM0
  5395   "RTN","SDM ",86,0)
  5396    ;
  5397   "RTN","SDM ",87,0)
  5398   CHKSO S CO V=$S($P(^D PT(DFN,"S" ,Y,0),U,11 )=1:" (COL LATERAL)", 1:""),HY=Y ,SSC=^(0), SDAT16=$S( $D(^SD(409 .1,+$P(SSC ,U,16),0)) :$P(^(0),U ),1:"")
  5399   "RTN","SDM ",88,0)
  5400    F SDJ=3,4 ,5 I $P(^D PT(DFN,"S" ,HY,0),U,S DJ)]"" S Y =$P(^(0),U ,SDJ) W:$X >9 ! W ?10 ,"*" D DT^ SDM0 W ?32 ,$S(SDJ=3: "LAB",SDJ= 4:"XRAY",1 :"EKG")
  5401   "RTN","SDM ",89,0)
  5402    S SDLN=""  F J=0:0 S  J=$O(^SC( +SSC,"S",H Y,1,J)) Q: 'J  I $D(^ (J,0)),+^( 0)=DFN S S DLN="("_$P (^(0),U,2) _" MIN) "  Q
  5403   "RTN","SDM ",90,0)
  5404    S Y=HY Q
  5405   "RTN","SDM ",91,0)
  5406    ;
  5407   "RTN","SDM ",92,0)
  5408   END D KVAR ^VADPT K S DAPTYP,SDS C,%,%DT,AS KC,COV,DA, DIC,DIE,DP ,DR,HEY,HS I,HY,J,SB, SC,SDDIF,S DJ,SDLN,SD 17,SDMAX,S DU,SDYC,SI ,SL,SSC,ST ARTDAY,STR
  5409   "RTN","SDM ",93,0)
  5410    K WY,X,XX ,Y,S,SD,SD AP16,SDEDT ,SDTY,SM,S S,ST,ARG,C CX,CCXN,HX ,I,PXR,SDI NA,SDW,COL LAT,SDDIS  I $D(SDMM)  K:'SDMM S DMM
  5411   "RTN","SDM ",94,0)
  5412    K A,CC,CL NIEN,CN,CN IEN,CNPAT, CNSLTLNK,C NSULT,CNT, CONS,CPRST AT,CW,DSH, DTENTR,DTI N,DTLMT,DT R,ND,P8,PR OC,PT,PTIE N,PTNM,RTM P,NOSHOW,S CPTTM,SD1, SDAMSCN,SD ATE,SDDOT, SDII,SDINC ,SDINCM,SD LEN,SDNS,S DSI,SDST,S DSTR,SDSTR TDT
  5413   "RTN","SDM ",95,0)
  5414    K SDXSCAT ,SENDER,SE RVICE,SRV, STATUS,STP COD,TMP,TM PYCLNC,TYP E
  5415   "RTN","SDM ",96,0)
  5416    I '$D(SDM LT) K SDML T1
  5417   "RTN","SDM ",97,0)
  5418    Q
  5419   "RTN","SDM ",98,0)
  5420    ;
  5421   "RTN","SDM ",99,0)
  5422   OERR S XQO RQUIT=1 Q: '$D(ORVP)   S DFN=+OR VP G SDM
  5423   "RTN","SDM ",100,0)
  5424    ;
  5425   "RTN","SDM ",101,0)
  5426   HELP W !," YES - TO D ISPLAY FUT URE APPOIN TMENTS",!, "NO - FUTU RE APPOINT MENTS NOT  DISPLAYED"  G PEND
  5427   "RTN","SDM ",102,0)
  5428    ;
  5429   "RTN","SDM ",103,0)
  5430   CNAM(SDCL)  ;Return c linic name
  5431   "RTN","SDM ",104,0)
  5432    ;Input: S DCL=clinic  ien
  5433   "RTN","SDM ",105,0)
  5434    N SDX
  5435   "RTN","SDM ",106,0)
  5436    S SDX=$P( $G(^SC(+SD CL,0)),U)
  5437   "RTN","SDM ",107,0)
  5438    Q $S($L(S DX):SDX,1: "this clin ic")
  5439   "RTN","SDM ULT")
  5440   0^25^B1052 7012
  5441   "RTN","SDM ULT",1,0)
  5442   SDMULT ;AL B/TMP - MA KE MULTI-C LINIC APPO INTMENTS ;  02 Jan 20 00  6:30 P M
  5443   "RTN","SDM ULT",2,0)
  5444    ;;5.3;Sch eduling;** 63,168,380 ,478,676** ;Aug 13, 1 993;Build  99
  5445   "RTN","SDM ULT",3,0)
  5446    I '$D(DT)  D DT^SDUT L
  5447   "RTN","SDM ULT",4,0)
  5448    S IOP=$S( $D(ION):IO N,1:"HOME" ) D ^%ZIS  K SDNEXT,S DC1,IOP
  5449   "RTN","SDM ULT",5,0)
  5450   1 K SDAPTY P S SDMLT= "",DIC="^D PT(",DIC(0 )="AQZME"  D ^DIC S D FN=+Y I "^ "[X K FND  S SDNEXT=" " K SDMLT, SDAPTYP G  END^SDMULT 0
  5451   "RTN","SDM ULT",6,0)
  5452    G:Y<0 1 D  2^VADPT I  +VADM(6)  W !?10,*7, "PATIENT H AS DIED."  G 1
  5453   "RTN","SDM ULT",7,0)
  5454    S SDW=$S( '$D(^DPT(D FN,.1)):"" ,^(.1)]"": ^(.1),1:"" ),(SDMM,CO LLAT)=0
  5455   "RTN","SDM ULT",8,0)
  5456    S SDXXX=" " D EN^SDM  I $D(SDML T1) K FND  G END^SDMU LT0
  5457   "RTN","SDM ULT",9,0)
  5458    D:'$D(DT)  DT^SDUTL  S SDCT=0,S DMAX=DT K  SDC W !!," YOU MAY SE LECT FROM  2-4 CLINIC S",!
  5459   "RTN","SDM ULT",10,0)
  5460   RD S DIC=" ^SC(",DIC( 0)="AEMQZ" ,DIC("S")= "I $P(^(0) ,""^"",3)= ""C"",'$G( ^(""OOS"") )",DIC("A" )="Select  CLINIC: "  D ^DIC K D IC("S"),DI C("A") I X ="",SDCT>1  G START^S DMULT0
  5461   "RTN","SDM ULT",11,0)
  5462    I $S(X["^ ":1,'$D(DT OUT):0,$D( DTOUT)&DTO UT:1,1:0)  K FND G EN D^SDMULT0
  5463   "RTN","SDM ULT",12,0)
  5464    I $D(SDNE XT) S SDMA X=DT G:X]" " C G END^ SDMULT0
  5465   "RTN","SDM ULT",13,0)
  5466    I X']"" W  !,*7,"MUS T HAVE MOR E THAN 1 C LINIC" G R D
  5467   "RTN","SDM ULT",14,0)
  5468    N SDRES S  SDRES=$$C LNCK^SDUTL 2(+Y,1)
  5469   "RTN","SDM ULT",15,0)
  5470    I 'SDRES  W !,?5,"Cl inic MUST  be correct ed before  continuing ." G RD
  5471   "RTN","SDM ULT",16,0)
  5472    I $$MSG^S DMXFLAG(+Y ) G RD                         ;  SD/676
  5473   "RTN","SDM ULT",17,0)
  5474    G:Y'>0 RD  I $D(SDC1 (+Y)) W !, *7,"This c linic has  already be en selecte d" G RD
  5475   "RTN","SDM ULT",18,0)
  5476   C I $D(^SC (+Y,"SDPRO T")),$P(^( "SDPROT"), "^",1)="Y" ,'$D(^SC(+ Y,"SDPRIV" ,DUZ)) W ! ,*7,"Acces s to ",$$C NAM(+Y),"  is prohibi ted!",!,"O nly users  with a spe cial code  may access  this clin ic.",*7 G  RD
  5477   "RTN","SDM ULT",19,0)
  5478    I '$D(SDN EXT) S SDO K=0,SC=+Y, SDHY=Y,Y=$ S($D(^SC(S C,"SL")):$ P(^("SL"), "^",5),1:" ") K SD S  SDMULT=1 D  EN2^SDM S  Y=SDHY K  SDHY I 'SD OK W !,"CL INIC IGNOR ED!!" G RD  ;SD/478
  5479   "RTN","SDM ULT",20,0)
  5480    K SDOK I  '$D(^SC(+Y ,"SL")) W  !,"No appt  length sp ecified -  cannot boo k appts" G  RD
  5481   "RTN","SDM ULT",21,0)
  5482    S SL=^("S L"),SDL=+S L ;NAKED R EFERENCE ^ SC(IFN,"SL ")
  5483   "RTN","SDM ULT",22,0)
  5484   LEN I $P(S L,"^",2)]" " W !,"  A PPOINTMENT  LENGTH DE SIRED: ",+ SL R "// " ,X:DTIME G :$L(X)>3 L EN G:X["^"  END^SDMUL T0 I X]""  S POP=0,S= X D L^SDM1  G:POP LEN  S SDL=S
  5485   "RTN","SDM ULT",23,0)
  5486    S X2=$S($ D(^SC(+Y," SDP")):$P( ^("SDP")," ^",2),1:0) ,X1=DT D C ^%DTC S SD MAX=$S('(X -DT):SDMAX ,'(SDMAX-D T):X,X<SDM AX:X,1:SDM AX)
  5487   "RTN","SDM ULT",24,0)
  5488    I SDMAX'> DT W !,*7, $P(Y,"^",2 )," has ma x # of day s for futu re booking  undef or  = 0" G RD
  5489   "RTN","SDM ULT",25,0)
  5490    S SDC1(+Y )=$P(Y,U,2 )_"^"_SDL, SDCT=SDCT+ 1,SDC(SDCT )=Y,X2=$S( $D(^SC(+Y, "SDP")):$P (^("SDP"), "^",2),1:0 ),X1=DT D  C^%DTC S S DMAX=$S('( X-DT):SDMA X,'(SDMAX- DT):X,X<SD MAX:X,1:SD MAX)
  5491   "RTN","SDM ULT",26,0)
  5492    G DT^SDNE XT:$D(SDNE XT),START^ SDMULT0:'( SDCT#4),RD
  5493   "RTN","SDM ULT",27,0)
  5494    ;
  5495   "RTN","SDM ULT",28,0)
  5496    ;
  5497   "RTN","SDM ULT",29,0)
  5498   CNAM(SDCL)  ;Return c linic name
  5499   "RTN","SDM ULT",30,0)
  5500    ;Input: S DCL=clinic  ien
  5501   "RTN","SDM ULT",31,0)
  5502    N SDX
  5503   "RTN","SDM ULT",32,0)
  5504    S SDX=$P( $G(^SC(+SD CL,0)),U)
  5505   "RTN","SDM ULT",33,0)
  5506    Q $S($L(S DX):SDX,1: "this clin ic")
  5507   "RTN","SDM XCANC")
  5508   0^28^B5663 6473
  5509   "RTN","SDM XCANC",1,0 )
  5510   SDMXCANC ; MASS/AWS,D AP - APPOI NTMENT CAN CEL API;08 /22/017 ;2 018-05-31  14:50:23;8 .3;57S2u8Y +Z1Q952X8M y7e9D+ky76 DsDz7m9jFZ XLh5Dc=
  5511   "RTN","SDM XCANC",2,0 )
  5512    ;;5.3;Sch eduling;** 676**;AUGU ST 22,2017 ;Build 99
  5513   "RTN","SDM XCANC",3,0 )
  5514    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  5515   "RTN","SDM XCANC",4,0 )
  5516    ;  ICR#   Supported  References
  5517   "RTN","SDM XCANC",5,0 )
  5518    ;  5792   $$FIND^SDA M2
  5519   "RTN","SDM XCANC",6,0 )
  5520    ;  10103   $$NOW^XLF DT
  5521   "RTN","SDM XCANC",7,0 )
  5522    ;  2053   FILE^DIE
  5523   "RTN","SDM XCANC",8,0 )
  5524    ;  10013   ^DIK
  5525   "RTN","SDM XCANC",9,0 )
  5526    ;    1003 5    ^DPT
  5527   "RTN","SDM XCANC",10, 0)
  5528    ;  10040   ^SC
  5529   "RTN","SDM XCANC",11, 0)
  5530    Q
  5531   "RTN","SDM XCANC",12, 0)
  5532   CANCAPPT(P ATIEN,CLIN IEN,APTDTT M,CNUSER,C NREASON,CN NOTES,CONS ARY) ; Can cel an app ointment
  5533   "RTN","SDM XCANC",13, 0)
  5534    ; This is  the main  entry poin t in this  routine. W ill only c ancel appo intments
  5535   "RTN","SDM XCANC",14, 0)
  5536    ; with a  status of  "Scheduled ." This ta g was insp ired by CA NCEL^SDEC0 8.
  5537   "RTN","SDM XCANC",15, 0)
  5538    ;
  5539   "RTN","SDM XCANC",16, 0)
  5540    ; PATIEN  (I,REQ)    - Patient  IEN
  5541   "RTN","SDM XCANC",17, 0)
  5542    ; CLINIEN  (I,OPT)   - Clinic I EN (will b e looked u p if not p assed in)
  5543   "RTN","SDM XCANC",18, 0)
  5544    ; APTDTTM  (I,REQ)   - Appointm ent time ( in VistA f ormat)
  5545   "RTN","SDM XCANC",19, 0)
  5546    ; CNUSER  (I,OPT)    - User who  canceled  the appoin tment
  5547   "RTN","SDM XCANC",20, 0)
  5548    ; CNREASO N (I,OPT)  - Cancelat ion reason . Code is  from ^SD(4 09.2)
  5549   "RTN","SDM XCANC",21, 0)
  5550    ; CNNOTES  (I,OPT)   - Cancelat ion remark s
  5551   "RTN","SDM XCANC",22, 0)
  5552    ;
  5553   "RTN","SDM XCANC",23, 0)
  5554    S PATIEN= $G(PATIEN) ,CLINIEN=$ G(CLINIEN) ,APTDTTM=$ G(APTDTTM) ,CNUSER=$G (CNUSER),C NREASON=$G (CNREASON) ,CNNOTES=$ G(CNNOTES)
  5555   "RTN","SDM XCANC",24, 0)
  5556    N ERRTXT, SUCCESS,CN TYPE
  5557   "RTN","SDM XCANC",25, 0)
  5558    S (ERRTXT ,SUCCESS,C NTYPE)=""
  5559   "RTN","SDM XCANC",26, 0)
  5560    ;
  5561   "RTN","SDM XCANC",27, 0)
  5562    ; Check t he require d input pa rameters s ince these  are requi red to can cel the ap pointment
  5563   "RTN","SDM XCANC",28, 0)
  5564    I (PATIEN ="")!(APTD TTM="") D   Q 0
  5565   "RTN","SDM XCANC",29, 0)
  5566    . S ERRTX T="Missing  required  parameters "
  5567   "RTN","SDM XCANC",30, 0)
  5568    . D ERRLO G^SDMXERRO (101,ERRTX T,1) ; Log  an error  but don't  send a mes sage over  the interf ace
  5569   "RTN","SDM XCANC",31, 0)
  5570    ;
  5571   "RTN","SDM XCANC",32, 0)
  5572    ; Get the  Clinic ID  if it has n't been p assed in.
  5573   "RTN","SDM XCANC",33, 0)
  5574    I CLINIEN ="" S CLIN IEN=$$APTN ODEP^SDMXG APT(PATIEN ,APTDTTM,0 ,1)
  5575   "RTN","SDM XCANC",34, 0)
  5576    I CLINIEN ="" D  Q 0
  5577   "RTN","SDM XCANC",35, 0)
  5578    . S ERRTX T="Unable  to cancel  appointmen t. No clin ic has the  scheduled  appointme nt."
  5579   "RTN","SDM XCANC",36, 0)
  5580    . D ERRLO G^SDMXERRO (300,ERRTX T,1)
  5581   "RTN","SDM XCANC",37, 0)
  5582    ;
  5583   "RTN","SDM XCANC",38, 0)
  5584    ; Default  the cance l type if  it hasn't  been passe d in
  5585   "RTN","SDM XCANC",39, 0)
  5586    I CNREASO N'="" S CN TYPE=$P($G (^SD(409.2 ,CNREASON, 0)),"^",2)
  5587   "RTN","SDM XCANC",40, 0)
  5588    I (CNTYPE ="B")!(CNT YPE="") S  CNTYPE="C"
  5589   "RTN","SDM XCANC",41, 0)
  5590    I CNTYPE= "P" S CNTY PE="PC"
  5591   "RTN","SDM XCANC",42, 0)
  5592    ;
  5593   "RTN","SDM XCANC",43, 0)
  5594    ; Validat e paramete rs
  5595   "RTN","SDM XCANC",44, 0)
  5596    S SUCCESS =""
  5597   "RTN","SDM XCANC",45, 0)
  5598    S SUCCESS =$$VALDPAR M(PATIEN,C LINIEN,APT DTTM,CNTYP E,CNUSER,C NREASON,CN NOTES)
  5599   "RTN","SDM XCANC",46, 0)
  5600    I SUCCESS =0 Q 0 ; E rror is lo gged in ta g to suppo rt differe nt error I Ds
  5601   "RTN","SDM XCANC",47, 0)
  5602    ;
  5603   "RTN","SDM XCANC",48, 0)
  5604    ; Validat e appointm ent status
  5605   "RTN","SDM XCANC",49, 0)
  5606    S SUCCESS =""
  5607   "RTN","SDM XCANC",50, 0)
  5608    S SUCCESS =$$VALDAPT (PATIEN,AP TDTTM)
  5609   "RTN","SDM XCANC",51, 0)
  5610    I SUCCESS '="" D ERR LOG^SDMXER RO(309,SUC CESS,1) Q  0
  5611   "RTN","SDM XCANC",52, 0)
  5612    ;
  5613   "RTN","SDM XCANC",53, 0)
  5614    Q $$FILEC ANC(PATIEN ,CLINIEN,A PTDTTM,CNT YPE,CNUSER ,CNREASON, CNNOTES,.C ONSARY)
  5615   "RTN","SDM XCANC",54, 0)
  5616    ;
  5617   "RTN","SDM XCANC",55, 0)
  5618   FILECANC(P ATIEN,CLIN IEN,APTDTT M,CNTYPE,C NUSER,CNRE ASON,CNNOT ES,CONSARY ,CLINCHNG)  ; File th e data to  the databa se to canc el the app ointment
  5619   "RTN","SDM XCANC",56, 0)
  5620    ; This ta g will fil e data to  the databa se to canc el the app ointment.  We assume
  5621   "RTN","SDM XCANC",57, 0)
  5622    ; the inp ut paramet ers are al l valid pa rameters t hat match  to a valid , schedule d
  5623   "RTN","SDM XCANC",58, 0)
  5624    ; appoint ment. We w ill not pe rform vali dation on  the parame ters.
  5625   "RTN","SDM XCANC",59, 0)
  5626    ;
  5627   "RTN","SDM XCANC",60, 0)
  5628    ; PATIEN  (I,REQ)    - Patient  IEN
  5629   "RTN","SDM XCANC",61, 0)
  5630    ; CLINIEN  (I,REQ)   - Clinic I EN
  5631   "RTN","SDM XCANC",62, 0)
  5632    ; APTDTTM  (I,REQ)   - Appointm ent time ( in VistA f ormat)
  5633   "RTN","SDM XCANC",63, 0)
  5634    ; CNTYPE  (I,REQ)    - "PC" is  patient-ca nceled, "C " if clini c canceled
  5635   "RTN","SDM XCANC",64, 0)
  5636    ; CNUSER  (I,OPT)    - User who  canceled  the appoin tment
  5637   "RTN","SDM XCANC",65, 0)
  5638    ; CNREASO N (I,OPT)  - Cancelat ion reason . Code is  from ^SD(4 09.2)
  5639   "RTN","SDM XCANC",66, 0)
  5640    ; CNNOTES  (I,OPT)   - Cancelat ion remark s
  5641   "RTN","SDM XCANC",67, 0)
  5642    ; CONSARY  (I,OPT)   - Array of  consults  that were  linked.  t op node is  list of c onsults. 0  node is
  5643   "RTN","SDM XCANC",68, 0)
  5644    ;                      count of  consults,  and other  numbered  nodes are  the nth co nsult.
  5645   "RTN","SDM XCANC",69, 0)
  5646    ; CLINCHN G (I,OPT)  - Flag to  determine  if this co mes from a  clinic ch ange, so t hat we don 't cancel
  5647   "RTN","SDM XCANC",70, 0)
  5648    ;                      the sche duled stat us on the  linked con sult.
  5649   "RTN","SDM XCANC",71, 0)
  5650    ;
  5651   "RTN","SDM XCANC",72, 0)
  5652    ; Returns  1 if appo intment wa s successf ully cance led; 0 oth erwise.
  5653   "RTN","SDM XCANC",73, 0)
  5654    ;
  5655   "RTN","SDM XCANC",74, 0)
  5656    S PATIEN= $G(PATIEN) ,CLINIEN=$ G(CLINIEN) ,APTDTTM=$ G(APTDTTM) ,CNTYPE=$G (CNTYPE),C NUSER=$G(C NUSER),CNR EASON=$G(C NREASON),C NNOTES=$G( CNNOTES),C LINCHNG=$G (CLINCHNG)
  5657   "RTN","SDM XCANC",75, 0)
  5658    N SDDA,SD CPHDL,SDAT A,SDFDA,DA ,DIK,SDECI ENS,DURATI ON,ERRTXT, SUCCESS,AV AIL,OUTENC ,SCEFDA,SD EIEN
  5659   "RTN","SDM XCANC",76, 0)
  5660    S (SDDA,S DCPHDL,SDA TA,SDFDA,D A,DIK,SDEC IENS,DURAT ION,ERRTXT ,SUCCESS,A VAIL,OUTEN C,SCEFDA,S DEIEN)=""
  5661   "RTN","SDM XCANC",77, 0)
  5662    ;
  5663   "RTN","SDM XCANC",78, 0)
  5664    I (PATIEN ="")!(APTD TTM="")!(C LINIEN="")  Q 0
  5665   "RTN","SDM XCANC",79, 0)
  5666    ;
  5667   "RTN","SDM XCANC",80, 0)
  5668    ; Get the  appointme nt IFN for  the patie nt
  5669   "RTN","SDM XCANC",81, 0)
  5670    S SDDA=$$ FIND^SDAM2 (PATIEN,AP TDTTM,CLIN IEN)
  5671   "RTN","SDM XCANC",82, 0)
  5672    I SDDA=""  Q 0
  5673   "RTN","SDM XCANC",83, 0)
  5674    ;
  5675   "RTN","SDM XCANC",84, 0)
  5676    ; Get the  event han dler for t he calls t o BEFORE^S DAMEVT, AF TER^SDAMEV T, and EVT ^SDAMEVT
  5677   "RTN","SDM XCANC",85, 0)
  5678    S SDCPHDL =$$HANDLE^ SDAMEVT(1)
  5679   "RTN","SDM XCANC",86, 0)
  5680    S SDATA=S DDA_"^"_PA TIEN_"^"_A PTDTTM_"^" _CLINIEN
  5681   "RTN","SDM XCANC",87, 0)
  5682    ;
  5683   "RTN","SDM XCANC",88, 0)
  5684    D BEFORE^ SDAMEVT(.S DATA,PATIE N,APTDTTM, CLINIEN,SD DA,SDCPHDL )
  5685   "RTN","SDM XCANC",89, 0)
  5686    ;
  5687   "RTN","SDM XCANC",90, 0)
  5688    ; Update  informatio n in 2.98  file
  5689   "RTN","SDM XCANC",91, 0)
  5690    S SDECIEN S=APTDTTM_ ","_PATIEN _","
  5691   "RTN","SDM XCANC",92, 0)
  5692    ;S SDFDA( 2.98,SDECI ENS,.01)=C LINIEN
  5693   "RTN","SDM XCANC",93, 0)
  5694    S SDFDA(2 .98,SDECIE NS,"3")=CN TYPE
  5695   "RTN","SDM XCANC",94, 0)
  5696    S SDFDA(2 .98,SDECIE NS,"14")=C NUSER
  5697   "RTN","SDM XCANC",95, 0)
  5698    S SDFDA(2 .98,SDECIE NS,"15")=$ $NOW^XLFDT ()
  5699   "RTN","SDM XCANC",96, 0)
  5700    I CNREASO N'="" S SD FDA(2.98,S DECIENS,"1 6")=CNREAS ON
  5701   "RTN","SDM XCANC",97, 0)
  5702    I CNNOTES '="" S SDF DA(2.98,SD ECIENS,"17 ")=$E(CNNO TES,1,160)  ; Truncat e to 160 c hars
  5703   "RTN","SDM XCANC",98, 0)
  5704    ;
  5705   "RTN","SDM XCANC",99, 0)
  5706    ; Update  the databa se
  5707   "RTN","SDM XCANC",100 ,0)
  5708    D FILE^DI E("","SDFD A","SUCCES S")
  5709   "RTN","SDM XCANC",101 ,0)
  5710    ;
  5711   "RTN","SDM XCANC",102 ,0)
  5712    ; Update  ^GMR and ^ OR globals  if appoin tment was  scheduled  on an orde r or consu lt.
  5713   "RTN","SDM XCANC",103 ,0)
  5714    S SUCCESS =""
  5715   "RTN","SDM XCANC",104 ,0)
  5716    I ('CLINC HNG),(+$D( ^SC(CLINIE N,"S",APTD TTM,1,SDDA ,"CONS"))= 1) S SUCCE SS=$$UPCON REQ(CLINIE N,APTDTTM, CNTYPE,SDD A,CNNOTES, .CONSARY)
  5717   "RTN","SDM XCANC",105 ,0)
  5718    I SUCCESS '="" D ERR LOG^SDMXER RO(207,SUC CESS,1) Q  0
  5719   "RTN","SDM XCANC",106 ,0)
  5720    ;
  5721   "RTN","SDM XCANC",107 ,0)
  5722    ; Grab th e duration  of the ap pointment  before del eting the  data in th e ^SC glob al
  5723   "RTN","SDM XCANC",108 ,0)
  5724    S DURATIO N=$P($G(^S C(CLINIEN, "S",APTDTT M,1,SDDA,0 )),"^",2)
  5725   "RTN","SDM XCANC",109 ,0)
  5726    ;
  5727   "RTN","SDM XCANC",110 ,0)
  5728    ; Delete  data in ^S C global
  5729   "RTN","SDM XCANC",111 ,0)
  5730    S DIK="^S C("_CLINIE N_",""S"", "_APTDTTM_ ",1,"
  5731   "RTN","SDM XCANC",112 ,0)
  5732    S DA(2)=C LINIEN
  5733   "RTN","SDM XCANC",113 ,0)
  5734    S DA(1)=A PTDTTM
  5735   "RTN","SDM XCANC",114 ,0)
  5736    S DA=SDDA
  5737   "RTN","SDM XCANC",115 ,0)
  5738    D ^DIK
  5739   "RTN","SDM XCANC",116 ,0)
  5740    ;
  5741   "RTN","SDM XCANC",117 ,0)
  5742    ;
  5743   "RTN","SDM XCANC",118 ,0)
  5744    S OUTENC= $P($G(^DPT (PATIEN,"S ",APTDTTM, 0)),"^",20 )
  5745   "RTN","SDM XCANC",119 ,0)
  5746    I (OUTENC '=""),$D(^ SCE(OUTENC )) D
  5747   "RTN","SDM XCANC",120 ,0)
  5748    . S SCEIE N=OUTENC_" ,"
  5749   "RTN","SDM XCANC",121 ,0)
  5750    . I CNTYP E="C" S SC EFDA(409.6 8,SCEIEN," .12")=5 ;c ancelled b y clinic
  5751   "RTN","SDM XCANC",122 ,0)
  5752    . I CNTYP E="PC" S S CEFDA(409. 68,SCEIEN, ".12")=9 ; patient ca ncelled
  5753   "RTN","SDM XCANC",123 ,0)
  5754    . I $D(SC EFDA(409.6 8,SCEIEN," .12")) D F ILE^DIE("" ,"SCEFDA", "")
  5755   "RTN","SDM XCANC",124 ,0)
  5756    ;
  5757   "RTN","SDM XCANC",125 ,0)
  5758    ; Call th e event dr iver to se nd an HL7  message
  5759   "RTN","SDM XCANC",126 ,0)
  5760    D AFTER^S DAMEVT(.SD ATA,PATIEN ,APTDTTM,C LINIEN,SDD A,SDCPHDL)
  5761   "RTN","SDM XCANC",127 ,0)
  5762    D EVT^SDA MEVT(.SDAT A,2,0,SDCP HDL) ; SDA MEVT=2, SD MODE=0
  5763   "RTN","SDM XCANC",128 ,0)
  5764    ;
  5765   "RTN","SDM XCANC",129 ,0)
  5766    Q 1
  5767   "RTN","SDM XCANC",130 ,0)
  5768    ;
  5769   "RTN","SDM XCANC",131 ,0)
  5770   VALDPARM(P ATIEN,CLIN IEN,APTDTT M,CNTYPE,C NUSER,CNRE ASON,CNNOT ES) ; Vali date param eters
  5771   "RTN","SDM XCANC",132 ,0)
  5772    ; Determi ne if we c an cancel  the appoin tment base d on the p arameters  passed
  5773   "RTN","SDM XCANC",133 ,0)
  5774    ; into th e cancel A PI.
  5775   "RTN","SDM XCANC",134 ,0)
  5776    ;
  5777   "RTN","SDM XCANC",135 ,0)
  5778    ; PATIEN  (I,REQ)    - Patient  IEN
  5779   "RTN","SDM XCANC",136 ,0)
  5780    ; CLINIEN  (I,OPT)   - Clinic I EN (will b e looked u p if not p assed in)
  5781   "RTN","SDM XCANC",137 ,0)
  5782    ; APTDTTM  (I,REQ)   - Appointm ent time ( in VistA f ormat)
  5783   "RTN","SDM XCANC",138 ,0)
  5784    ; CNTYPE  (I,REQ)    - "PC" is  patient-ca nceled, "C " if clini c canceled
  5785   "RTN","SDM XCANC",139 ,0)
  5786    ; CNUSER  (I,REQ)    - User who  canceled  the appoin tment
  5787   "RTN","SDM XCANC",140 ,0)
  5788    ; CNREASO N (I,OPT)  - Cancelat ion reason . Code is  from ^SD(4 09.2)
  5789   "RTN","SDM XCANC",141 ,0)
  5790    ; CNNOTES  (I,OPT)   - Cancelat ion remark s
  5791   "RTN","SDM XCANC",142 ,0)
  5792    ;
  5793   "RTN","SDM XCANC",143 ,0)
  5794    ; Returns  1 if we c an cancel  the appoin tment; 0 o therwise.
  5795   "RTN","SDM XCANC",144 ,0)
  5796    ;
  5797   "RTN","SDM XCANC",145 ,0)
  5798    S PATIEN= $G(PATIEN) ,CLINIEN=$ G(CLINIEN) ,APTDTTM=$ G(APTDTTM) ,CNTYPE=$G (CNTYPE),C NUSER=$G(C NUSER),CNR EASON=$G(C NREASON),C NNOTES=$G( CNNOTES)
  5799   "RTN","SDM XCANC",146 ,0)
  5800    N TYPE,ER RTXT
  5801   "RTN","SDM XCANC",147 ,0)
  5802    S (TYPE,E RRTXT)=""
  5803   "RTN","SDM XCANC",148 ,0)
  5804    ;
  5805   "RTN","SDM XCANC",149 ,0)
  5806    ; Validat e patient
  5807   "RTN","SDM XCANC",150 ,0)
  5808    I '$D(^DP T(PATIEN))  D  Q 0
  5809   "RTN","SDM XCANC",151 ,0)
  5810    . S ERRTX T="Unable  to cancel  appointmen t. Invalid  patient."
  5811   "RTN","SDM XCANC",152 ,0)
  5812    . D ERRLO G^SDMXERRO (204,ERRTX T,1)
  5813   "RTN","SDM XCANC",153 ,0)
  5814    ;
  5815   "RTN","SDM XCANC",154 ,0)
  5816    I '$D(^SC (CLINIEN))  D  Q 0
  5817   "RTN","SDM XCANC",155 ,0)
  5818    . S ERRTX T="Unable  to cancel  appointmen t. Invalid  clinic."
  5819   "RTN","SDM XCANC",156 ,0)
  5820    . D ERRLO G^SDMXERRO (300,ERRTX T,1)
  5821   "RTN","SDM XCANC",157 ,0)
  5822    ;
  5823   "RTN","SDM XCANC",158 ,0)
  5824    I (CNREAS ON'=""),(' $D(^SD(409 .2,CNREASO N))) D  Q  0
  5825   "RTN","SDM XCANC",159 ,0)
  5826    . S ERRTX T="Unable  to cancel  appointmen t. Invalid  cancelati on reason. "
  5827   "RTN","SDM XCANC",160 ,0)
  5828    . D ERRLO G^SDMXERRO (302,ERRTX T,1)
  5829   "RTN","SDM XCANC",161 ,0)
  5830    ;
  5831   "RTN","SDM XCANC",162 ,0)
  5832    Q 1
  5833   "RTN","SDM XCANC",163 ,0)
  5834    ;
  5835   "RTN","SDM XCANC",164 ,0)
  5836   VALDAPT(PA TIEN,APTDT TM) ; Vali date appoi ntment sta tus
  5837   "RTN","SDM XCANC",165 ,0)
  5838    ; Determi ne if we c an cancel  the appoin tment base d on the s tatus of t he
  5839   "RTN","SDM XCANC",166 ,0)
  5840    ; appoint ment. Only  an appoin tment with  a status  of "Schedu led" is co nsidered
  5841   "RTN","SDM XCANC",167 ,0)
  5842    ; valid t o cancel.
  5843   "RTN","SDM XCANC",168 ,0)
  5844    ;
  5845   "RTN","SDM XCANC",169 ,0)
  5846    ; PATIEN   - Patient  IEN
  5847   "RTN","SDM XCANC",170 ,0)
  5848    ; APTDTTM  - Appoint ment time
  5849   "RTN","SDM XCANC",171 ,0)
  5850    ;
  5851   "RTN","SDM XCANC",172 ,0)
  5852    ; Returns  "" if we  can cancel  the appoi ntment; ot herwise, t he reason  the
  5853   "RTN","SDM XCANC",173 ,0)
  5854    ; appoint ment canno t be cance led will b e returned .
  5855   "RTN","SDM XCANC",174 ,0)
  5856    ;
  5857   "RTN","SDM XCANC",175 ,0)
  5858    S PATIEN= $G(PATIEN) ,APTDTTM=$ G(APTDTTM)
  5859   "RTN","SDM XCANC",176 ,0)
  5860    N APTSTS
  5861   "RTN","SDM XCANC",177 ,0)
  5862    S APTSTS= ""
  5863   "RTN","SDM XCANC",178 ,0)
  5864    ;
  5865   "RTN","SDM XCANC",179 ,0)
  5866    S APTSTS= $$APTSTAT^ SDMXGAPT(P ATIEN,APTD TTM)
  5867   "RTN","SDM XCANC",180 ,0)
  5868    ;
  5869   "RTN","SDM XCANC",181 ,0)
  5870    ; Does th e appointm ent even e xist?
  5871   "RTN","SDM XCANC",182 ,0)
  5872    I APTSTS= "" Q "Appo intment do es not exi st"
  5873   "RTN","SDM XCANC",183 ,0)
  5874    ;
  5875   "RTN","SDM XCANC",184 ,0)
  5876    ; Have we  already c anceled th e appointm ent?
  5877   "RTN","SDM XCANC",185 ,0)
  5878    ;I APTSTS ="CANCELLE D" Q "Appo intment al ready canc elled" ;Ne ed to upda te clinics  on cancel
  5879   "RTN","SDM XCANC",186 ,0)
  5880    ;
  5881   "RTN","SDM XCANC",187 ,0)
  5882    ; Has the  appointme nt already  been chec ked in?
  5883   "RTN","SDM XCANC",188 ,0)
  5884    ;I APTSTS ["CHECKED  IN" Q "App ointment a lready che cked-in"
  5885   "RTN","SDM XCANC",189 ,0)
  5886    ;
  5887   "RTN","SDM XCANC",190 ,0)
  5888    ; Has the  appointme nt already  been chec ked out?
  5889   "RTN","SDM XCANC",191 ,0)
  5890    ;I APTSTS ["CHECKED  OUT" Q "Ap pointment  already ch ecked-out"
  5891   "RTN","SDM XCANC",192 ,0)
  5892    ;
  5893   "RTN","SDM XCANC",193 ,0)
  5894    Q ""
  5895   "RTN","SDM XCANC",194 ,0)
  5896    ;
  5897   "RTN","SDM XCANC",195 ,0)
  5898   UPCONREQ(C LINIEN,APT DTTM,CNTYP E,SDDA,CNN OTES,CONSA RY) ; Upda te consult  request
  5899   "RTN","SDM XCANC",196 ,0)
  5900    ; Update  the status  of the co nsult to n o longer b e "Schedul ed" if the
  5901   "RTN","SDM XCANC",197 ,0)
  5902    ; appoint ment with  the linked  consult w as cancele d. This wi ll update  the status
  5903   "RTN","SDM XCANC",198 ,0)
  5904    ; of the  consult to  be "Activ e."
  5905   "RTN","SDM XCANC",199 ,0)
  5906    ;
  5907   "RTN","SDM XCANC",200 ,0)
  5908    ; CLINIEN  (I,OPT) -  Clinic IE N (will be  looked up  if not pa ssed in)
  5909   "RTN","SDM XCANC",201 ,0)
  5910    ; APTDTTM  (I,REQ) -  Appointme nt time (i n VistA fo rmat)
  5911   "RTN","SDM XCANC",202 ,0)
  5912    ; CNTYPE  (I,REQ)  -  "PC" is p atient-can celed, "C"  if clinic  canceled
  5913   "RTN","SDM XCANC",203 ,0)
  5914    ; SDDA (I ,REQ)    -  Appointme nt IFN
  5915   "RTN","SDM XCANC",204 ,0)
  5916    ; CNNOTES  (I,OPT) -  Cancelati on remarks
  5917   "RTN","SDM XCANC",205 ,0)
  5918    ; CONSARY  (I,OPT)   - Array of  consults  that were  linked.  t op node is  list of c onsults. 0  node is
  5919   "RTN","SDM XCANC",206 ,0)
  5920    ;                      count of  consults,  and other  numbered  nodes are  the nth co nsult.
  5921   "RTN","SDM XCANC",207 ,0)
  5922    ;
  5923   "RTN","SDM XCANC",208 ,0)
  5924    ; Returns  "" if ^GR M and ^OR  globals we re success fully upda ted; other wise,
  5925   "RTN","SDM XCANC",209 ,0)
  5926    ; the rea son the co nsult requ est wasn't  updated w ill be ret urned.
  5927   "RTN","SDM XCANC",210 ,0)
  5928    ;
  5929   "RTN","SDM XCANC",211 ,0)
  5930    S CLINIEN =$G(CLINIE N),APTDTTM =$G(APTDTT M),CNTYPE= $G(CNTYPE) ,SDDA=$G(S DDA),CNNOT ES=$G(CNNO TES)
  5931   "RTN","SDM XCANC",212 ,0)
  5932    N SDSC,SD TTM,SDWH,S DPL,TMPD,S DADM,SDADM 2,SDERR,SC LNK,CONSNO DE,ERROR
  5933   "RTN","SDM XCANC",213 ,0)
  5934    S (SDSC,S DTTM,SDWH, SDPL,TMPD, SDADM,SDAD M2,SDERR,S CLNK,CONSN ODE,ERROR) =""
  5935   "RTN","SDM XCANC",214 ,0)
  5936    ;
  5937   "RTN","SDM XCANC",215 ,0)
  5938    ; Set ass umed varia bles for c all to CAN CEL^SDCNSL T
  5939   "RTN","SDM XCANC",216 ,0)
  5940    S SDSC=CL INIEN
  5941   "RTN","SDM XCANC",217 ,0)
  5942    S SDTTM=A PTDTTM
  5943   "RTN","SDM XCANC",218 ,0)
  5944    S SDWH=CN TYPE
  5945   "RTN","SDM XCANC",219 ,0)
  5946    S SDPL=SD DA
  5947   "RTN","SDM XCANC",220 ,0)
  5948    S SDADM2= $P($G(^SC( CLINIEN,"S ",APTDTTM, 1,SDDA,0)) ,"^",7)
  5949   "RTN","SDM XCANC",221 ,0)
  5950    S TMPD=CN NOTES
  5951   "RTN","SDM XCANC",222 ,0)
  5952    S SCLNK=$ P($G(^SC(S DSC,"S",SD TTM,1,SDPL ,"CONS")), U) ; Consu lt ID
  5953   "RTN","SDM XCANC",223 ,0)
  5954    ;
  5955   "RTN","SDM XCANC",224 ,0)
  5956    I '$$INST RING^SDMXC ORE(SCLNK, $G(CONSARY ),",") D
  5957   "RTN","SDM XCANC",225 ,0)
  5958    . S CONSA RY(0)=$G(C ONSARY(0)) +1
  5959   "RTN","SDM XCANC",226 ,0)
  5960    . S CONSA RY(CONSARY (0))=SCLNK
  5961   "RTN","SDM XCANC",227 ,0)
  5962    . I $G(CO NSARY)=""  S CONSARY= SCLNK
  5963   "RTN","SDM XCANC",228 ,0)
  5964    . E  S CO NSARY=CONS ARY_","_SC LNK
  5965   "RTN","SDM XCANC",229 ,0)
  5966    ;
  5967   "RTN","SDM XCANC",230 ,0)
  5968    ; Update  the ^GMR g lobal with  the cance led appoin tment stat us
  5969   "RTN","SDM XCANC",231 ,0)
  5970    F CONSNOD E=1:1:CONS ARY(0) D
  5971   "RTN","SDM XCANC",232 ,0)
  5972    . S SCLNK =CONSARY(C ONSNODE)
  5973   "RTN","SDM XCANC",233 ,0)
  5974    . I $$CSL TAPTS^SDMX MAKE(SCLNK ,APTDTTM,C LINIEN,SDD A) Q  ; do n't update  status fo r consults  attached  to other a ppts
  5975   "RTN","SDM XCANC",234 ,0)
  5976    . S SDADM =SDADM2 ;  Cache off  value sinc e it is ki lled by CA NCEL^SDCNS LT
  5977   "RTN","SDM XCANC",235 ,0)
  5978    . D CANCE L^SDCNSLT
  5979   "RTN","SDM XCANC",236 ,0)
  5980    . ;
  5981   "RTN","SDM XCANC",237 ,0)
  5982    . I ($G(S DERR)'="") ,($G(SDERR )'["0") S  ERROR=ERRO R_$P($G(SD ERR),"^",2 )_"-" Q  ;  Return re ason consu lt request  wasn't up dated
  5983   "RTN","SDM XCANC",238 ,0)
  5984    . ;
  5985   "RTN","SDM XCANC",239 ,0)
  5986    . ; Since  the consu lt request  was succe ssfully up dated, upd ate the st atus of th e consult  in MASS by  triggerin g an updat e message
  5987   "RTN","SDM XCANC",240 ,0)
  5988    . S SCLNK =CONSARY(C ONSNODE) ;  SCLINK is  killed in  CANCEL^SD CNSLT
  5989   "RTN","SDM XCANC",241 ,0)
  5990    . D TRUPD MSG^ORMXTR (SCLNK)
  5991   "RTN","SDM XCANC",242 ,0)
  5992    ;
  5993   "RTN","SDM XCANC",243 ,0)
  5994    Q ERROR
  5995   "RTN","SDM XCANC",244 ,0)
  5996    ;;#eor#
  5997   "RTN","SDM XCHKI")
  5998   0^30^B2054 3866
  5999   "RTN","SDM XCHKI",1,0 )
  6000   SDMXCHKI ; MASS/BB -  Appointmen t Checkin  API;8/17/1 7
  6001   "RTN","SDM XCHKI",2,0 )
  6002    ;;5.3;Sch eduling;** 676**;AUGU ST 22,2017 ;Build 99
  6003   "RTN","SDM XCHKI",3,0 )
  6004    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  6005   "RTN","SDM XCHKI",4,0 )
  6006    ;  ICR#   Supported  References
  6007   "RTN","SDM XCHKI",5,0 )
  6008    ;  5792   $$FIND^SDA M2
  6009   "RTN","SDM XCHKI",6,0 )
  6010    ;  2054    DT^DILF
  6011   "RTN","SDM XCHKI",7,0 )
  6012    ;  10000   NOW^%DTC
  6013   "RTN","SDM XCHKI",8,0 )
  6014    ;  2053   FILE^DIE
  6015   "RTN","SDM XCHKI",9,0 )
  6016    ;  10040   ^SC
  6017   "RTN","SDM XCHKI",10, 0)
  6018    Q
  6019   "RTN","SDM XCHKI",11, 0)
  6020   CHKIN(PATI D,CLINID,A PPTDT,CHEC KINDT,USER DUZ) ;Chec k-in Appoi ntment API
  6021   "RTN","SDM XCHKI",12, 0)
  6022    ; SCOPE:         PUB LIC
  6023   "RTN","SDM XCHKI",13, 0)
  6024    ; DESCRIP TION:  Pub lic API to  check-in  an appoint ment in Vi stA
  6025   "RTN","SDM XCHKI",14, 0)
  6026    ; PARAMET ERS:
  6027   "RTN","SDM XCHKI",15, 0)
  6028    ; PATID ( I,REQ) - P atient IEN  (internal  VistA ID)
  6029   "RTN","SDM XCHKI",16, 0)
  6030    ; CLINID  (I,REQ) -  Clinic IEN  (internal  VistA ID
  6031   "RTN","SDM XCHKI",17, 0)
  6032    ; APPTDT  (I,REQ) -  Date and t ime of app ointment i n vista fo rmat
  6033   "RTN","SDM XCHKI",18, 0)
  6034    ; CHECKIN DT (I,REQ)  - Date an d time of  the check  in action
  6035   "RTN","SDM XCHKI",19, 0)
  6036    ; USERDUZ  (I,REQ) -  Data Entr y Clerk
  6037   "RTN","SDM XCHKI",20, 0)
  6038    ; RETURNS : success/ failure ar ray - see  CHK^XMASSC HKIN for d etails
  6039   "RTN","SDM XCHKI",21, 0)
  6040    S PATID=$ G(PATID),C LINID=$G(C LINID),APP TDT=$G(APP TDT),CHECK INDT=$G(CH ECKINDT),U SERDUZ=$G( USERDUZ)
  6041   "RTN","SDM XCHKI",22, 0)
  6042    N RET
  6043   "RTN","SDM XCHKI",23, 0)
  6044    S RET=""
  6045   "RTN","SDM XCHKI",24, 0)
  6046    D CHK(.RE T,$$FMTSTR (PATID,CLI NID,APPTDT ),CHECKIND T,USERDUZ)
  6047   "RTN","SDM XCHKI",25, 0)
  6048    Q RET
  6049   "RTN","SDM XCHKI",26, 0)
  6050   CCHKIN(PAT ID,CLINID, APPTDT) ;K ills the C heck-in no de of the  clinic glo bal, rever ting statu s to "no a ction yet" .
  6051   "RTN","SDM XCHKI",27, 0)
  6052    ;  PATID  (I,REQ) -  Patient IE N (interna l VistA ID )
  6053   "RTN","SDM XCHKI",28, 0)
  6054    ;  CLINID  (I,REQ) -  Clinic IE N (interna l VistA ID
  6055   "RTN","SDM XCHKI",29, 0)
  6056    ;  APPTDT  (I,REQ) -  Date and  time of ap pointment  in vista f ormat
  6057   "RTN","SDM XCHKI",30, 0)
  6058    S PATID=$ G(PATID),C LINID=$G(C LINID),APP TDT=$G(APP TDT)
  6059   "RTN","SDM XCHKI",31, 0)
  6060    I (PATID= "")!(CLINI D="")!(APP TDT="") Q
  6061   "RTN","SDM XCHKI",32, 0)
  6062    N APPTIEN ,OUTENC,SC EIEN,SCEFD A,MASSFDA, MASSIENS
  6063   "RTN","SDM XCHKI",33, 0)
  6064    S APPTIEN =$$FIND^SD AM2(PATID, APPTDT,CLI NID)
  6065   "RTN","SDM XCHKI",34, 0)
  6066    I APPTIEN ="" Q
  6067   "RTN","SDM XCHKI",35, 0)
  6068    ;
  6069   "RTN","SDM XCHKI",36, 0)
  6070    ; Remove  all check  in/out dat a in the " C" node
  6071   "RTN","SDM XCHKI",37, 0)
  6072    S MASSIEN S=APPTIEN_ ","_APPTDT _","_CLINI D_","
  6073   "RTN","SDM XCHKI",38, 0)
  6074    S MASSFDA (44.003,MA SSIENS,302 )="@"
  6075   "RTN","SDM XCHKI",39, 0)
  6076    S MASSFDA (44.003,MA SSIENS,303 )="@"
  6077   "RTN","SDM XCHKI",40, 0)
  6078    S MASSFDA (44.003,MA SSIENS,304 )="@"
  6079   "RTN","SDM XCHKI",41, 0)
  6080    S MASSFDA (44.003,MA SSIENS,305 )="@"
  6081   "RTN","SDM XCHKI",42, 0)
  6082    S MASSFDA (44.003,MA SSIENS,306 )="@"
  6083   "RTN","SDM XCHKI",43, 0)
  6084    S MASSFDA (44.003,MA SSIENS,309 )="@"
  6085   "RTN","SDM XCHKI",44, 0)
  6086    D FILE^DI E("","MASS FDA","")
  6087   "RTN","SDM XCHKI",45, 0)
  6088    ;Remove t he C node  which no l onger has  any data:
  6089   "RTN","SDM XCHKI",46, 0)
  6090    K ^SC(CLI NID,"S",AP PTDT,1,APP TIEN,"C")
  6091   "RTN","SDM XCHKI",47, 0)
  6092    ;
  6093   "RTN","SDM XCHKI",48, 0)
  6094    S OUTENC= $P($G(^DPT (PATID,"S" ,APPTDT,0) ),"^",20)
  6095   "RTN","SDM XCHKI",49, 0)
  6096    I (OUTENC '=""),$D(^ SCE(OUTENC )) D
  6097   "RTN","SDM XCHKI",50, 0)
  6098    . S SCEIE N=OUTENC_" ,"
  6099   "RTN","SDM XCHKI",51, 0)
  6100    . S SCEFD A(409.68,S CEIEN,".12 ")=14 ;Act ion Requir ed
  6101   "RTN","SDM XCHKI",52, 0)
  6102    . D FILE^ DIE("","SC EFDA","")
  6103   "RTN","SDM XCHKI",53, 0)
  6104    Q
  6105   "RTN","SDM XCHKI",54, 0)
  6106   FMTSTR(PAT ID,CLINID, APPTDT) ;P erforms st ring conca tenation
  6107   "RTN","SDM XCHKI",55, 0)
  6108    ;  PATID( I,REQ) - p atient IEN  (internal  VistA ID)
  6109   "RTN","SDM XCHKI",56, 0)
  6110    ;  CLINID  (I,REQ) -  clinic IE N (interna l VistA ID
  6111   "RTN","SDM XCHKI",57, 0)
  6112    ;  APPTDT  (I,REQ) -  date and  time of ap pointment  in VistA f ormat
  6113   "RTN","SDM XCHKI",58, 0)
  6114    Q $G(PATI D)_"-"_$G( CLINID)_"- "_$G(APPTD T)_";"
  6115   "RTN","SDM XCHKI",59, 0)
  6116   CHK(RET,AP PTARY,CHEC KINDT,USER DUZ) ;Set- up routine  for check -in for an  appointme nt in Vist A. Can tak e multiple  appointme nts at onc e,
  6117   "RTN","SDM XCHKI",60, 0)
  6118    ;                             b ut we migh t not need  that - cu rrently on ly doing o ne at a ti me.
  6119   "RTN","SDM XCHKI",61, 0)
  6120    ;  RET (O ,OPT) - Ou tput array  containin g the succ ess/failur e state of  attempted  check-ins .
  6121   "RTN","SDM XCHKI",62, 0)
  6122    ;                     RETurn va lue = 1 if  check-in  successful  or '99' i f appointm ent was no t checked  in
  6123   "RTN","SDM XCHKI",63, 0)
  6124    ;                     Syntax:
  6125   "RTN","SDM XCHKI",64, 0)
  6126    ;                         DFN_" -"_clinicI EN_"-"_dat e/timestam p of appt_ "-"_RETurn  value_";"
  6127   "RTN","SDM XCHKI",65, 0)
  6128    ;                     Example o f data out put (examp le represe nts the re sult of 2  checked in  appts):
  6129   "RTN","SDM XCHKI",66, 0)
  6130    ;                         RET(0 )="308165- 1218-31204 20.1215-1
  6131   "RTN","SDM XCHKI",67, 0)
  6132    ;                         RET(1 )="308165- 4569-31204 20.1030-99 "
  6133   "RTN","SDM XCHKI",68, 0)
  6134    ;  APPTAR Y (I,REQ)  - Input st ring conta ining appo intment de tails to b e checked  in. Format :
  6135   "RTN","SDM XCHKI",69, 0)
  6136    ;                      DFN_"-"_ clinic IEN _"-"_date/ timestamp  of schedul ed appt_"; "
  6137   "RTN","SDM XCHKI",70, 0)
  6138    ;  CHECKI NDT (I,REQ ) - Check  in Date/ti me
  6139   "RTN","SDM XCHKI",71, 0)
  6140    ;  USERDU Z (I,REQ)  - Data Ent ry Clerk
  6141   "RTN","SDM XCHKI",72, 0)
  6142    ;
  6143   "RTN","SDM XCHKI",73, 0)
  6144    S RET=$G( RET),APPTA RY=$G(APPT ARY),CHECK INDT=$G(CH ECKINDT),U SERDUZ=$G( USERDUZ)
  6145   "RTN","SDM XCHKI",74, 0)
  6146    N VPSCIEN ,COUNT,DFN ,VPSDT,VPS CLIN,RESUL T,APPTDATA ,U
  6147   "RTN","SDM XCHKI",75, 0)
  6148    S (VPSCIE N,COUNT,DF N,VPSDT,VP SCLIN,RESU LT,APPTDAT A)=""
  6149   "RTN","SDM XCHKI",76, 0)
  6150    S U="^"
  6151   "RTN","SDM XCHKI",77, 0)
  6152    I '+APPTA RY S RET(0 )="---99-a ppt record  not sent"  Q
  6153   "RTN","SDM XCHKI",78, 0)
  6154    F COUNT=1 :1 S APPTD ATA=$P(APP TARY,";",C OUNT) Q:AP PTDATA']""   D
  6155   "RTN","SDM XCHKI",79, 0)
  6156    . S DFN=$ P(APPTDATA ,"-")
  6157   "RTN","SDM XCHKI",80, 0)
  6158    . S VPSCL IN=$P(APPT DATA,"-",2 )
  6159   "RTN","SDM XCHKI",81, 0)
  6160    . S VPSDT =$P(APPTDA TA,"-",3)
  6161   "RTN","SDM XCHKI",82, 0)
  6162    . I '+DFN  S RET(COU NT)=APPTDA TA_"-99-pa tient DFN  not sent"  Q
  6163   "RTN","SDM XCHKI",83, 0)
  6164    . I '+VPS DT S RET(C OUNT)=APPT DATA_"-99- date/times tamp not s ent" Q
  6165   "RTN","SDM XCHKI",84, 0)
  6166    . I '+VPS CLIN S RET (COUNT)=AP PTDATA_"-9 9-clinic i dentifier  not sent"  Q
  6167   "RTN","SDM XCHKI",85, 0)
  6168    . D DT^DI LF("T",VPS DT,.VPSDT)
  6169   "RTN","SDM XCHKI",86, 0)
  6170    . S VPSCI EN=$$FIND^ SDAM2(DFN, VPSDT,VPSC LIN)
  6171   "RTN","SDM XCHKI",87, 0)
  6172    . I +VPSC IEN'>0 S R ET(COUNT)= APPTDATA_" -99-Appt n ot found."  Q
  6173   "RTN","SDM XCHKI",88, 0)
  6174    . D HDLKI LL^SDAMEVT   ;CLEAR P RE-EXISTIN G HANDLES
  6175   "RTN","SDM XCHKI",89, 0)
  6176    . N SDATA ,SDCIHDL S  SDATA=VPS CIEN_U_DFN _U_VPSDT_U _VPSCLIN,S DCIHDL=$$H ANDLE^SDAM EVT(1)  ;C ALL TO EVE NT HANDLER
  6177   "RTN","SDM XCHKI",90, 0)
  6178    . D BEFOR E^SDAMEVT( .SDATA,DFN ,VPSDT,VPS CLIN,VPSCI EN,SDCIHDL )  ;CAPTUR E CURRENT  APT DATA I N ^TMP("SD AMEVT",$J
  6179   "RTN","SDM XCHKI",91, 0)
  6180    . S RESUL T=$$CHECKI N(VPSCLIN, VPSDT,VPSC IEN,CHECKI NDT,USERDU Z)
  6181   "RTN","SDM XCHKI",92, 0)
  6182    . D AFTER ^SDAMEVT(. SDATA,DFN, VPSDT,VPSC LIN,VPSCIE N,SDCIHDL)   ;CAPTURE  CHECK-IN  DATA IN ^T MP("SDAMEV T",$J
  6183   "RTN","SDM XCHKI",93, 0)
  6184    . D EVT^S DAMEVT(.SD ATA,4,1,SD CIHDL)  ;  4 := CI EV T ,  1:= C OMPUTER MO NLOGUE   ; CALL EVT H ANDLER
  6185   "RTN","SDM XCHKI",94, 0)
  6186    . D HDLKI LL^SDAMEVT   ;CLEAR H ANDLES
  6187   "RTN","SDM XCHKI",95, 0)
  6188    . S RET(C OUNT)=APPT DATA_"-"_R ESULT
  6189   "RTN","SDM XCHKI",96, 0)
  6190    Q
  6191   "RTN","SDM XCHKI",97, 0)
  6192   CHECKIN(CL IN,DTM,CIE N,CHECKIND T,USERDUZ)  ;Update a ppropriate  fields fo r check-in  (HOSPITAL  LOCATION  file(#44).  Actually  checks pat ient in.
  6193   "RTN","SDM XCHKI",98, 0)
  6194    ;  CLIN ( I,REQ) - c linic IEN
  6195   "RTN","SDM XCHKI",99, 0)
  6196    ;  DTM (I ,REQ) - Vi stA date/t ime
  6197   "RTN","SDM XCHKI",100 ,0)
  6198    ;  CIEN ( I,REQ) - " Contact" ( appointmen t) entry t o check in
  6199   "RTN","SDM XCHKI",101 ,0)
  6200    ;  CHECKI NDT (I,REQ ) - Check  in Date/ti me
  6201   "RTN","SDM XCHKI",102 ,0)
  6202    ;  USERDU Z (I,REQ)  - Data Ent ry Clerk
  6203   "RTN","SDM XCHKI",103 ,0)
  6204    S CLIN=$G (CLIN),DTM =$G(DTM),C IEN=$G(CIE N),CHECKIN DT=$G(CHEC KINDT),USE RDUZ=$G(US ERDUZ)
  6205   "RTN","SDM XCHKI",104 ,0)
  6206    I ($G(CIE N)="")!($G (DTM)="")! ($G(CLIN)= "") Q 0
  6207   "RTN","SDM XCHKI",105 ,0)
  6208    N VPSFDA, VERR,USERF ILE
  6209   "RTN","SDM XCHKI",106 ,0)
  6210    S (VPSFDA ,USERFILE) =""
  6211   "RTN","SDM XCHKI",107 ,0)
  6212    N %,VPSNO W D NOW^%D TC S VPSNO W=%
  6213   "RTN","SDM XCHKI",108 ,0)
  6214    S VPSFDA( 44.003,CIE N_","_DTM_ ","_CLIN_" ,",309)=CH ECKINDT  ; PATIENT MU LTIPLE/APP OINTMENT M ULTIPLE OF  HOSPITAL  LOCATION F ILE
  6215   "RTN","SDM XCHKI",109 ,0)
  6216    D FILE^DI E("","VPSF DA","VERR" )
  6217   "RTN","SDM XCHKI",110 ,0)
  6218    S USERFIL E(44.003,C IEN_","_DT M_","_CLIN _",",302)= USERDUZ  ; File Check  In DUZ
  6219   "RTN","SDM XCHKI",111 ,0)
  6220    D FILE^DI E("","USER FILE","VER R")
  6221   "RTN","SDM XCHKI",112 ,0)
  6222    I $D(VERR ) Q "99-AP PT COULD N OT BE CHEC KED IN" ;
  6223   "RTN","SDM XCHKI",113 ,0)
  6224    Q 1
  6225   "RTN","SDM XCHKO")
  6226   0^29^B1959 7023
  6227   "RTN","SDM XCHKO",1,0 )
  6228   SDMXCHKO ; MASS/JMM -  APPOINTME NT CHECKOU T API;8/24 /17
  6229   "RTN","SDM XCHKO",2,0 )
  6230    ;;5.3;Sch eduling;** 676**;AUGU ST 22,2017 ;Build 99
  6231   "RTN","SDM XCHKO",3,0 )
  6232    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  6233   "RTN","SDM XCHKO",4,0 )
  6234    ;  ICR#   Supported
  6235   "RTN","SDM XCHKO",5,0 )
  6236    ;  5729   $$FIND^SDA M2
  6237   "RTN","SDM XCHKO",6,0 )
  6238    ;  2053   FILE^DIE
  6239   "RTN","SDM XCHKO",7,0 )
  6240    ;
  6241   "RTN","SDM XCHKO",8,0 )
  6242    Q
  6243   "RTN","SDM XCHKO",9,0 )
  6244   CHKOUT(PAT IENTIEN,CL INICIEN,AP PTDT,CHKOU TDT,USERDU Z) ;Check  out appoin tment API
  6245   "RTN","SDM XCHKO",10, 0)
  6246    ;  PATIEN TIEN (I,RE Q) - Patie nt IEN
  6247   "RTN","SDM XCHKO",11, 0)
  6248    ;  CLINIC IEN (I,REQ ) - Clinic  IEN
  6249   "RTN","SDM XCHKO",12, 0)
  6250    ;  APPTDT  (I,REQ) -  appointme nt date/ti me in VA D T format
  6251   "RTN","SDM XCHKO",13, 0)
  6252    ;  CHKOUT DT (I,REQ)  - check o ut date/ti me in VA D T format
  6253   "RTN","SDM XCHKO",14, 0)
  6254    ;  USERDU Z  (I,REQ)  - user ID
  6255   "RTN","SDM XCHKO",15, 0)
  6256    N RESULT, SDUZ,SDMOD E,SDEVENT, SDROOT,SDM ODE,SDRET, ENCIEN,ERR COUNT,USER FILE,VERR, CTRL,VPSCI EN,SDERROO T,SDVIEN,U
  6257   "RTN","SDM XCHKO",16, 0)
  6258    S (RESULT ,SDUZ,SDMO DE,SDEVENT ,SDROOT,SD MODE,SDRET ,ENCIEN,ER RCOUNT,USE RFILE,VERR ,CTRL,VPSC IEN,SDERRO OT,SDVIEN, U)=""
  6259   "RTN","SDM XCHKO",17, 0)
  6260    S PATIENT IEN=$G(PAT IENTIEN),C LINICIEN=$ G(CLINICIE N),APPTDT= $G(APPTDT) ,CHKOUTDT= $G(CHKOUTD T),USERDUZ =$G(USERDU Z)
  6261   "RTN","SDM XCHKO",18, 0)
  6262    ;Validate  Inputs
  6263   "RTN","SDM XCHKO",19, 0)
  6264    I PATIENT IEN="" Q 0   ;Quit if  no patien t
  6265   "RTN","SDM XCHKO",20, 0)
  6266    I CLINICI EN="" Q 0   ;Quit if  no clinic
  6267   "RTN","SDM XCHKO",21, 0)
  6268    I APPTDT= "" Q 0  ;Q uit if no  appt d/t
  6269   "RTN","SDM XCHKO",22, 0)
  6270    I CHKOUTD T="" Q 0   ;Quit if n o checkout  d/t
  6271   "RTN","SDM XCHKO",23, 0)
  6272    ;Setup Ev ent and Ro ot Arrays
  6273   "RTN","SDM XCHKO",24, 0)
  6274    S SDMODE= 0
  6275   "RTN","SDM XCHKO",25, 0)
  6276    S U="^"
  6277   "RTN","SDM XCHKO",26, 0)
  6278    S SDEVENT =$NA(SDEVE NT)
  6279   "RTN","SDM XCHKO",27, 0)
  6280    S SDROOT= $NA(SDEVEN T)
  6281   "RTN","SDM XCHKO",28, 0)
  6282    S @SDEVEN T@("EVENT" )="CHECK-O UT"
  6283   "RTN","SDM XCHKO",29, 0)
  6284    S @SDROOT @("EVENT") ="CHECK-OU T"
  6285   "RTN","SDM XCHKO",30, 0)
  6286    S @SDROOT @("DATE/TI ME")=CHKOU TDT
  6287   "RTN","SDM XCHKO",31, 0)
  6288    S @SDROOT @("USER")= USERDUZ
  6289   "RTN","SDM XCHKO",32, 0)
  6290    D INIT^SD API(PATIEN TIEN,APPTD T,CLINICIE N,.SDEVENT ,.SDROOT,. SDMODE,.SD RET,.SDUZ)
  6291   "RTN","SDM XCHKO",33, 0)
  6292    I $$ERRCH K^SDAPIER( ) D  Q 0   ;Communica te interna lly-logged  vista err ors up to  MASS
  6293   "RTN","SDM XCHKO",34, 0)
  6294    . S ERRCO UNT=$G(@SD ERROOT@("E RROR"))
  6295   "RTN","SDM XCHKO",35, 0)
  6296    . F CTRL= 1:1:ERRCOU NT D
  6297   "RTN","SDM XCHKO",36, 0)
  6298    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=1 D  ERRLOG^SDM XERRO(201, "No event  data",1)
  6299   "RTN","SDM XCHKO",37, 0)
  6300    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=2 D  ERRLOG^SDM XERRO(204, "Invalid P atient ID" ,1)
  6301   "RTN","SDM XCHKO",38, 0)
  6302    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=3 D  ERRLOG^SDM XERRO(308, "Invalid U ser ID",1)
  6303   "RTN","SDM XCHKO",39, 0)
  6304    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=4 D  ERRLOG^SDM XERRO(300, "Invalid C linic ID", 1)
  6305   "RTN","SDM XCHKO",40, 0)
  6306    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=5 D  ERRLOG^SDM XERRO(305, "Invalid E ncounter I D",1)
  6307   "RTN","SDM XCHKO",41, 0)
  6308    . . E  D  ERRLOG^SDM XERRO(207, $G(@SDERRO OT@("ERROR ",CTRL)),1 )
  6309   "RTN","SDM XCHKO",42, 0)
  6310    S SDMODE= 0  ;0-Non- interactiv e, 1-Inter active
  6311   "RTN","SDM XCHKO",43, 0)
  6312    S ENCIEN= $$EN^SDAPI AP(PATIENT IEN,APPTDT ,CLINICIEN ,SDUZ,SDMO DE,.SDVIEN )
  6313   "RTN","SDM XCHKO",44, 0)
  6314    I $$ERRCH K^SDAPIER( ) D  Q 0   ;Communica te interna lly-logged  vista err ors up to  MASS
  6315   "RTN","SDM XCHKO",45, 0)
  6316    . S ERRCO UNT=$G(@SD ERROOT@("E RROR"))
  6317   "RTN","SDM XCHKO",46, 0)
  6318    . F CTRL= 1:1:ERRCOU NT D
  6319   "RTN","SDM XCHKO",47, 0)
  6320    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=100! $P($G(@SDE RROOT@("ER ROR",CTRL) ),"^",1)=1 02 D ERRLO G^SDMXERRO (307,"Inva lid Checko ut D/T",1)
  6321   "RTN","SDM XCHKO",48, 0)
  6322    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=101  D ERRLOG^S DMXERRO(20 4,"Invalid  Patient I D",1)
  6323   "RTN","SDM XCHKO",49, 0)
  6324    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=103  D ERRLOG^S DMXERRO(30 9,"Current  status wo n't allow  checking-o ut",1)
  6325   "RTN","SDM XCHKO",50, 0)
  6326    . . I $P( $G(@SDERRO OT@("ERROR ",CTRL))," ^",1)=104  D ERRLOG^S DMXERRO(30 7,"Appoint ment date  is after t oday",1)
  6327   "RTN","SDM XCHKO",51, 0)
  6328    . . E  D  ERRLOG^SDM XERRO(207, $G(@SDERRO OT@("ERROR ",CTRL)),1 )
  6329   "RTN","SDM XCHKO",52, 0)
  6330    ;S RESULT =$$FINAL^S DAPI(ENCIE N)  this c onditional ly deleted  data from  the encou nter. No l onger doin g that.
  6331   "RTN","SDM XCHKO",53, 0)
  6332    S VPSCIEN =$$FIND^SD AM2(PATIEN TIEN,APPTD T,CLINICIE N)
  6333   "RTN","SDM XCHKO",54, 0)
  6334    S USERFIL E(44.003,V PSCIEN_"," _APPTDT_", "_CLINICIE N_",",304) =USERDUZ   ;File Chec k Out DUZ
  6335   "RTN","SDM XCHKO",55, 0)
  6336    D FILE^DI E("","USER FILE","VER R")
  6337   "RTN","SDM XCHKO",56, 0)
  6338    Q RESULT   ;Returns  encounter  IEN and st atus
  6339   "RTN","SDM XCHKO",57, 0)
  6340   CHKODEL(PA TIEN,APPTD T,CLINIEN)   ;Undo a  checked-ou t appointm ent
  6341   "RTN","SDM XCHKO",58, 0)
  6342    ;  PATIEN TIEN (I,RE Q) - patie nt ien
  6343   "RTN","SDM XCHKO",59, 0)
  6344    ;  APPTDT  (I,REQ) -  vista app ointment d ate/time
  6345   "RTN","SDM XCHKO",60, 0)
  6346    N CLINLIN E,DIC,DA,X ,DLAYGO,DI E,DR,OUTEN C,SCEIEN,S CEFDA
  6347   "RTN","SDM XCHKO",61, 0)
  6348    S (CLINLI NE,DIC,DA, X,DLAYGO,D IE,DR)=""
  6349   "RTN","SDM XCHKO",62, 0)
  6350    ;Validate  Inputs
  6351   "RTN","SDM XCHKO",63, 0)
  6352    I $G(PATI EN)="" Q     ;Quit if  no patien t
  6353   "RTN","SDM XCHKO",64, 0)
  6354    I $G(APPT DT)="" Q    ;Quit if  no appt d/ t
  6355   "RTN","SDM XCHKO",65, 0)
  6356    I $G(CLIN IEN)="" Q    ;quit if  no clinic
  6357   "RTN","SDM XCHKO",66, 0)
  6358    ;
  6359   "RTN","SDM XCHKO",67, 0)
  6360    ;Set up f iling data  arrays an d find if  the appoin tment alre ady exists
  6361   "RTN","SDM XCHKO",68, 0)
  6362    S CLINLIN E=$$FIND^S DAM2(PATIE N,APPTDT,C LINIEN)
  6363   "RTN","SDM XCHKO",69, 0)
  6364    I CLINLIN E="" Q
  6365   "RTN","SDM XCHKO",70, 0)
  6366    ;
  6367   "RTN","SDM XCHKO",71, 0)
  6368    ; File ch anges
  6369   "RTN","SDM XCHKO",72, 0)
  6370    S DIC="^S C("_CLINIE N_",""S"", "_APPTDT_" ,1,"
  6371   "RTN","SDM XCHKO",73, 0)
  6372    S DA(2)=C LINIEN,DA( 1)=APPTDT, X=PATIEN ; Set node l evels 2, 1  and index
  6373   "RTN","SDM XCHKO",74, 0)
  6374    S DIC("P" )="44.003P A",DIC(0)= "L",DLAYGO =44.003
  6375   "RTN","SDM XCHKO",75, 0)
  6376    S DIE=DIC
  6377   "RTN","SDM XCHKO",76, 0)
  6378    S DA=CLIN LINE  ;+Y  contains t he interna l entry nu mber of su bentry cho sen
  6379   "RTN","SDM XCHKO",77, 0)
  6380    S DR="303 ////@;304/ ///@;306// //@"
  6381   "RTN","SDM XCHKO",78, 0)
  6382    D ^DIE
  6383   "RTN","SDM XCHKO",79, 0)
  6384    ;
  6385   "RTN","SDM XCHKO",80, 0)
  6386    S OUTENC= $P($G(^DPT (PATIEN,"S ",APPTDT,0 )),"^",20)
  6387   "RTN","SDM XCHKO",81, 0)
  6388    I (OUTENC '=""),$D(^ SCE(OUTENC )) D
  6389   "RTN","SDM XCHKO",82, 0)
  6390    . S SCEIE N=OUTENC_" ,"
  6391   "RTN","SDM XCHKO",83, 0)
  6392    . S SCEFD A(409.68,S CEIEN,".12 ")=14 ;Act ion Requir ed
  6393   "RTN","SDM XCHKO",84, 0)
  6394    . S SCEFD A(409.68,S CEIEN,".07 ")="@" ;Ch eck out da te
  6395   "RTN","SDM XCHKO",85, 0)
  6396    . D FILE^ DIE("","SC EFDA","")
  6397   "RTN","SDM XCHKO",86, 0)
  6398    Q
  6399   "RTN","SDM XCORE")
  6400   0^31^B4139 5699
  6401   "RTN","SDM XCORE",1,0 )
  6402   SDMXCORE ; MASS/RPC,D AP- Core T ags;8/22/1 7
  6403   "RTN","SDM XCORE",2,0 )
  6404    ;;5.3;Sch eduling;** 676**;AUGU ST 22,2017 ;Build 99
  6405   "RTN","SDM XCORE",3,0 )
  6406    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  6407   "RTN","SDM XCORE",4,0 )
  6408    ;  ICR#   Supported
  6409   "RTN","SDM XCORE",5,0 )
  6410    ;  10103   $$HL7TFM^ XLFDT
  6411   "RTN","SDM XCORE",6,0 )
  6412    ;  10103   $$FMTHL7^ XLFDT
  6413   "RTN","SDM XCORE",7,0 )
  6414    ;  2056   $$GET1^DIQ
  6415   "RTN","SDM XCORE",8,0 )
  6416    ;  1621   ^%ZTER
  6417   "RTN","SDM XCORE",9,0 )
  6418    ;  10104   $$STRIP^X LFSTR
  6419   "RTN","SDM XCORE",10, 0)
  6420    ;    1003 5    ^DPT
  6421   "RTN","SDM XCORE",11, 0)
  6422    ;  10040   ^SC
  6423   "RTN","SDM XCORE",12, 0)
  6424    ;  ###     ^OR
  6425   "RTN","SDM XCORE",13, 0)
  6426    Q
  6427   "RTN","SDM XCORE",14, 0)
  6428   HL72VATS(H L7TS) ; Co nverts HL7  formatted  timestamp s to VA fo rmat
  6429   "RTN","SDM XCORE",15, 0)
  6430    ;  HL7TS  - date/tim e stamp in  24H HL7 f ormat (YYY YMMDDHHMMS S)
  6431   "RTN","SDM XCORE",16, 0)
  6432    Q $$HL7TF M^XLFDT($G (HL7TS))
  6433   "RTN","SDM XCORE",17, 0)
  6434   VA2HL7TS(V ATS) ; Con verts VA f ormatted t imestamps  to HL7 for mat
  6435   "RTN","SDM XCORE",18, 0)
  6436    ;  VATS -  date/time  stamp in  VA format  (YYYMMDD.H HMMSS)
  6437   "RTN","SDM XCORE",19, 0)
  6438    Q $$FMTHL 7^XLFDT($G (VATS))
  6439   "RTN","SDM XCORE",20, 0)
  6440   GETPTIEN(P ATNAME) ;  Returns pa tient ID o r null, na me must be  perfect m atch
  6441   "RTN","SDM XCORE",21, 0)
  6442    ; PATNAME  - Patient  name - mu st be exac t LAST,FIR ST
  6443   "RTN","SDM XCORE",22, 0)
  6444    N IEN
  6445   "RTN","SDM XCORE",23, 0)
  6446    I $G(PATN AME)="" Q  ""
  6447   "RTN","SDM XCORE",24, 0)
  6448    I $D(^DPT ("B",PATNA ME)) D
  6449   "RTN","SDM XCORE",25, 0)
  6450    . S IEN=$ O(^DPT("B" ,PATNAME," "))
  6451   "RTN","SDM XCORE",26, 0)
  6452    Q $G(IEN)
  6453   "RTN","SDM XCORE",27, 0)
  6454   GETPTNM(DF N) ; Retur ns patient  name from  ^DPT glob al, given  a valid DF N
  6455   "RTN","SDM XCORE",28, 0)
  6456    ; DFN - P atient ID  to look fo r
  6457   "RTN","SDM XCORE",29, 0)
  6458    N PATNAME
  6459   "RTN","SDM XCORE",30, 0)
  6460    I $G(DFN) ="" Q ""
  6461   "RTN","SDM XCORE",31, 0)
  6462    I $D(^DPT (DFN,0)) D
  6463   "RTN","SDM XCORE",32, 0)
  6464    . S PATNA ME=$P($G(^ DPT(DFN,0) ),"^",1)
  6465   "RTN","SDM XCORE",33, 0)
  6466    Q $G(PATN AME)
  6467   "RTN","SDM XCORE",34, 0)
  6468   GETLCIEN(L OCNAME) ;  Returns Lo cation ID  or null, n ame must b e perfect  match
  6469   "RTN","SDM XCORE",35, 0)
  6470    ; PATNAME  - Locatio n name - m ust be exa ct
  6471   "RTN","SDM XCORE",36, 0)
  6472    N IEN
  6473   "RTN","SDM XCORE",37, 0)
  6474    I $G(LOCN AME)="" Q  ""
  6475   "RTN","SDM XCORE",38, 0)
  6476    I $D(^SC( "B",LOCNAM E)) D
  6477   "RTN","SDM XCORE",39, 0)
  6478    . S IEN=$ O(^SC("B", LOCNAME,"" ))
  6479   "RTN","SDM XCORE",40, 0)
  6480    Q $G(IEN)
  6481   "RTN","SDM XCORE",41, 0)
  6482   GETLCNM(LO CID) ; Ret urns locat ion name f rom clinic  file 44 g iven a val id clinic  IEN
  6483   "RTN","SDM XCORE",42, 0)
  6484    ; LOCID -  Location  ID to look  for
  6485   "RTN","SDM XCORE",43, 0)
  6486    Q $$GET1^ DIQ(44,$G( LOCID),.01 )
  6487   "RTN","SDM XCORE",44, 0)
  6488   GETNMPRV(C LINIC) ; R eturns the  number of  providers  associate d with a c linic
  6489   "RTN","SDM XCORE",45, 0)
  6490    ; CLINIC  - The Clin ic IEN (fi rst piece  of DPT 0 n ode)
  6491   "RTN","SDM XCORE",46, 0)
  6492    Q $P($G(^ SC($G(CLIN IC),"PR",0 )),"^",4)  ;Piece 3 i s most rec ently assi gned numbe r, piece 4  is total  active.
  6493   "RTN","SDM XCORE",47, 0)
  6494   GETCNGNM(C LINICGROUP ) ; Return s the Name  of a Clin ic's group
  6495   "RTN","SDM XCORE",48, 0)
  6496    ; CLINICG ROUP - The  Clinic Gr oup IEN
  6497   "RTN","SDM XCORE",49, 0)
  6498    Q $P($G(^ SD(409.67, $G(CLINICG ROUP),0)), "^",1)
  6499   "RTN","SDM XCORE",50, 0)
  6500   GETPRVNM(P ROVIEN) ;  Returns th e provider  name, giv en a provi der ID
  6501   "RTN","SDM XCORE",51, 0)
  6502    ; PROVIEN  - The Pro vider IEN
  6503   "RTN","SDM XCORE",52, 0)
  6504    Q $P($G(^ VA(200,$G( PROVIEN),0 )),"^")
  6505   "RTN","SDM XCORE",53, 0)
  6506   ICLNDPRV(C LINIC,PROV IEN) ; Det ermines if  the provi der is the  default p rovider fo r the clin ic
  6507   "RTN","SDM XCORE",54, 0)
  6508    ; CLINIC  - The Clin ic IEN (fi rst piece  of DPT 0 n ode)
  6509   "RTN","SDM XCORE",55, 0)
  6510    ; PROVIEN  - The Pro vider IEN
  6511   "RTN","SDM XCORE",56, 0)
  6512    Q $P($G(^ SC($G(CLIN IC),"PR",$ $CLNPVIND( $G(CLINIC) ,$G(PROVIE N)),0)),"^ ",2)
  6513   "RTN","SDM XCORE",57, 0)
  6514   CLNPVIND(C LINIC,PROV IEN) ; Det ermines th e line num ber the pr ovider is  listed on  for a clin ic
  6515   "RTN","SDM XCORE",58, 0)
  6516    ; CLINIC  - The Clin ic IEN (fi rst piece  of DPT 0 n ode)
  6517   "RTN","SDM XCORE",59, 0)
  6518    ; PROVIEN  - The Pro vider IEN
  6519   "RTN","SDM XCORE",60, 0)
  6520    Q +$QS($Q (^SC($G(CL INIC),"PR" ,"B",$G(PR OVIEN))),5 )
  6521   "RTN","SDM XCORE",61, 0)
  6522   GTCANRSN(P ATIENTIEN, APPTDT) ;  Returns th e discrete  cancellat ion reason
  6523   "RTN","SDM XCORE",62, 0)
  6524    ; PATIEN  (I,REQ)- P atient ID  as in DPT( PATIEN,"S" ,APPTDAT
  6525   "RTN","SDM XCORE",63, 0)
  6526    ; APPTDAT  (I,REQ) -  Appointme nt date
  6527   "RTN","SDM XCORE",64, 0)
  6528    Q $P($G(^ SD(409.2,$ $APTNODEP^ SDMXGAPT($ G(PATIENTI EN),$G(APP TDT),0,15) ,0)),"^",1 )
  6529   "RTN","SDM XCORE",65, 0)
  6530   GTCNRNTP(P ATIENTIEN, APPTDT) ;  Gets the c ancelation  reason ty pe.
  6531   "RTN","SDM XCORE",66, 0)
  6532    ; PATIEN  - Patient  ID as in D PT(PATIEN, "S",APPTDA T
  6533   "RTN","SDM XCORE",67, 0)
  6534    ; APPTDAT  - Appoint ment date
  6535   "RTN","SDM XCORE",68, 0)
  6536    N VAL,CAN TYPE
  6537   "RTN","SDM XCORE",69, 0)
  6538    S CANTYPE =$$APTNODE P^SDMXGAPT ($G(PATIEN TIEN),$G(A PPTDT),0,1 5)
  6539   "RTN","SDM XCORE",70, 0)
  6540    S VAL=$P( $G(^SD(409 .2,$G(CANT YPE),0))," ^",2)
  6541   "RTN","SDM XCORE",71, 0)
  6542    Q $S($G(V AL)="B":"C ",1:$G(VAL ))
  6543   "RTN","SDM XCORE",72, 0)
  6544   ORD2CONS(O RDERID) ;R eturns the  consult I D linked t o the give n order
  6545   "RTN","SDM XCORE",73, 0)
  6546    ; ORDERID        - O rder ID
  6547   "RTN","SDM XCORE",74, 0)
  6548    N CNSLTLN K
  6549   "RTN","SDM XCORE",75, 0)
  6550    I $G(ORDE RID)="" Q  ""
  6551   "RTN","SDM XCORE",76, 0)
  6552    S CNSLTLN K=$G(^OR(1 00,ORDERID ,4))
  6553   "RTN","SDM XCORE",77, 0)
  6554    I $P(CNSL TLNK,";",2 )="GMRC" Q  $P(CNSLTL NK,";",1)
  6555   "RTN","SDM XCORE",78, 0)
  6556    Q ""
  6557   "RTN","SDM XCORE",79, 0)
  6558   INSTRING(V ALUE,LIST, DELIM) ; c ompare a s tring VALU E to see i f it is a  list given  a particu lar delimi ter
  6559   "RTN","SDM XCORE",80, 0)
  6560    ; VALUE -  VALUE to  find in th e list.
  6561   "RTN","SDM XCORE",81, 0)
  6562    ; LIST -  The list t o check
  6563   "RTN","SDM XCORE",82, 0)
  6564    ; DELIM -  Delimiter  that sepa rates the  data in th e list. De fault = ", "
  6565   "RTN","SDM XCORE",83, 0)
  6566    Q $S($G(D ELIM)="":( ","_$G(LIS T)_",")[(" ,"_$G(VALU E)_","),1: ($G(DELIM) _$G(LIST)_ $G(DELIM)) [($G(DELIM )_$G(VALUE )_$G(DELIM )))
  6567   "RTN","SDM XCORE",84, 0)
  6568   INITINC ;  Sets temp  global tha t indicate s this pro cess is fi ling an in coming mes sage
  6569   "RTN","SDM XCORE",85, 0)
  6570    S ^TMP($J ,"INCINTF" )=1
  6571   "RTN","SDM XCORE",86, 0)
  6572    Q
  6573   "RTN","SDM XCORE",87, 0)
  6574   DONEINC ;  Clears tem p global t hat indica tes this p rocess is  filing an  incoming m essage
  6575   "RTN","SDM XCORE",88, 0)
  6576    K ^TMP($J ,"INCINTF" )
  6577   "RTN","SDM XCORE",89, 0)
  6578    Q
  6579   "RTN","SDM XCORE",90, 0)
  6580   INCINTF()  ; Checks t emp global  that indi cates whet her the pr ocess is f iling an i ncoming me ssage
  6581   "RTN","SDM XCORE",91, 0)
  6582    Q +$G(^TM P($J,"INCI NTF"))
  6583   "RTN","SDM XCORE",92, 0)
  6584   SETMSGET()     ;SEND  AN ERROR M ESSAGE OUT  AND LOG T HE CACHE E RROR+STACK  TO ^ERROR S
  6585   "RTN","SDM XCORE",93, 0)
  6586    N $ETRAP
  6587   "RTN","SDM XCORE",94, 0)
  6588    S $ETRAP= "LOGSEND^S DMXCORE"
  6589   "RTN","SDM XCORE",95, 0)
  6590    Q
  6591   "RTN","SDM XCORE",96, 0)
  6592   LOGSEND()  ;
  6593   "RTN","SDM XCORE",97, 0)
  6594    S $ETRAP= "Q:$QUIT " """ Q"
  6595   "RTN","SDM XCORE",98, 0)
  6596    D ERRLOG^ SDMXERRO(3 15,"Cache  Error: "_$ ZE,1)
  6597   "RTN","SDM XCORE",99, 0)
  6598    D ^%ZTER
  6599   "RTN","SDM XCORE",100 ,0)
  6600    Q:$QUIT " " Q
  6601   "RTN","SDM XCORE",101 ,0)
  6602    Q
  6603   "RTN","SDM XCORE",102 ,0)
  6604    ;
  6605   "RTN","SDM XCORE",103 ,0)
  6606   FMTPHONE(P HONE,EXT)  ; Formats  a VistA te lephone nu mber into  an HL7-com pliant for mat
  6607   "RTN","SDM XCORE",104 ,0)
  6608    ; Formats  include:  (nnn)nnn-n nnn and nn n-nnnn, de pending on  whether o r not ther e is an ar ea code.
  6609   "RTN","SDM XCORE",105 ,0)
  6610    ; If the  number is  not in an  a valid fo rmat, does  not attem pt to do a ny formatt ing.
  6611   "RTN","SDM XCORE",106 ,0)
  6612    ; Returns  1 if the  number was  formatted , 0 otherw ise.
  6613   "RTN","SDM XCORE",107 ,0)
  6614    ;
  6615   "RTN","SDM XCORE",108 ,0)
  6616    ; PHONE -  Phone num ber to be  formatted
  6617   "RTN","SDM XCORE",109 ,0)
  6618    ; EXT   -  Phone num ber extens ion (if sp ecified)
  6619   "RTN","SDM XCORE",110 ,0)
  6620    ;
  6621   "RTN","SDM XCORE",111 ,0)
  6622    I $G(PHON E)="" Q 0
  6623   "RTN","SDM XCORE",112 ,0)
  6624    N TEMP,LE NGTH
  6625   "RTN","SDM XCORE",113 ,0)
  6626    ;
  6627   "RTN","SDM XCORE",114 ,0)
  6628    ; Extract  phone num ber
  6629   "RTN","SDM XCORE",115 ,0)
  6630    S TEMP=$$ STRIP^XLFS TR(PHONE," -()")  ; S trip certa in delimit ers
  6631   "RTN","SDM XCORE",116 ,0)
  6632    S TEMP=$T R(TEMP,"x" ,"X")             ; S tandardize  extension  delimiter
  6633   "RTN","SDM XCORE",117 ,0)
  6634    S EXT=$P( TEMP,"X",2 )                 ; P ull out th e extensio n (if it e xists)
  6635   "RTN","SDM XCORE",118 ,0)
  6636    S TEMP=$P (TEMP,"X", 1)
  6637   "RTN","SDM XCORE",119 ,0)
  6638    ;
  6639   "RTN","SDM XCORE",120 ,0)
  6640    ; Format  based on l ength
  6641   "RTN","SDM XCORE",121 ,0)
  6642    S LENGTH= $L(TEMP)
  6643   "RTN","SDM XCORE",122 ,0)
  6644    I '$$INST RING^SDMXC ORE(LENGTH ,"7,10",", ") Q 0                              ; Lengt h not 7 or  10
  6645   "RTN","SDM XCORE",123 ,0)
  6646    I LENGTH= 7 S TEMP=$ E(TEMP,1,3 )_"-"_$E(T EMP,4,7)                            ; No ar ea code: n nn-nnnn
  6647   "RTN","SDM XCORE",124 ,0)
  6648    I LENGTH= 10 S TEMP= "("_$E(TEM P,1,3)_")" _$E(TEMP,4 ,6)_"-"_$E (TEMP,7,10 )  ; Area  code: (nnn )nnn-nnnn
  6649   "RTN","SDM XCORE",125 ,0)
  6650    ;
  6651   "RTN","SDM XCORE",126 ,0)
  6652    ; Save ou tput
  6653   "RTN","SDM XCORE",127 ,0)
  6654    S PHONE=T EMP
  6655   "RTN","SDM XCORE",128 ,0)
  6656    Q 1
  6657   "RTN","SDM XCORE",129 ,0)
  6658   ESCINVLD(S EG,ESC) ;  Escapes in valid ASCI I characte rs in a si ngle segme nt
  6659   "RTN","SDM XCORE",130 ,0)
  6660    ; This wi ll also ad d the segm ent to the  current H LO message  array
  6661   "RTN","SDM XCORE",131 ,0)
  6662    ; SEG - s egment arr ay created  by the HL O package
  6663   "RTN","SDM XCORE",132 ,0)
  6664    ; ESC - s tring to r eplace unp rintable c haracters  with
  6665   "RTN","SDM XCORE",133 ,0)
  6666    I '$D(SEG ) Q
  6667   "RTN","SDM XCORE",134 ,0)
  6668    N FIELD,R EP,COMP,SU BCOMP,VALU E
  6669   "RTN","SDM XCORE",135 ,0)
  6670    S (FIELD, REP,COMP,S UBCOMP,VAL UE)=""
  6671   "RTN","SDM XCORE",136 ,0)
  6672    ;
  6673   "RTN","SDM XCORE",137 ,0)
  6674    S FIELD=0  ; SEG(0)  is the seg ment ident ifier, whi ch should  never be e scaped
  6675   "RTN","SDM XCORE",138 ,0)
  6676    F  S FIEL D=$O(SEG(F IELD)) Q:' FIELD  D
  6677   "RTN","SDM XCORE",139 ,0)
  6678    . F  S RE P=$O(SEG(F IELD,REP))  Q:'REP  D
  6679   "RTN","SDM XCORE",140 ,0)
  6680    . . F  S  COMP=$O(SE G(FIELD,RE P,COMP)) Q :'COMP  D
  6681   "RTN","SDM XCORE",141 ,0)
  6682    . . . F   S SUBCOMP= $O(SEG(FIE LD,REP,COM P,SUBCOMP) ) Q:'SUBCO MP  D
  6683   "RTN","SDM XCORE",142 ,0)
  6684    . . . . S  VALUE=SEG (FIELD,REP ,COMP,SUBC OMP)
  6685   "RTN","SDM XCORE",143 ,0)
  6686    . . . . D  CHECK(.VA LUE,$G(ESC ))
  6687   "RTN","SDM XCORE",144 ,0)
  6688    . . . . S  SEG(FIELD ,REP,COMP, SUBCOMP)=V ALUE
  6689   "RTN","SDM XCORE",145 ,0)
  6690    Q
  6691   "RTN","SDM XCORE",146 ,0)
  6692   CHECK(VALU E,ESC) ; C hecks a li ne for inv alid chara cters, and  escapes t hem where  applicable
  6693   "RTN","SDM XCORE",147 ,0)
  6694    ; VALUE -  Value to  check
  6695   "RTN","SDM XCORE",148 ,0)
  6696    ; ESC   -  Escape ch aracter st arter
  6697   "RTN","SDM XCORE",149 ,0)
  6698    N CHARNUM ,TMPVAL
  6699   "RTN","SDM XCORE",150 ,0)
  6700    I $G(VALU E)="" Q
  6701   "RTN","SDM XCORE",151 ,0)
  6702    S TMPVAL= VALUE
  6703   "RTN","SDM XCORE",152 ,0)
  6704    F CHARNUM =1:1:31 D
  6705   "RTN","SDM XCORE",153 ,0)
  6706    . I $L(CH ARNUM)=1 S  CHARNUM=" 0"_CHARNUM
  6707   "RTN","SDM XCORE",154 ,0)
  6708    . S TMPVA L=$$REPLAC E(TMPVAL,$ C(CHARNUM) ,ESC)
  6709   "RTN","SDM XCORE",155 ,0)
  6710    . S VALUE =TMPVAL
  6711   "RTN","SDM XCORE",156 ,0)
  6712    Q
  6713   "RTN","SDM XCORE",157 ,0)
  6714   REPLACE(VA LUE,CHAR,R EPLACE) ;  Replaces o ne charact er with an  escape se quence
  6715   "RTN","SDM XCORE",158 ,0)
  6716    ; VALUE -  String to  check
  6717   "RTN","SDM XCORE",159 ,0)
  6718    ; CHAR -  Character  to check
  6719   "RTN","SDM XCORE",160 ,0)
  6720    ; REPLACE  - Replace ment strin g
  6721   "RTN","SDM XCORE",161 ,0)
  6722    N I,TMPVA L,CURCHAR
  6723   "RTN","SDM XCORE",162 ,0)
  6724    S (I,TMPV AL,CURCHAR )=""
  6725   "RTN","SDM XCORE",163 ,0)
  6726    F I=1:1:$ L(VALUE) D
  6727   "RTN","SDM XCORE",164 ,0)
  6728    . S CURCH AR=$E(VALU E,I)
  6729   "RTN","SDM XCORE",165 ,0)
  6730    . S TMPVA L=TMPVAL_$ S(CURCHAR= CHAR:REPLA CE,1:CURCH AR)
  6731   "RTN","SDM XCORE",166 ,0)
  6732    Q TMPVAL
  6733   "RTN","SDM XCORE",167 ,0)
  6734   DEC2HEX(NU M) ; Given  an intege r, returns  the hexad ecimal rep resentatio n
  6735   "RTN","SDM XCORE",168 ,0)
  6736    ; NUM - i nteger
  6737   "RTN","SDM XCORE",169 ,0)
  6738    I $G(NUM) ="" Q ""
  6739   "RTN","SDM XCORE",170 ,0)
  6740    N IND,RET
  6741   "RTN","SDM XCORE",171 ,0)
  6742    S (RET,IN D)=""
  6743   "RTN","SDM XCORE",172 ,0)
  6744    F IND=1:1  S RET=$E( "012345678 9ABCDEF",N UM#16+1)_R ET,NUM=NUM \16 Q:'NUM
  6745   "RTN","SDM XCORE",173 ,0)
  6746    I $L(RET) =1 S RET=" 0"_RET
  6747   "RTN","SDM XCORE",174 ,0)
  6748    Q RET
  6749   "RTN","SDM XCORE",175 ,0)
  6750   DATALKUP(S EG,FILE,FI LEPATH,FIE LD,ERRCODE ,ERRTEXT)  ; Translat es a data  element fo r a given  fileman fi le in an H L7 field
  6751   "RTN","SDM XCORE",176 ,0)
  6752    ;          Tries usi ng the Tit le to look up the dat a. If that  fails use s the ID t o lookup
  6753   "RTN","SDM XCORE",177 ,0)
  6754    ;          the reaso n against  the title.  If that f ails tries  using the  ID agains t the ID.
  6755   "RTN","SDM XCORE",178 ,0)
  6756    ;   SEG ( I,REQ) - M essage seg ment to pa rse
  6757   "RTN","SDM XCORE",179 ,0)
  6758    ;   FILE  (I,REQ) -  Fileman Fi le to look up
  6759   "RTN","SDM XCORE",180 ,0)
  6760    ;   FILEP ATH (I,REQ ) - global  path to t he file's  storage lo cation for  DIC looku p. Make su re to end  with a com ma ^<glo>( <File>,
  6761   "RTN","SDM XCORE",181 ,0)
  6762    ;   FIELD  (I,REQ) -  message f ield to lo ok in
  6763   "RTN","SDM XCORE",182 ,0)
  6764    ;   ERRCO DE (I,OPT)  - error o n failure
  6765   "RTN","SDM XCORE",183 ,0)
  6766    ;   ERRTE XT (I,OPT)  - error t ext on fai lure
  6767   "RTN","SDM XCORE",184 ,0)
  6768    ;
  6769   "RTN","SDM XCORE",185 ,0)
  6770    ; Check R equirement s
  6771   "RTN","SDM XCORE",186 ,0)
  6772    I ($G(FIL E)="")!($G (FIELD)="" ) Q ""
  6773   "RTN","SDM XCORE",187 ,0)
  6774    ;
  6775   "RTN","SDM XCORE",188 ,0)
  6776    N ID,TITL E,DATA,X,Y ,DIC
  6777   "RTN","SDM XCORE",189 ,0)
  6778    S (ID,TIT LE,DATA,X, Y,DIC)=""
  6779   "RTN","SDM XCORE",190 ,0)
  6780    S ID=$$GE T^HLOPRS(. SEG,FIELD, 1)       ; component  1  HL7 ID  field
  6781   "RTN","SDM XCORE",191 ,0)
  6782    S TITLE=$ $GET^HLOPR S(.SEG,FIE LD,2)    ; component  2 HL7 Titl e field
  6783   "RTN","SDM XCORE",192 ,0)
  6784    I (ID="") ,(TITLE="" ) Q ""   ; No data to  translate
  6785   "RTN","SDM XCORE",193 ,0)
  6786    ;
  6787   "RTN","SDM XCORE",194 ,0)
  6788    ; Try rob ust multi  tier looku p
  6789   "RTN","SDM XCORE",195 ,0)
  6790    I TITLE'= "" S DIC=$ G(FILEPATH ),DIC(0)=" B",X=TITLE  D ^DIC S  DATA=$P(Y, "^",1)   ; lookup "B"  node with  the secon d componen t
  6791   "RTN","SDM XCORE",196 ,0)
  6792    I DATA'=" ",DATA'=-1  Q DATA
  6793   "RTN","SDM XCORE",197 ,0)
  6794    I ID'=""  d
  6795   "RTN","SDM XCORE",198 ,0)
  6796    . S DIC=$ G(FILEPATH ),DIC(0)=" B",X=ID D  ^DIC S DAT A=$P(Y,"^" ,1)   ;loo kup "B" no de with th e first co mponent
  6797   "RTN","SDM XCORE",199 ,0)
  6798    . I DATA' ="",DATA'= -1 Q
  6799   "RTN","SDM XCORE",200 ,0)
  6800    . I $$GET 1^DIQ(FILE ,ID,".01") '="" S DAT A=ID    ;c heck if th e ID match es a recor d in the F ile. if so  use it.
  6801   "RTN","SDM XCORE",201 ,0)
  6802    I DATA'=" ",DATA'=-1  Q DATA
  6803   "RTN","SDM XCORE",202 ,0)
  6804    I $G(ERRC ODE)'="" D  ERRLOG^SD MXERRO(ERR CODE,$G(ER RTEXT),1)  ;All looku ps have fa iled and d ata exists  so send a n error
  6805   "RTN","SDM XCORE",203 ,0)
  6806    Q ""
  6807   "RTN","SDM XERRO")
  6808   0^32^B4538 024
  6809   "RTN","SDM XERRO",1,0 )
  6810   SDMXERRO ; MASS/MJK -  Outgoing  Error Inte rface;08/1 7/2017
  6811   "RTN","SDM XERRO",2,0 )
  6812    ;;5.3;Sch eduling;** 676**;AUGU ST 17,2017 ;Build 99
  6813   "RTN","SDM XERRO",3,0 )
  6814    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  6815   "RTN","SDM XERRO",4,0 )
  6816    Q
  6817   "RTN","SDM XERRO",5,0 )
  6818   ERRLOG(ERR ORID,ERROR TEXT,SENDM SG) ;LOG A N ERROR TO  ^XERROR A ND OPTIONA LLY TRIGGE R ERROR IN TERFACE
  6819   "RTN","SDM XERRO",6,0 )
  6820    ; ERRORID    - Numer ic identif ier for th e error co de
  6821   "RTN","SDM XERRO",7,0 )
  6822    ; ERRORTE XT - Error  text expl aining the  issue
  6823   "RTN","SDM XERRO",8,0 )
  6824    ; SENDMSG (DEFAULT:  1)   - Set  to 1 to t rigger the  error int erface
  6825   "RTN","SDM XERRO",9,0 )
  6826    ;
  6827   "RTN","SDM XERRO",10, 0)
  6828    N OK
  6829   "RTN","SDM XERRO",11, 0)
  6830    I $G(SEND MSG)="" S  SENDMSG=1
  6831   "RTN","SDM XERRO",12, 0)
  6832    I $G(SEND MSG) S OK= $$SENDERR( "","","",$ G(ERRORID) ,$G(ERRORT EXT))
  6833   "RTN","SDM XERRO",13, 0)
  6834    Q
  6835   "RTN","SDM XERRO",14, 0)
  6836    ;
  6837   "RTN","SDM XERRO",15, 0)
  6838   SENDERR(SE GID,SEQUEN CE,FIELDPO S,ERRCODE, ERRTEXT,ER ROR) ;TRIG GER ERROR  INTERFACE
  6839   "RTN","SDM XERRO",16, 0)
  6840    ;   SEGID     - Segm ent index
  6841   "RTN","SDM XERRO",17, 0)
  6842    ;   SEQUE NCE - Segm ent sequen ce
  6843   "RTN","SDM XERRO",18, 0)
  6844    ;   FIELD POS - Fiel d Position
  6845   "RTN","SDM XERRO",19, 0)
  6846    ;   ERRCO DE  - Nume ric identi fier for t he error c ode
  6847   "RTN","SDM XERRO",20, 0)
  6848    ;   ERRTE XT  - Erro r text exp laining th e issue
  6849   "RTN","SDM XERRO",21, 0)
  6850    ;   ERROR     - Outp ut paramet er contain ing the er ror reason
  6851   "RTN","SDM XERRO",22, 0)
  6852    ;
  6853   "RTN","SDM XERRO",23, 0)
  6854    ; FROM HL O processi ng code.
  6855   "RTN","SDM XERRO",24, 0)
  6856    ;   HDR:  For incomi ng interfa ces to Vis tA that pr ocess an e rror throu gh SENDERR  the HDR v ariable wi ll hold th e header i nformation
  6857   "RTN","SDM XERRO",25, 0)
  6858    ;         for the me ssage. Thi s informat ion can be  used to g et the sou rce messag e to retur n on the e rror.
  6859   "RTN","SDM XERRO",26, 0)
  6860    ;
  6861   "RTN","SDM XERRO",27, 0)
  6862    S ERROR=$ G(ERROR)
  6863   "RTN","SDM XERRO",28, 0)
  6864    N PARMS,M SG,SEG,WHO TO
  6865   "RTN","SDM XERRO",29, 0)
  6866    S PARMS(" MESSAGE TY PE")="ACK"
  6867   "RTN","SDM XERRO",30, 0)
  6868    S PARMS(" EVENT")="N AK"
  6869   "RTN","SDM XERRO",31, 0)
  6870    ;
  6871   "RTN","SDM XERRO",32, 0)
  6872    I '$$NEWM SG^HLOAPI( .PARMS,.MS G,.ERROR)  S ERROR="C OULD NOT I NITIALIZE  MESSAGE" Q  0
  6873   "RTN","SDM XERRO",33, 0)
  6874    ;
  6875   "RTN","SDM XERRO",34, 0)
  6876    ;MSA SEGM ENT
  6877   "RTN","SDM XERRO",35, 0)
  6878    D SET^HLO API(.SEG," MSA",0)
  6879   "RTN","SDM XERRO",36, 0)
  6880    D SET^HLO API(.SEG,$ G(HDR("MES SAGE CONTR OL ID")),2 )  ;MSA-2
  6881   "RTN","SDM XERRO",37, 0)
  6882    I '$$ADDS EG^HLOAPI( .MSG,.SEG, .ERROR) S  ERROR="COU LD NOT ADD  MSA SEGME NT" Q 0
  6883   "RTN","SDM XERRO",38, 0)
  6884    ;
  6885   "RTN","SDM XERRO",39, 0)
  6886    ;ERR SEGM ENT
  6887   "RTN","SDM XERRO",40, 0)
  6888    D SET^HLO API(.SEG," ERR",0)             ; ERR-0
  6889   "RTN","SDM XERRO",41, 0)
  6890    D SET^HLO API(.SEG,$ G(SEGID),1 ,1)      ; ERR-1.1
  6891   "RTN","SDM XERRO",42, 0)
  6892    D SET^HLO API(.SEG,$ G(SEQUENCE ),1,2)   ; ERR-1.2
  6893   "RTN","SDM XERRO",43, 0)
  6894    D SET^HLO API(.SEG,$ G(FIELDPOS ),1,3)   ; ERR-1.3
  6895   "RTN","SDM XERRO",44, 0)
  6896    D SET^HLO API(.SEG,$ G(ERRCODE) ,1,4,1)  ; ERR-1.4.1
  6897   "RTN","SDM XERRO",45, 0)
  6898    D SET^HLO API(.SEG,$ G(ERRTEXT) ,1,4,2)  ; ERR-1.4.2
  6899   "RTN","SDM XERRO",46, 0)
  6900    D SET^HLO API(.SEG," HL70357",1 ,4,3)    ; ERR-1.4.3
  6901   "RTN","SDM XERRO",47, 0)
  6902    I '$$ADDS EG^HLOAPI( .MSG,.SEG, .ERROR) S  ERROR="COU LD NOT ADD  ERR SEGME NT" Q 0
  6903   "RTN","SDM XERRO",48, 0)
  6904    ;
  6905   "RTN","SDM XERRO",49, 0)
  6906    S PARMS(" SENDING AP PLICATION" )="SD-ACK- OUT"
  6907   "RTN","SDM XERRO",50, 0)
  6908    S WHOTO(" RECEIVING  APPLICATIO N")="MASS"
  6909   "RTN","SDM XERRO",51, 0)
  6910    S WHOTO(" FACILITY L INK NAME") ="SD ACK O UT"
  6911   "RTN","SDM XERRO",52, 0)
  6912    ;
  6913   "RTN","SDM XERRO",53, 0)
  6914    Q $$SENDO NE^HLOAPI1 (.MSG,.PAR MS,.WHOTO, .ERROR)
  6915   "RTN","SDM XFLAG")
  6916   0^42^B1043 5281
  6917   "RTN","SDM XFLAG",1,0 )
  6918   SDMXFLAG ; MASS/JEO -   Clinic F lag modify (cont) ;SE P 23, 2017
  6919   "RTN","SDM XFLAG",2,0 )
  6920    ;;5.3;Sch eduling;** 676**;AUGU ST 22,2017 ;Build 99
  6921   "RTN","SDM XFLAG",3,0 )
  6922    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  6923   "RTN","SDM XFLAG",4,0 )
  6924    ;
  6925   "RTN","SDM XFLAG",5,0 )
  6926    ; input:
  6927   "RTN","SDM XFLAG",6,0 )
  6928    ;         SDCL := cl inic#
  6929   "RTN","SDM XFLAG",7,0 )
  6930    ;         S:'$D(^SC( SDCL,"S"," MX"))
  6931   "RTN","SDM XFLAG",8,0 )
  6932    ;
  6933   "RTN","SDM XFLAG",9,0 )
  6934   IND N DIC, X,Y,TIUAPD T,CLID
  6935   "RTN","SDM XFLAG",10, 0)
  6936    K DIC
  6937   "RTN","SDM XFLAG",11, 0)
  6938    S DIC=44, DIC(0)="AE MO"
  6939   "RTN","SDM XFLAG",12, 0)
  6940    S DIC("A" )="Select  CLINIC://  "
  6941   "RTN","SDM XFLAG",13, 0)
  6942    D ^DIC K  DIC("S") S :+Y>0 CLID =+Y
  6943   "RTN","SDM XFLAG",14, 0)
  6944    I $G(CLID )="" G ASK CLIN
  6945   "RTN","SDM XFLAG",15, 0)
  6946    D DISPLAY (CLID)
  6947   "RTN","SDM XFLAG",16, 0)
  6948    G IND
  6949   "RTN","SDM XFLAG",17, 0)
  6950    Q
  6951   "RTN","SDM XFLAG",18, 0)
  6952    ;
  6953   "RTN","SDM XFLAG",19, 0)
  6954   ASKCLIN ;
  6955   "RTN","SDM XFLAG",20, 0)
  6956    N DIR,X,Y ,LINE
  6957   "RTN","SDM XFLAG",21, 0)
  6958    W #,!?6," MASS CLINI C FLAG UTI LITY"
  6959   "RTN","SDM XFLAG",22, 0)
  6960    W !!,"Now  you'll se lect the c linics."
  6961   "RTN","SDM XFLAG",23, 0)
  6962    S DIR(0)= "SO^A:Show  Flag for  All Clinic s;I:Show/M odify Flag  for an In dividual C linic;"
  6963   "RTN","SDM XFLAG",24, 0)
  6964    S DIR("A" )="Select  Clinics by "
  6965   "RTN","SDM XFLAG",25, 0)
  6966    S DIR("?" ,1)="Show/ Modify MAS S Flag for  Clinic."
  6967   "RTN","SDM XFLAG",26, 0)
  6968    D ^DIR
  6969   "RTN","SDM XFLAG",27, 0)
  6970    K DIR
  6971   "RTN","SDM XFLAG",28, 0)
  6972    I Y="I" G  IND
  6973   "RTN","SDM XFLAG",29, 0)
  6974    I Y="A" G  ALL
  6975   "RTN","SDM XFLAG",30, 0)
  6976    Q:Y="^"
  6977   "RTN","SDM XFLAG",31, 0)
  6978    Q
  6979   "RTN","SDM XFLAG",32, 0)
  6980    ;
  6981   "RTN","SDM XFLAG",33, 0)
  6982   ALL    ;
  6983   "RTN","SDM XFLAG",34, 0)
  6984    N IEN,CLF L,FLAG,Y,% ,%Y
  6985   "RTN","SDM XFLAG",35, 0)
  6986    W !!?5,"C LINIC NAME ",?40,"MAS S FLAG",!
  6987   "RTN","SDM XFLAG",36, 0)
  6988    W ?5,"--- --------", ?40,"----- ----",!!
  6989   "RTN","SDM XFLAG",37, 0)
  6990    S LINE=7, IEN=0,Y=1
  6991   "RTN","SDM XFLAG",38, 0)
  6992    S IEN=0
  6993   "RTN","SDM XFLAG",39, 0)
  6994    F  S IEN= $O(^SC(IEN )) Q:('IEN )!(Y=0)  D
  6995   "RTN","SDM XFLAG",40, 0)
  6996    . S CLFL= $$GETFLAG( IEN)
  6997   "RTN","SDM XFLAG",41, 0)
  6998    . S FLAG= $S(CLFL=1: "YES",CLFL =0:"NO",1: "ERROR")
  6999   "RTN","SDM XFLAG",42, 0)
  7000    . W ?5,$P (^SC(IEN,0 ),"^"),?43 ,FLAG,!
  7001   "RTN","SDM XFLAG",43, 0)
  7002    . S LINE= LINE+1
  7003   "RTN","SDM XFLAG",44, 0)
  7004    . I LINE= 22 D PAUSE ^VALM1 S L INE=0
  7005   "RTN","SDM XFLAG",45, 0)
  7006    I Y=0 G A SKCLIN
  7007   "RTN","SDM XFLAG",46, 0)
  7008    ;
  7009   "RTN","SDM XFLAG",47, 0)
  7010    Q
  7011   "RTN","SDM XFLAG",48, 0)
  7012    ;
  7013   "RTN","SDM XFLAG",49, 0)
  7014   DISPLAY(CL ID)    ; D isplays th e individu al clinic  MASS flag
  7015   "RTN","SDM XFLAG",50, 0)
  7016    ;                 an d prompt t o update i t.
  7017   "RTN","SDM XFLAG",51, 0)
  7018    N CLFL,FL AG,CLNAME, FLG,CHANGE ,%,%Y
  7019   "RTN","SDM XFLAG",52, 0)
  7020    S CLNAME= $P(^SC(CLI D,0),"^")
  7021   "RTN","SDM XFLAG",53, 0)
  7022    S CLFL=$P ($G(^SC(CL ID,"MX")), "^")
  7023   "RTN","SDM XFLAG",54, 0)
  7024    S FLAG=$S (CLFL=1:"Y ES",CLFL=0 :"NO",CLFL ="":"NOT S ET, USING  DEFAULT",1 :"ERROR")
  7025   "RTN","SDM XFLAG",55, 0)
  7026    W #,!!?5, "CLINIC NA ME",?40,"M ASS FLAG", !
  7027   "RTN","SDM XFLAG",56, 0)
  7028    W ?5,"--- --------", ?40,"----- ----",!
  7029   "RTN","SDM XFLAG",57, 0)
  7030    W !?5,CLN AME,?40,FL AG
  7031   "RTN","SDM XFLAG",58, 0)
  7032    W !!,"DO  YOU WANT T O CHANGE T HE MASS FL AG?: "
  7033   "RTN","SDM XFLAG",59, 0)
  7034    S %=2     ;default t o yes
  7035   "RTN","SDM XFLAG",60, 0)
  7036    D YN^DICN     ;Yes N o question
  7037   "RTN","SDM XFLAG",61, 0)
  7038    I %'=1 Q
  7039   "RTN","SDM XFLAG",62, 0)
  7040    ; handle  setting ne w value
  7041   "RTN","SDM XFLAG",63, 0)
  7042    W !!,"SET  THE MASS  FLAG TO YE S OR NO?:  "
  7043   "RTN","SDM XFLAG",64, 0)
  7044    S %=$S(CL FL=1:1,CLF L=0:2,1:"" )
  7045   "RTN","SDM XFLAG",65, 0)
  7046    D YN^DICN     ;Yes N o question
  7047   "RTN","SDM XFLAG",66, 0)
  7048    ;determin e if we ar e changing
  7049   "RTN","SDM XFLAG",67, 0)
  7050    S CHANGE= $S(%=1:1,% =2:0,1:"")
  7051   "RTN","SDM XFLAG",68, 0)
  7052    I CHANGE' ="",CHANGE '=CLFL D
  7053   "RTN","SDM XFLAG",69, 0)
  7054    . S $P(^S C(CLID,"MX "),"^")=CH ANGE,FLAG= $S(CHANGE= 1:"YES",CH ANGE=0:"NO ")
  7055   "RTN","SDM XFLAG",70, 0)
  7056    . W !!?5, "THE MASS  FLAG HAS B EEN UPDATE D TO ",FLA G,!
  7057   "RTN","SDM XFLAG",71, 0)
  7058    E  W !!?5 ,"THE MASS  FLAG WAS  NOT CHANGE D."
  7059   "RTN","SDM XFLAG",72, 0)
  7060    Q
  7061   "RTN","SDM XFLAG",73, 0)
  7062    ;
  7063   "RTN","SDM XFLAG",74, 0)
  7064   MSG(IEN)     ;Display s message  in the men us
  7065   "RTN","SDM XFLAG",75, 0)
  7066    N FLAG
  7067   "RTN","SDM XFLAG",76, 0)
  7068    S FLAG=$$ GETFLAG(IE N)
  7069   "RTN","SDM XFLAG",77, 0)
  7070    D:FLAG
  7071   "RTN","SDM XFLAG",78, 0)
  7072    . W !!!?1 2,"This cl inic is no  longer sc hedulable  in VistA."
  7073   "RTN","SDM XFLAG",79, 0)
  7074    . W !?12, "Please vi ew or sche dule to it  in MASS." ,!!
  7075   "RTN","SDM XFLAG",80, 0)
  7076    Q FLAG
  7077   "RTN","SDM XFLAG",81, 0)
  7078    ;
  7079   "RTN","SDM XFLAG",82, 0)
  7080   GETFLAG(IE N)    ;get s the clin ic flag. I f not set  gets the d efault.
  7081   "RTN","SDM XFLAG",83, 0)
  7082    N FLAG
  7083   "RTN","SDM XFLAG",84, 0)
  7084    I $G(IEN) ="" Q ""
  7085   "RTN","SDM XFLAG",85, 0)
  7086    S FLAG=$$ GET1^DIQ(4 4,IEN_",", 22902,"I")
  7087   "RTN","SDM XFLAG",86, 0)
  7088    I FLAG=""  S FLAG=$$ GET^XPAR(" SYS","SDMX  CLINIC RO  FLAG DEFA ULT")    ; Check Syst em level d efault
  7089   "RTN","SDM XFLAG",87, 0)
  7090    I FLAG=""  S FLAG=0
  7091   "RTN","SDM XFLAG",88, 0)
  7092    Q FLAG
  7093   "RTN","SDM XGAPT")
  7094   0^33^B3064 9074
  7095   "RTN","SDM XGAPT",1,0 )
  7096   SDMXGAPT ; MASS/RPC -  Appointme nt retriev al API;08/ 17/2017 ;2 018-05-15  12:59:56;8 .3;p5D3ea3 q2RdoVfX3p t3a2wEHdg6 w6I3WscrUy 9s1AaQ=
  7097   "RTN","SDM XGAPT",2,0 )
  7098    ;;5.3;Sch eduling;** 676**;AUGU ST 17,2017 ;Build 99
  7099   "RTN","SDM XGAPT",3,0 )
  7100    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  7101   "RTN","SDM XGAPT",4,0 )
  7102    ;  ICR#   Supported
  7103   "RTN","SDM XGAPT",5,0 )
  7104    ;  2056   $$GET1^DIQ
  7105   "RTN","SDM XGAPT",6,0 )
  7106    ;  5729   $FIND^SDAM 2
  7107   "RTN","SDM XGAPT",7,0 )
  7108    ;    1003 5    ^DPT
  7109   "RTN","SDM XGAPT",8,0 )
  7110    ;  10040   ^SC
  7111   "RTN","SDM XGAPT",9,0 )
  7112    Q
  7113   "RTN","SDM XGAPT",10, 0)
  7114   GETAPPT(PA TIEN,APPTD T,APPTARY)  ;Gets the  appointme nt details  form the  database a nd returns  it in an  array.
  7115   "RTN","SDM XGAPT",11, 0)
  7116    ;  See pa rameter de scriptions  for detai ls of the  available  nodes.
  7117   "RTN","SDM XGAPT",12, 0)
  7118    ;   PATIE N(I,REQ) -  The patie nt IEN
  7119   "RTN","SDM XGAPT",13, 0)
  7120    ;   APPTD T(I,REQ)   - the appo intment da te/time in  vista for mat.
  7121   "RTN","SDM XGAPT",14, 0)
  7122    ;                      Found in  the ^DPT( <IEN>,"S", <APPTDT> n ode.
  7123   "RTN","SDM XGAPT",15, 0)
  7124    ;   APPTA RY(O,REQ)  - Array  o f appointm ent data.
  7125   "RTN","SDM XGAPT",16, 0)
  7126    ;
  7127   "RTN","SDM XGAPT",17, 0)
  7128    ;          APPTARY(" PATIENT IE N") - IEN
  7129   "RTN","SDM XGAPT",18, 0)
  7130    ;          APPTARY(" APPTDT")   = date/tim e of the a ppointment  in VistA  format
  7131   "RTN","SDM XGAPT",19, 0)
  7132    ;          APPTARY(" APPTTYPE")  - appoint ment type
  7133   "RTN","SDM XGAPT",20, 0)
  7134    ;          APPTARY(" MADE ON DA TE") - dat e/time the  appointme nt was mad e in VistA  format.
  7135   "RTN","SDM XGAPT",21, 0)
  7136    ;          APPTARY(" CANCEL REA SON") - Ca ncellation  reason (d iscrete)
  7137   "RTN","SDM XGAPT",22, 0)
  7138    ;          APPTARY(" CANCEL REM ARK") - Ca ncellation  remark (f reetext)
  7139   "RTN","SDM XGAPT",23, 0)
  7140    ;          APPTARY(" CHECKIN DT ") - date/ time of th e check in  action
  7141   "RTN","SDM XGAPT",24, 0)
  7142    ;          APPTARY(" CHECKIN US ER") - che ck in user
  7143   "RTN","SDM XGAPT",25, 0)
  7144    ;          APPTARY(" CHECKOUT D T") - date /time of t he check o ut action
  7145   "RTN","SDM XGAPT",26, 0)
  7146    ;          APPTARY(" CHECKOUT U SER") - ch eck out us er
  7147   "RTN","SDM XGAPT",27, 0)
  7148    ;          APPTARY(" CLINIC")   = the clin ic of this  appointme nt
  7149   "RTN","SDM XGAPT",28, 0)
  7150    ;          APPTARY(" CLINIC NAM E") = Clin ic name
  7151   "RTN","SDM XGAPT",29, 0)
  7152    ;          APPTARY(" CLINIC PRO VIDER",0)  - number o f provider s on the c linic
  7153   "RTN","SDM XGAPT",30, 0)
  7154    ;          APPTARY(" CLINIC PRO VIDER",n," IEN") - Pr ovider IEN
  7155   "RTN","SDM XGAPT",31, 0)
  7156    ;          APPTARY(" CLINIC PRO VIDER",n," NAME") - N ame of pro vider
  7157   "RTN","SDM XGAPT",32, 0)
  7158    ;          APPTARY(" CLINIC PUR GED") - Fl ag to say  the clinic  has reach ed its
  7159   "RTN","SDM XGAPT",33, 0)
  7160    ;                                       pu rge days s o the data  is no lon ger availa ble.
  7161   "RTN","SDM XGAPT",34, 0)
  7162    ;          APPTARY(" CLINIC GRO UP")  - Th is is heav ily coveri ng our spe cialties.
  7163   "RTN","SDM XGAPT",35, 0)
  7164    ;          APPTARY(" COMMENT")  - Appointm ent commen t.
  7165   "RTN","SDM XGAPT",36, 0)
  7166    ;          APPTARY(" CONSULT")  - linked c onsult ID
  7167   "RTN","SDM XGAPT",37, 0)
  7168    ;          APPTARY(" COV") - Th e COV. Loo king into  what this  is.
  7169   "RTN","SDM XGAPT",38, 0)
  7170    ;          APPTARY(" DURATION")  - appoint ment durat ion
  7171   "RTN","SDM XGAPT",39, 0)
  7172    ;          APPTARY(" ENCOUNTER  IEN") - En counter ID
  7173   "RTN","SDM XGAPT",40, 0)
  7174    ;          APPTARY(" ELIGIBILIT Y")  - App ointment e ligibility  if differ ent than p rimary
  7175   "RTN","SDM XGAPT",41, 0)
  7176    ;          APPTARY(" Next Avail able") - I f the appt  was sched uled as ne xt availab le
  7177   "RTN","SDM XGAPT",42, 0)
  7178    ;          APPTARY(" PAT INDICA TED DATE")   - Date t he start o f search w as perform ed on.
  7179   "RTN","SDM XGAPT",43, 0)
  7180    ;          APPTARY(" STATUS") -  APPT stat us calcula ted to cur rent state
  7181   "RTN","SDM XGAPT",44, 0)
  7182    ;                               (SCHEDULED /CHECKED I N/CHECKED  OUT/CANCEL LED/NO-SHO W)
  7183   "RTN","SDM XGAPT",45, 0)
  7184    ;          APPTARY(" USER") - S cheduling  user
  7185   "RTN","SDM XGAPT",46, 0)
  7186    ;
  7187   "RTN","SDM XGAPT",47, 0)
  7188    N DELIM,C LNODE0,SNO DE0,CLINIC ,PROVARY,C LNODEC,CLN ODECN
  7189   "RTN","SDM XGAPT",48, 0)
  7190    K APPTARY    ;Force  output onl y paramete r
  7191   "RTN","SDM XGAPT",49, 0)
  7192    ;
  7193   "RTN","SDM XGAPT",50, 0)
  7194    I $G(PATI EN)="" Q
  7195   "RTN","SDM XGAPT",51, 0)
  7196    I $G(APPT DT)="" Q
  7197   "RTN","SDM XGAPT",52, 0)
  7198    ;
  7199   "RTN","SDM XGAPT",53, 0)
  7200    S DELIM=" ^"
  7201   "RTN","SDM XGAPT",54, 0)
  7202    S SNODE0= $$APPTNODE (PATIEN,AP PTDT,0)
  7203   "RTN","SDM XGAPT",55, 0)
  7204    I $G(SNOD E0)="" Q     ;no appo intment fo und
  7205   "RTN","SDM XGAPT",56, 0)
  7206    ;
  7207   "RTN","SDM XGAPT",57, 0)
  7208    ; Get cli nic
  7209   "RTN","SDM XGAPT",58, 0)
  7210    S CLINIC= $P(SNODE0, DELIM,1)
  7211   "RTN","SDM XGAPT",59, 0)
  7212    S CLNODE0 =$$CLINNOD E(PATIEN,A PPTDT,CLIN IC,0)
  7213   "RTN","SDM XGAPT",60, 0)
  7214    S CLNODEC =$$CLINNOD E(PATIEN,A PPTDT,CLIN IC,"C")
  7215   "RTN","SDM XGAPT",61, 0)
  7216    S CLNODEC N=$$CLINNO DE(PATIEN, APPTDT,CLI NIC,"CONS" )
  7217   "RTN","SDM XGAPT",62, 0)
  7218    ;
  7219   "RTN","SDM XGAPT",63, 0)
  7220    ; Get pro viders off  of clinic
  7221   "RTN","SDM XGAPT",64, 0)
  7222    I $G(CLIN IC)'="" D  CLINPROV(C LINIC,.PRO VARY)
  7223   "RTN","SDM XGAPT",65, 0)
  7224    ;
  7225   "RTN","SDM XGAPT",66, 0)
  7226    ; Build A rray of pa tient info rmation fr om the kno wn nodes
  7227   "RTN","SDM XGAPT",67, 0)
  7228    S APPTARY ("PATIENT  IEN")=PATI EN  ;IEN
  7229   "RTN","SDM XGAPT",68, 0)
  7230    S APPTARY ("APPTDT") =APPTDT    ;date/time  of the ap pointment  in VistA f ormat
  7231   "RTN","SDM XGAPT",69, 0)
  7232    S APPTARY ("APPTTYPE ")=$P(SNOD E0,DELIM,1 6)  ;appoi ntment typ e
  7233   "RTN","SDM XGAPT",70, 0)
  7234    S APPTARY ("CLINIC") =$G(CLINIC )    ;the  clinic of  this appoi ntment  ;
  7235   "RTN","SDM XGAPT",71, 0)
  7236    I $G(CLNO DE0)="" S  APPTARY("C LINIC PURG ED")=1
  7237   "RTN","SDM XGAPT",72, 0)
  7238    I $D(PROV ARY) M APP TARY("CLIN IC PROVIDE R")=PROVAR Y
  7239   "RTN","SDM XGAPT",73, 0)
  7240    S APPTARY ("CLINIC N AME")=$$GE T1^DIQ(44, $G(CLINIC) ,.01)
  7241   "RTN","SDM XGAPT",74, 0)
  7242    S APPTARY ("CLINIC G ROUP")=$$C LINGRP($G( CLINIC))
  7243   "RTN","SDM XGAPT",75, 0)
  7244    S APPTARY ("CLINIC G ROUP NAME" )=$$GET1^D IQ(409.67, $G(APPTARY ("CLINIC G ROUP")),.0 1)
  7245   "RTN","SDM XGAPT",76, 0)
  7246    S APPTARY ("CHECKIN  DT")=$P($G (CLNODEC), DELIM,1)
  7247   "RTN","SDM XGAPT",77, 0)
  7248    S APPTARY ("CHECKIN  USER")=$P( $G(CLNODEC ),DELIM,2)
  7249   "RTN","SDM XGAPT",78, 0)
  7250    S APPTARY ("CHECKOUT  DT")=$P($ G(CLNODEC) ,DELIM,3)
  7251   "RTN","SDM XGAPT",79, 0)
  7252    S APPTARY ("CHECKOUT  USER")=$P ($G(CLNODE C),DELIM,4 )
  7253   "RTN","SDM XGAPT",80, 0)
  7254    S APPTARY ("COMMENT" )=$P(CLNOD E0,DELIM,4 )
  7255   "RTN","SDM XGAPT",81, 0)
  7256    S APPTARY ("CONSULT" )=$$CLINNO DE(PATIEN, APPTDT,CLI NIC,"CONS" )   ;consu lt ID
  7257   "RTN","SDM XGAPT",82, 0)
  7258    S APPTARY ("COV")=$P (SNODE0,DE LIM,7)     ;The COV i f c&P/Sche duled/or w alked in
  7259   "RTN","SDM XGAPT",83, 0)
  7260    S APPTARY ("DURATION ")=$P(CLNO DE0,DELIM, 2)
  7261   "RTN","SDM XGAPT",84, 0)
  7262    s APPTARY ("ELIGIBIL ITY")=$P(C LNODE0,DEL IM,10)
  7263   "RTN","SDM XGAPT",85, 0)
  7264    S APPTARY ("PAT INDI CATED DATE ")=$$APTNO DEP(PATIEN ,APPTDT,1, 1)
  7265   "RTN","SDM XGAPT",86, 0)
  7266    ; APPT st atus - Com puted and  translated
  7267   "RTN","SDM XGAPT",87, 0)
  7268    S APPTARY ("STATUS") =$$APTSTAT (PATIEN,AP PTDT,0)
  7269   "RTN","SDM XGAPT",88, 0)
  7270    S APPTARY ("STATUS P IECE")=$P( SNODE0,DEL IM,2)       ;Status f rom the st atus node
  7271   "RTN","SDM XGAPT",89, 0)
  7272    S APPTARY ("USER")=$ P(SNODE0,D ELIM,18)       ;Sched uling user
  7273   "RTN","SDM XGAPT",90, 0)
  7274    S APPTARY ("CANCEL R EASON")=$P (SNODE0,DE LIM,15)
  7275   "RTN","SDM XGAPT",91, 0)
  7276    S APPTARY ("CANCEL R EMARK")=$$ APTNODEP(P ATIEN,APPT DT,"R",1)
  7277   "RTN","SDM XGAPT",92, 0)
  7278    S APPTARY ("MADE ON  DATE")=$P( SNODE0,DEL IM,19)
  7279   "RTN","SDM XGAPT",93, 0)
  7280    S APPTARY ("ENCOUNTE R IEN")=$P (SNODE0,DE LIM,20)
  7281   "RTN","SDM XGAPT",94, 0)
  7282    Q
  7283   "RTN","SDM XGAPT",95, 0)
  7284   APPTNODE(P ATIEN,APPT DT,NODE) ; For a give n patient  we will re turn their  appointme nt node in  the ^DPT  file.
  7285   "RTN","SDM XGAPT",96, 0)
  7286    ;   PATIE N(I,REQ) -  The patie nt IEN
  7287   "RTN","SDM XGAPT",97, 0)
  7288    ;   APPTD T(I,REQ)   - the appo intment da te/time in  vista for mat. Found  in the ^D PT(<IEN>," S",<APPTDT > node.
  7289   "RTN","SDM XGAPT",98, 0)
  7290    ;   NODE( I,REQ)  -  node numbe r to pull
  7291   "RTN","SDM XGAPT",99, 0)
  7292    ;
  7293   "RTN","SDM XGAPT",100 ,0)
  7294    I ($G(APP TDT)="")!( $G(PATIEN) ="")!($G(N ODE)="") Q  ""
  7295   "RTN","SDM XGAPT",101 ,0)
  7296    Q $G(^DPT (PATIEN,"S ",APPTDT,N ODE))
  7297   "RTN","SDM XGAPT",102 ,0)
  7298   APTNODEP(P ATIEN,APPT DT,NODE,PI ECE) ;For  a given pa tient we w ill return  a piece o f their ap pointment  node in th e ^DPT fil e.
  7299   "RTN","SDM XGAPT",103 ,0)
  7300    ;   PATIE N(I,REQ) -  The patie nt IEN
  7301   "RTN","SDM XGAPT",104 ,0)
  7302    ;   APPTD T(I,REQ)   - the appo intment da te/time in  vista for mat. Found  in the ^D PT(<IEN>," S",<APPTDT > node.
  7303   "RTN","SDM XGAPT",105 ,0)
  7304    ;   NODE( I,REQ)  -  node numbe r to pull
  7305   "RTN","SDM XGAPT",106 ,0)
  7306    ;   PIECE (I,REQ)  -  piece in  the node t o return
  7307   "RTN","SDM XGAPT",107 ,0)
  7308    ;   DATA( I,OPT) - d ata node m ay be pass ed in to b ypass extr acting.
  7309   "RTN","SDM XGAPT",108 ,0)
  7310    N DATA
  7311   "RTN","SDM XGAPT",109 ,0)
  7312    S DATA=$$ APPTNODE($ G(PATIEN), $G(APPTDT) ,$G(NODE))
  7313   "RTN","SDM XGAPT",110 ,0)
  7314    Q $P($G(D ATA),"^",$ G(PIECE))
  7315   "RTN","SDM XGAPT",111 ,0)
  7316   CLINNODE(P ATIEN,APPT DT,CLINICI EN,NODE,CO UNT) ;For  a given pa tient we w ill find t heir clini c node in  the ^SC fi le.
  7317   "RTN","SDM XGAPT",112 ,0)
  7318    ;   May n eed to loo p through  the overbo oks on tha t time.
  7319   "RTN","SDM XGAPT",113 ,0)
  7320    ;   PATIE N(I,REQ) -  The patie nt IEN
  7321   "RTN","SDM XGAPT",114 ,0)
  7322    ;   APPTD T(I,REQ)   - the appo intment da te/time in  vista for mat. Found  in the ^D PT(<IEN>," S",<APPTDT > node.
  7323   "RTN","SDM XGAPT",115 ,0)
  7324    ;   CLINI CIEN(I,REQ )  - clini c record I EN to sear ch through
  7325   "RTN","SDM XGAPT",116 ,0)
  7326    ;   NODE( I,REQ) - l ast node f or the cli nic. 0 nod e has appo intment in fo. "C" no de has che ck in/out  info.
  7327   "RTN","SDM XGAPT",117 ,0)
  7328    ;   COUNT (O,OPT) -  subscript  # of appoi ntment
  7329   "RTN","SDM XGAPT",118 ,0)
  7330    I $G(CLIN ICIEN)=""  Q ""
  7331   "RTN","SDM XGAPT",119 ,0)
  7332    N RET
  7333   "RTN","SDM XGAPT",120 ,0)
  7334    ; Loop th rough the  possibly m ultiple ap pointments  scheduled  into this  clinic sl ot
  7335   "RTN","SDM XGAPT",121 ,0)
  7336    S COUNT=$ $FIND^SDAM 2($G(PATIE N),$G(APPT DT),$G(CLI NICIEN))
  7337   "RTN","SDM XGAPT",122 ,0)
  7338    I $G(COUN T)'="" S R ET=$G(^SC( $G(CLINICI EN),"S",$G (APPTDT),1 ,COUNT,$G( NODE)))     ;Get the  node from  the SC glo bal
  7339   "RTN","SDM XGAPT",123 ,0)
  7340    Q $G(RET)
  7341   "RTN","SDM XGAPT",124 ,0)
  7342   CLINPROV(C LINIC,ARRA Y) ;Sets a n array fi lled with  clinic pro vider data
  7343   "RTN","SDM XGAPT",125 ,0)
  7344    ;  CLINIC  (I,REQ) -  The Clini c IEN (fir st piece o f DPT 0 no de)
  7345   "RTN","SDM XGAPT",126 ,0)
  7346    ;  ARRAY   (O,REQ) -  APPTARY(" CLINIC PRO VIDER",0)  - number o f provider s on the c linic
  7347   "RTN","SDM XGAPT",127 ,0)
  7348    ;                     APPTARY(" CLINIC PRO VIDER",N," IEN") - Pr ovider IEN
  7349   "RTN","SDM XGAPT",128 ,0)
  7350    ;                     APPTARY(" CLINIC PRO VIDER",N," NAME") - N ame of pro vider
  7351   "RTN","SDM XGAPT",129 ,0)
  7352    N NUM
  7353   "RTN","SDM XGAPT",130 ,0)
  7354    K ARRAY
  7355   "RTN","SDM XGAPT",131 ,0)
  7356    I $G(CLIN IC)="" Q
  7357   "RTN","SDM XGAPT",132 ,0)
  7358    S NUM=0
  7359   "RTN","SDM XGAPT",133 ,0)
  7360    S ARRAY(0 )=0
  7361   "RTN","SDM XGAPT",134 ,0)
  7362    F  S NUM= $O(^SC(CLI NIC,"PR",N UM)) Q:'NU M  D
  7363   "RTN","SDM XGAPT",135 ,0)
  7364    . S ARRAY (NUM,"IEN" )=$$PROVIE N(CLINIC,N UM) ;-Prov ider IEN   File 200
  7365   "RTN","SDM XGAPT",136 ,0)
  7366    . I ARRAY (NUM,"IEN" )="" Q
  7367   "RTN","SDM XGAPT",137 ,0)
  7368    . S ARRAY (NUM,"NAME ")=$$GET1^ DIQ(200,(A RRAY(NUM," IEN")),.01 ) ;- Name  of provide r File 200
  7369   "RTN","SDM XGAPT",138 ,0)
  7370    . S ARRAY (0)=ARRAY( 0)+1
  7371   "RTN","SDM XGAPT",139 ,0)
  7372    Q
  7373   "RTN","SDM XGAPT",140 ,0)
  7374   PROVIEN(CL INIC,NODE)  ;Returns  the Nth pr ovider ID  for a Clin ic
  7375   "RTN","SDM XGAPT",141 ,0)
  7376    ;  CLINIC  (I,REQ) -  The Clini c IEN (fir st piece o f DPT 0 no de)
  7377   "RTN","SDM XGAPT",142 ,0)
  7378    ;  NODE ( I,REQ)       - The co unt of the  node bein g examined
  7379   "RTN","SDM XGAPT",143 ,0)
  7380    Q $P($G(^ SC($G(CLIN IC),"PR",$ G(NODE),0) ),"^",1)
  7381   "RTN","SDM XGAPT",144 ,0)
  7382   CLINGRP(CL INIC) ;Ret urns the I D of a Cli nic's grou p
  7383   "RTN","SDM XGAPT",145 ,0)
  7384    ;  CLINIC  (I,REQ) -  The Clini c IEN (fir st piece o f DPT 0 no de)
  7385   "RTN","SDM XGAPT",146 ,0)
  7386    Q $P($G(^ SC($G(CLIN IC),0)),"^ ",31)
  7387   "RTN","SDM XGAPT",147 ,0)
  7388   APTSTAT(PA TIEN,APPTD T,NOOP) ;R eturns cur rent compu ted appoin tment stat us which
  7389   "RTN","SDM XGAPT",148 ,0)
  7390    ;  includ es checked  in/out wh ich the "S "0;2 node  does not.
  7391   "RTN","SDM XGAPT",149 ,0)
  7392    ;   PATIE N (I,REQ)-  Patient I D as in DP T(PATIEN," S",APPTDAT
  7393   "RTN","SDM XGAPT",150 ,0)
  7394    ;   APPTD T (I,REQ)  - Appointm ent date
  7395   "RTN","SDM XGAPT",151 ,0)
  7396    ;   NOOP  (I,OPT)    - Deprecat ed
  7397   "RTN","SDM XGAPT",152 ,0)
  7398    ; OUTPUT:  Appointme nt current  Status va lues:
  7399   "RTN","SDM XGAPT",153 ,0)
  7400    ;                SCH EDULED (De fault)
  7401   "RTN","SDM XGAPT",154 ,0)
  7402    ;                CHE CKED IN
  7403   "RTN","SDM XGAPT",155 ,0)
  7404    ;                CHE CKED OUT
  7405   "RTN","SDM XGAPT",156 ,0)
  7406    ;                CAN CELLED
  7407   "RTN","SDM XGAPT",157 ,0)
  7408    ;                NO- SHOW
  7409   "RTN","SDM XGAPT",158 ,0)
  7410    ;                ""  if the app ointment d oes not ex ist.\
  7411   "RTN","SDM XGAPT",159 ,0)
  7412    ;
  7413   "RTN","SDM XGAPT",160 ,0)
  7414    N RET,DPT 0,CLINICID ,S,C,CLINC ,P,VADMVT, VAINDT,STA TUS,SDSCE, SDIEN,SDDA
  7415   "RTN","SDM XGAPT",161 ,0)
  7416    I $G(PATI EN)="" Q " "
  7417   "RTN","SDM XGAPT",162 ,0)
  7418    I $G(APPT DT)="" Q " "
  7419   "RTN","SDM XGAPT",163 ,0)
  7420    ;
  7421   "RTN","SDM XGAPT",164 ,0)
  7422    ;
  7423   "RTN","SDM XGAPT",165 ,0)
  7424    S DPT0=$$ APPTNODE(P ATIEN,APPT DT,0)
  7425   "RTN","SDM XGAPT",166 ,0)
  7426    I $G(DPT0 )="" Q ""
  7427   "RTN","SDM XGAPT",167 ,0)
  7428    ;
  7429   "RTN","SDM XGAPT",168 ,0)
  7430    ;CLINIC I D IS FIRST  PART OF D PT "S" 0 N ODE
  7431   "RTN","SDM XGAPT",169 ,0)
  7432    S CLINICI D=+$G(DPT0 )
  7433   "RTN","SDM XGAPT",170 ,0)
  7434    I $G(CLIN ICID)="" Q  ""
  7435   "RTN","SDM XGAPT",171 ,0)
  7436    ;
  7437   "RTN","SDM XGAPT",172 ,0)
  7438    ;
  7439   "RTN","SDM XGAPT",173 ,0)
  7440    ; -- get  data for e valuation
  7441   "RTN","SDM XGAPT",174 ,0)
  7442    S SDDA=+$ $FIND^SDAM 2(PATIEN,A PPTDT,CLIN ICID)
  7443   "RTN","SDM XGAPT",175 ,0)
  7444    S CLINC=$ G(^SC(CLIN ICID,"S",A PPTDT,1,SD DA,"C"))
  7445   "RTN","SDM XGAPT",176 ,0)
  7446    ;
  7447   "RTN","SDM XGAPT",177 ,0)
  7448    ; -- set  initial st atus value  ; non-cou nt clinic?
  7449   "RTN","SDM XGAPT",178 ,0)
  7450    S RET=$S( $P(DPT0,"^ ",2)]"":$P ($P($P(^DD (2.98,3,0) ,"^",3),$P (DPT0,"^", 2)_":",2), ";"),1:"")
  7451   "RTN","SDM XGAPT",179 ,0)
  7452    ;
  7453   "RTN","SDM XGAPT",180 ,0)
  7454    ; if depl oying for  inpatient,  add updat es for inp atient log ic.
  7455   "RTN","SDM XGAPT",181 ,0)
  7456    ;
  7457   "RTN","SDM XGAPT",182 ,0)
  7458    ; -- dete rmine ci/c o indicato r
  7459   "RTN","SDM XGAPT",183 ,0)
  7460    I RET=""  S RET=$S($ P(CLINC,"^ ",3):"CHEC KED OUT",+ CLINC:"CHE CKED IN",1 :"")
  7461   "RTN","SDM XGAPT",184 ,0)
  7462    ;
  7463   "RTN","SDM XGAPT",185 ,0)
  7464    S RET=$S( RET["CANCE LLED":"CAN CELLED",RE T["NO-SHOW ":"NO SHOW ",RET["CHE CKED OUT": "CHECKED O UT",RET["C HECKED IN" :"CHECKED  IN",1:"SCH EDULED")
  7465   "RTN","SDM XGAPT",186 ,0)
  7466    Q RET
  7467   "RTN","SDM XGAPT",187 ,0)
  7468    ;
  7469   "RTN","SDM XGAPT",188 ,0)
  7470    Q  ;;#eor #
  7471   "RTN","SDM XLKRQ")
  7472   0^40^B4319 5858
  7473   "RTN","SDM XLKRQ",1,0 )
  7474   SDMXLKRQ ; MASS/DAP -  Locking a nd Reseque ncing Tags ;11/05/17; 2018-05-17  12:25:40; 8.3;jJk9Iu lUe+O82uI+ ShjD2CNFjD ZkMxrzk5Lp nGxc7k8=
  7475   "RTN","SDM XLKRQ",2,0 )
  7476    ;;5.3;Sch eduling;** 676**;NOVE MBER 25,20 17;Build 9 9
  7477   "RTN","SDM XLKRQ",3,0 )
  7478    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  7479   "RTN","SDM XLKRQ",4,0 )
  7480    ;  ICR#   Supported
  7481   "RTN","SDM XLKRQ",5,0 )
  7482    ;  10103   $$HTFM^XL FDT
  7483   "RTN","SDM XLKRQ",6,0 )
  7484    ;  4724   REPROC^HLO API3
  7485   "RTN","SDM XLKRQ",7,0 )
  7486    ;  10035     ^DPT
  7487   "RTN","SDM XLKRQ",8,0 )
  7488    ;  ###     ^OR
  7489   "RTN","SDM XLKRQ",9,0 )
  7490    Q
  7491   "RTN","SDM XLKRQ",10, 0)
  7492    ;
  7493   "RTN","SDM XLKRQ",11, 0)
  7494    ;
  7495   "RTN","SDM XLKRQ",12, 0)
  7496   SEQUENCE(M SGARY,LOCK ARY,ENCIEN ) ;Entry p oint- Call ed from SD MX schedul ing
  7497   "RTN","SDM XLKRQ",13, 0)
  7498    N PATIEN, CLINIEN,AP PTDT,ORDID ,CONSID,MS GIEN,ERRMS G
  7499   "RTN","SDM XLKRQ",14, 0)
  7500    S (PATIEN ,CLINIEN,A PPTDT,ORDI D,CONSID,M SGIEN,ERRM SG)=""
  7501   "RTN","SDM XLKRQ",15, 0)
  7502    K LOCKARY
  7503   "RTN","SDM XLKRQ",16, 0)
  7504    S ENCIEN= $G(ENCIEN)
  7505   "RTN","SDM XLKRQ",17, 0)
  7506    D ARY2VAR (.MSGARY,. PATIEN,.CL INIEN,.APP TDT,.ORDID ,.CONSID,. MSGIEN)  ; Puts the A rray's val ues in the  local var iables.
  7507   "RTN","SDM XLKRQ",18, 0)
  7508    I $$INHOL DQ(PATIEN, CLINIEN,AP PTDT,ORDID ,CONSID,MS GIEN,ENCIE N) D RESEQ (PATIEN,CL INIEN,APPT DT,ORDID,C ONSID,MSGI EN,ENCIEN, "HOLDQUEUE  LOCKS") Q  0
  7509   "RTN","SDM XLKRQ",19, 0)
  7510    I '$$LOCK ALL(PATIEN ,CLINIEN,A PPTDT,ORDI D,CONSID,E NCIEN,.ERR MSG) D RES EQ(PATIEN, CLINIEN,AP PTDT,ORDID ,CONSID,MS GIEN,ENCIE N,ERRMSG)  Q 0
  7511   "RTN","SDM XLKRQ",20, 0)
  7512    D CACHEAR Y(.LOCKARY ,PATIEN,CL INIEN,APPT DT,ORDID,C ONSID,ENCI EN)
  7513   "RTN","SDM XLKRQ",21, 0)
  7514    I $$SHOUL DRQ() D RE QUEUE()
  7515   "RTN","SDM XLKRQ",22, 0)
  7516    Q 1
  7517   "RTN","SDM XLKRQ",23, 0)
  7518   AFTRPROC(L OCKARY) ;E ntry point  after mes sage proce ssing to r elease loc ks. Sequen ce sets th e input vi a CACHEARY .
  7519   "RTN","SDM XLKRQ",24, 0)
  7520    N PATIEN, CLINIEN,AP PTDT,ORDID ,CONSID,MS GIEN,ENCIE N,OK
  7521   "RTN","SDM XLKRQ",25, 0)
  7522    S (PATIEN ,CLINIEN,A PPTDT,ORDI D,CONSID,M SGIEN,ENCI EN,OK)=""
  7523   "RTN","SDM XLKRQ",26, 0)
  7524    D ARY2VAR (.LOCKARY, .PATIEN,.C LINIEN,.AP PTDT,.ORDI D,.CONSID, .MSGIEN,.E NCIEN)
  7525   "RTN","SDM XLKRQ",27, 0)
  7526    S OK=$$UL OCKALL(PAT IEN,CLINIE N,APPTDT,O RDID,CONSI D,ENCIEN)
  7527   "RTN","SDM XLKRQ",28, 0)
  7528    I $$SHOUL DRQ() D RE QUEUE()
  7529   "RTN","SDM XLKRQ",29, 0)
  7530    Q
  7531   "RTN","SDM XLKRQ",30, 0)
  7532   INHOLDQ(PA TIEN,CLINI EN,APPTDT, ORDID,CONS ID,MSGIEN, ENCIEN) ;E valuates i f the curr ent messag e has any  lockable I Ds in the  hold queue
  7533   "RTN","SDM XLKRQ",31, 0)
  7534    I $G(PATI EN),$G(APP TDT),$G(@$ $HQGLO()@( "PATIEN",$ G(PATIEN), $G(APPTDT) ))'="" Q 1
  7535   "RTN","SDM XLKRQ",32, 0)
  7536    I $G(CLIN IEN),$G(AP PTDT),$G(@ $$HQGLO()@ ("CLINIEN" ,$G(CLINIE N),$G(APPT DT)))'=""  Q 1
  7537   "RTN","SDM XLKRQ",33, 0)
  7538    I $G(ORDI D),$G(@$$H QGLO()@("O RDID",$G(O RDID)))'=" " Q 1
  7539   "RTN","SDM XLKRQ",34, 0)
  7540    I $G(CONS ID),$G(@$$ HQGLO()@(" CONSID",$G (CONSID))) '="" Q 1
  7541   "RTN","SDM XLKRQ",35, 0)
  7542    I $G(MSGI EN),$G(@$$ HQGLO()@(" MSGIEN",$G (MSGIEN))) '="" Q 1
  7543   "RTN","SDM XLKRQ",36, 0)
  7544    I $G(ENCI EN),$G(@$$ HQGLO()@(" ENCIEN",$G (ENCIEN))) '="" Q 1
  7545   "RTN","SDM XLKRQ",37, 0)
  7546    Q 0
  7547   "RTN","SDM XLKRQ",38, 0)
  7548    ;
  7549   "RTN","SDM XLKRQ",39, 0)
  7550   LOCKALL(PA TIEN,CLINI EN,APPTDT, ORDID,CONS ID,ENCIEN, ERRMSG) ;
  7551   "RTN","SDM XLKRQ",40, 0)
  7552    ;PATIEN      - Patie nt IEN
  7553   "RTN","SDM XLKRQ",41, 0)
  7554    ;CLINIEN     - Clini c IEN
  7555   "RTN","SDM XLKRQ",42, 0)
  7556    ;APPDT       - Appoi ntment dat e and time  in vista  format. Fo r example:  3171024.0 915
  7557   "RTN","SDM XLKRQ",43, 0)
  7558    ;ORDID       - Order  ID
  7559   "RTN","SDM XLKRQ",44, 0)
  7560    ;CONSID      - Consu lt ID
  7561   "RTN","SDM XLKRQ",45, 0)
  7562    ;ENCIEN      - Encou nter IEN
  7563   "RTN","SDM XLKRQ",46, 0)
  7564    ;ERRMSG      - Node  we failed  locking
  7565   "RTN","SDM XLKRQ",47, 0)
  7566    I $G(PATI EN),$G(APP TDT),'$$LO CKPAT($G(P ATIEN),$G( APPTDT)) S  ERRMSG="P ATIENT^"_P ATIEN_"^"_ APPTDT Q 0
  7567   "RTN","SDM XLKRQ",48, 0)
  7568    I $G(CLIN IEN),$G(AP PTDT),'$$L OCKCLIN($G (CLINIEN), $G(APPTDT) ) S ERRMSG ="CLINIC^" _CLINIEN_" ^"_APPTDT  Q 0
  7569   "RTN","SDM XLKRQ",49, 0)
  7570    I $G(ORDI D),'$$LOCK ORD($G(ORD ID)) S ERR MSG="ORDER ^"_ORDID Q  0
  7571   "RTN","SDM XLKRQ",50, 0)
  7572    I $G(CONS ID),'$$LOC KCONS($G(C ONSID)) S  ERRMSG="CO NSULT^"_CO NSID Q 0
  7573   "RTN","SDM XLKRQ",51, 0)
  7574    I $G(ENCI EN),'$$LOC KENC($G(EN CIEN)) S E RRMSG="ENC OUNTER^"_E NCIEN Q 0
  7575   "RTN","SDM XLKRQ",52, 0)
  7576    Q 1
  7577   "RTN","SDM XLKRQ",53, 0)
  7578   RESEQ(PATI EN,CLINIEN ,APPTDT,OR DID,CONSID ,MSGIEN,EN CIEN,ERRMS G) ;Resequ ences a me ssage- Rel eases lock s and adds  to hold q ueue
  7579   "RTN","SDM XLKRQ",54, 0)
  7580    N OK
  7581   "RTN","SDM XLKRQ",55, 0)
  7582    S OK=$$UL OCKALL($G( PATIEN),$G (CLINIEN), $G(APPTDT) ,$G(ORDID) ,$G(CONSID ),$G(ENCIE N))
  7583   "RTN","SDM XLKRQ",56, 0)
  7584    S OK=$$AD DHOLDQ($G( PATIEN),$G (CLINIEN), $G(APPTDT) ,$G(ORDID) ,$G(CONSID ),$G(MSGIE N),$G(ENCI EN),$G(ERR MSG))
  7585   "RTN","SDM XLKRQ",57, 0)
  7586    I $$SHOUL DRQ() D RE QUEUE() Q
  7587   "RTN","SDM XLKRQ",58, 0)
  7588    I $$HASTA SK() Q      ;Tasks ap ply to all  messages
  7589   "RTN","SDM XLKRQ",59, 0)
  7590    S OK=$$MA KETASK()    ;Creates  a task to  re-enqueue  all held  messages o ne minute  from now
  7591   "RTN","SDM XLKRQ",60, 0)
  7592    Q
  7593   "RTN","SDM XLKRQ",61, 0)
  7594   ULOCKALL(P ATIEN,CLIN IEN,APPTDT ,ORDID,CON SID,ENCIEN ) ;
  7595   "RTN","SDM XLKRQ",62, 0)
  7596    ;PATIEN      - Patie nt IEN
  7597   "RTN","SDM XLKRQ",63, 0)
  7598    ;CLINIEN     - Clini c IEN
  7599   "RTN","SDM XLKRQ",64, 0)
  7600    ;APPDT       - Appoi ntment dat e and time  in vista  format. Fo r example:  3171024.0 915
  7601   "RTN","SDM XLKRQ",65, 0)
  7602    ;ORDID       - Order  ID
  7603   "RTN","SDM XLKRQ",66, 0)
  7604    ;ENCIEN      - Encou nter IEN
  7605   "RTN","SDM XLKRQ",67, 0)
  7606    I $G(PATI EN),$G(APP TDT),'$$UL OCKPAT($G( PATIEN),$G (APPTDT))  Q 0
  7607   "RTN","SDM XLKRQ",68, 0)
  7608    I $G(CLIN IEN),$G(AP PTDT),'$$U LCKCLIN($G (CLINIEN), $G(APPTDT) ) Q 0
  7609   "RTN","SDM XLKRQ",69, 0)
  7610    I $G(ORDI D),'$$ULOC KORD($G(OR DID)) Q 0
  7611   "RTN","SDM XLKRQ",70, 0)
  7612    I $G(CONS ID),'$$ULC KCONS($G(C ONSID)) Q  0
  7613   "RTN","SDM XLKRQ",71, 0)
  7614    I $G(ENCI EN),'$$ULC KENC($G(EN CIEN)) Q 0
  7615   "RTN","SDM XLKRQ",72, 0)
  7616    Q 1
  7617   "RTN","SDM XLKRQ",73, 0)
  7618   ADDHOLDQ(P ATIEN,CLIN IEN,APPTDT ,ORDID,CON SID,MSGIEN ,ENCIEN,ER RMSG) ;Add s a messag e entry to  the hold  queue
  7619   "RTN","SDM XLKRQ",74, 0)
  7620    N OK
  7621   "RTN","SDM XLKRQ",75, 0)
  7622    S OK=""
  7623   "RTN","SDM XLKRQ",76, 0)
  7624    I $G(MSGI EN)="" Q 1        ;Sh ould never  happen
  7625   "RTN","SDM XLKRQ",77, 0)
  7626    S @$$HQGL O()@(0)=$$ HTFM^XLFDT ($H+31,1)_ "^"_$$HTFM ^XLFDT($H, 1)         ;Purge dat e^Create d ate used b y XQ82
  7627   "RTN","SDM XLKRQ",78, 0)
  7628    I $I(@$$H QGLO())=1  S @$$HQGLO ()@("FRSTH ORO")=$H
  7629   "RTN","SDM XLKRQ",79, 0)
  7630    I $G(PATI EN),$G(APP TDT),$I(@$ $HQGLO()@( "PATIEN",$ G(PATIEN), $G(APPTDT) ))
  7631   "RTN","SDM XLKRQ",80, 0)
  7632    I $G(CLIN IEN),$G(AP PTDT),$I(@ $$HQGLO()@ ("CLINIEN" ,$G(CLINIE N),$G(APPT DT)))
  7633   "RTN","SDM XLKRQ",81, 0)
  7634    I $G(ORDI D),$I(@$$H QGLO()@("O RDID",$G(O RDID)))
  7635   "RTN","SDM XLKRQ",82, 0)
  7636    I $G(CONS ID),$I(@$$ HQGLO()@(" CONSID",$G (CONSID)))
  7637   "RTN","SDM XLKRQ",83, 0)
  7638    I $G(ENCI EN),$I(@$$ HQGLO()@(" ENCIEN",$G (ENCIEN)))
  7639   "RTN","SDM XLKRQ",84, 0)
  7640    I $I(@$$H QGLO()@("M SGIEN",$G( MSGIEN)))= 1 S OK=$I( @$$HQGLO() @("UNIQMSG S"))
  7641   "RTN","SDM XLKRQ",85, 0)
  7642    I $G(ERRM SG)'="" S  @$$HQGLO() @("MSGIEN" ,$G(MSGIEN ),"FAILED  LOCK")=ERR MSG    ;Di agnostic m essage
  7643   "RTN","SDM XLKRQ",86, 0)
  7644    Q 1
  7645   "RTN","SDM XLKRQ",87, 0)
  7646   SHOULDRQ()  ;Determin es if the  hold queue  should be  requeued.  Deprecate d in favor  of using  tasks
  7647   "RTN","SDM XLKRQ",88, 0)
  7648    N HELDMSG S,QUETIME, RQUETIME,T DIFF
  7649   "RTN","SDM XLKRQ",89, 0)
  7650    S HELDMSG S=$G(@$$HQ GLO())
  7651   "RTN","SDM XLKRQ",90, 0)
  7652    I +HELDMS GS=0 Q 0
  7653   "RTN","SDM XLKRQ",91, 0)
  7654    S QUETIME =$P(@$$HQG LO()@("FRS THORO"),", ",2)
  7655   "RTN","SDM XLKRQ",92, 0)
  7656    S RQUETIM E=$P($H,", ",2)
  7657   "RTN","SDM XLKRQ",93, 0)
  7658    S TDIFF=( RQUETIME-Q UETIME)
  7659   "RTN","SDM XLKRQ",94, 0)
  7660    I TDIFF>1 0 Q 1
  7661   "RTN","SDM XLKRQ",95, 0)
  7662    I TDIFF<0  Q 1        ;Midnight  and DST c an get a b onus reque ue
  7663   "RTN","SDM XLKRQ",96, 0)
  7664    Q 0
  7665   "RTN","SDM XLKRQ",97, 0)
  7666   REQUEUE()  ;Merges th e hold que ue back in to the HLO  queue. Th is is safe  to call a t any time
  7667   "RTN","SDM XLKRQ",98, 0)
  7668    N MSGIEN
  7669   "RTN","SDM XLKRQ",99, 0)
  7670    F  S MSGI EN=$O(@$$H QGLO()@("M SGIEN",$G( MSGIEN)))  Q:(MSGIEN= "")  D
  7671   "RTN","SDM XLKRQ",100 ,0)
  7672    . D REPRO C^HLOAPI3( MSGIEN)
  7673   "RTN","SDM XLKRQ",101 ,0)
  7674    . D CLRHQ NDE("MSGIE N",MSGIEN)
  7675   "RTN","SDM XLKRQ",102 ,0)
  7676    D CLRHQGL O()
  7677   "RTN","SDM XLKRQ",103 ,0)
  7678    Q
  7679   "RTN","SDM XLKRQ",104 ,0)
  7680    ;
  7681   "RTN","SDM XLKRQ",105 ,0)
  7682   MAKETASK()  ;Creates  a task to  re-enque a ll held me ssages one  minute fr om now
  7683   "RTN","SDM XLKRQ",106 ,0)
  7684    S @$$HQGL O()@("TASK  SCHEDULED ")=1   ;
  7685   "RTN","SDM XLKRQ",107 ,0)
  7686    N ZTRTN,Z TDESC,ZTDT H,ZTIO,ZTS K
  7687   "RTN","SDM XLKRQ",108 ,0)
  7688    s (ZTIO,Z TSK)=""
  7689   "RTN","SDM XLKRQ",109 ,0)
  7690    S ZTRTN=" REQUEUE^SD MXLKRQ"
  7691   "RTN","SDM XLKRQ",110 ,0)
  7692    S ZTDESC= "MASS MESS AGE RESEQU ENCING"
  7693   "RTN","SDM XLKRQ",111 ,0)
  7694    S ZTDTH=$ $HADD^XLFD T($H,"","" ,1)    ;Se t task to  run one mi nute from  now
  7695   "RTN","SDM XLKRQ",112 ,0)
  7696    D ^%ZTLOA D
  7697   "RTN","SDM XLKRQ",113 ,0)
  7698    I $G(ZTSK )'="" S @$ $HQGLO()@( "TASK SCHE DULED")=ZT SK Q 1      ;Task num ber return ed
  7699   "RTN","SDM XLKRQ",114 ,0)
  7700    Q 0
  7701   "RTN","SDM XLKRQ",115 ,0)
  7702   HASTASK()  ;Batch tas k already  scheduled
  7703   "RTN","SDM XLKRQ",116 ,0)
  7704    Q ($G(@$$ HQGLO()@(" TASK SCHED ULED"))'=" ")
  7705   "RTN","SDM XLKRQ",117 ,0)
  7706   LOCKPAT(PA TIEN,APPTD T) ;
  7707   "RTN","SDM XLKRQ",118 ,0)
  7708    I ($G(PAT IEN)="")!( $G(APPTDT) ="") Q 0
  7709   "RTN","SDM XLKRQ",119 ,0)
  7710    Q $$LOCK( $NA(^DPT(P ATIEN,"S", APPTDT)))
  7711   "RTN","SDM XLKRQ",120 ,0)
  7712   LOCKCLIN(C LINIEN,APP TDT) ;
  7713   "RTN","SDM XLKRQ",121 ,0)
  7714    I ($G(CLI NIEN)="")! ($G(APPTDT )="") Q 0
  7715   "RTN","SDM XLKRQ",122 ,0)
  7716    Q $$LOCK( $NA(^SC(CL INIEN,"S", APPTDT)))
  7717   "RTN","SDM XLKRQ",123 ,0)
  7718   LOCKORD(OR DID) ;
  7719   "RTN","SDM XLKRQ",124 ,0)
  7720    I $G(ORDI D)="" Q 0
  7721   "RTN","SDM XLKRQ",125 ,0)
  7722    Q $$LOCK( $NA(^OR(10 0,ORDID)))
  7723   "RTN","SDM XLKRQ",126 ,0)
  7724   LOCKCONS(C ONSID) ;
  7725   "RTN","SDM XLKRQ",127 ,0)
  7726    I $G(CONS ID)="" Q 0
  7727   "RTN","SDM XLKRQ",128 ,0)
  7728    Q $$LOCK( $NA(^GMR(1 23,CONSID) ))
  7729   "RTN","SDM XLKRQ",129 ,0)
  7730   LOCKENC(EN CIEN) ;
  7731   "RTN","SDM XLKRQ",130 ,0)
  7732    I $G(ENCI EN)="" Q 0
  7733   "RTN","SDM XLKRQ",131 ,0)
  7734    Q $$LOCK( $NA(^SCE(E NCIEN,0)))
  7735   "RTN","SDM XLKRQ",132 ,0)
  7736   ULOCKPAT(P ATIEN,APPT DT) ;
  7737   "RTN","SDM XLKRQ",133 ,0)
  7738    I ($G(PAT IEN)="")!( $G(APPTDT) ="") Q 0
  7739   "RTN","SDM XLKRQ",134 ,0)
  7740    Q $$ULOCK ($NA(^DPT( PATIEN,"S" ,APPTDT)))
  7741   "RTN","SDM XLKRQ",135 ,0)
  7742   ULCKCLIN(C LINIEN,APP TDT) ;
  7743   "RTN","SDM XLKRQ",136 ,0)
  7744    I ($G(CLI NIEN)="")! ($G(APPTDT )="") Q 0
  7745   "RTN","SDM XLKRQ",137 ,0)
  7746    Q $$ULOCK ($NA(^SC(C LINIEN,"S" ,APPTDT)))
  7747   "RTN","SDM XLKRQ",138 ,0)
  7748   ULOCKORD(O RDID) ;
  7749   "RTN","SDM XLKRQ",139 ,0)
  7750    I $G(ORDI D)="" Q 0
  7751   "RTN","SDM XLKRQ",140 ,0)
  7752    Q $$ULOCK ($NA(^OR(1 00,ORDID)) )
  7753   "RTN","SDM XLKRQ",141 ,0)
  7754   ULCKCONS(C ONSID) ;
  7755   "RTN","SDM XLKRQ",142 ,0)
  7756    I $G(CONS ID)="" Q 0
  7757   "RTN","SDM XLKRQ",143 ,0)
  7758    Q $$ULOCK ($NA(^GMR( 123,CONSID )))
  7759   "RTN","SDM XLKRQ",144 ,0)
  7760   ULCKENC(EN CIEN) ;
  7761   "RTN","SDM XLKRQ",145 ,0)
  7762    I $G(ENCI EN)="" Q 0
  7763   "RTN","SDM XLKRQ",146 ,0)
  7764    Q $$ULOCK ($NA(^SCE( ENCIEN,0)) )
  7765   "RTN","SDM XLKRQ",147 ,0)
  7766   LOCKOGR(FR ) ; LOCKS  AN OPEN GL OBAL ROOT
  7767   "RTN","SDM XLKRQ",148 ,0)
  7768    ; FR - AN  OPEN GLOB AL ROOT AS  USED BY F ILEMAN (DI E, DIC)
  7769   "RTN","SDM XLKRQ",149 ,0)
  7770    S FR=$G(F R)
  7771   "RTN","SDM XLKRQ",150 ,0)
  7772    S FR=$E(F R,"",$L(FR )-1)_")"
  7773   "RTN","SDM XLKRQ",151 ,0)
  7774    Q $$LOCK( FR)
  7775   "RTN","SDM XLKRQ",152 ,0)
  7776   ULOCKOGR(F R) ; UNLOC KS AN OPEN  GLOBAL RO OT
  7777   "RTN","SDM XLKRQ",153 ,0)
  7778    ; FR - AN  OPEN GLOB AL ROOT AS  USED BY F ILEMAN (DI E, DIC)
  7779   "RTN","SDM XLKRQ",154 ,0)
  7780    S FR=$G(F R)
  7781   "RTN","SDM XLKRQ",155 ,0)
  7782    S FR=$E(F R,"",$L(FR )-1)_")"
  7783   "RTN","SDM XLKRQ",156 ,0)
  7784    Q $$ULOCK (FR)
  7785   "RTN","SDM XLKRQ",157 ,0)
  7786   LOCK(GLO)  ;Locks a l ock name
  7787   "RTN","SDM XLKRQ",158 ,0)
  7788    ;GLO    - Lock name
  7789   "RTN","SDM XLKRQ",159 ,0)
  7790    S GLO=$NA (@GLO)
  7791   "RTN","SDM XLKRQ",160 ,0)
  7792    L +@GLO:0  E  Q 0
  7793   "RTN","SDM XLKRQ",161 ,0)
  7794    Q 1
  7795   "RTN","SDM XLKRQ",162 ,0)
  7796   ULOCK(GLO)  ;Unlocks  a lock nam e
  7797   "RTN","SDM XLKRQ",163 ,0)
  7798    ;GLO    - Lock name
  7799   "RTN","SDM XLKRQ",164 ,0)
  7800    S GLO=$NA (@GLO)
  7801   "RTN","SDM XLKRQ",165 ,0)
  7802    L -@GLO:0  E  Q 0
  7803   "RTN","SDM XLKRQ",166 ,0)
  7804    Q 1
  7805   "RTN","SDM XLKRQ",167 ,0)
  7806   HQGLO() ;
  7807   "RTN","SDM XLKRQ",168 ,0)
  7808    ;Returns  a referenc e to the g lobal used  for reseq uencing
  7809   "RTN","SDM XLKRQ",169 ,0)
  7810    Q $NA(^XT MP("SDMX H OLDQUEUE") )
  7811   "RTN","SDM XLKRQ",170 ,0)
  7812   CLRHQGLO()  ;Clears t he entire  hold queue  global
  7813   "RTN","SDM XLKRQ",171 ,0)
  7814    K @$$HQGL O()    ;
  7815   "RTN","SDM XLKRQ",172 ,0)
  7816    Q
  7817   "RTN","SDM XLKRQ",173 ,0)
  7818   CLRHQNDE(N ODE,VAL) ; Clears a s pecified n ode in the  hold queu e global
  7819   "RTN","SDM XLKRQ",174 ,0)
  7820    I ($G(NOD E)="")!($G (VAL)="")  Q
  7821   "RTN","SDM XLKRQ",175 ,0)
  7822    K @$$HQGL O()@(NODE, VAL)
  7823   "RTN","SDM XLKRQ",176 ,0)
  7824    Q
  7825   "RTN","SDM XLKRQ",177 ,0)
  7826   ARY2VAR(AR Y,PATIEN,C LINIEN,APP TDT,ORDID, CONSID,MSG IEN,ENCIEN ) ;Pulls I Ds out of  the SDMX s tandard sc heduling a rray
  7827   "RTN","SDM XLKRQ",178 ,0)
  7828    S PATIEN= $G(ARY("PA TIENT IEN" ))
  7829   "RTN","SDM XLKRQ",179 ,0)
  7830    S CLINIEN =$G(ARY("C LINIC"))
  7831   "RTN","SDM XLKRQ",180 ,0)
  7832    S APPTDT= $G(ARY("AP PTDT"))
  7833   "RTN","SDM XLKRQ",181 ,0)
  7834    S ORDID=$ G(ARY("ORD ER ID"))
  7835   "RTN","SDM XLKRQ",182 ,0)
  7836    S CONSID= $G(ARY("CO NSULT ID") )
  7837   "RTN","SDM XLKRQ",183 ,0)
  7838    S MSGIEN= $G(ARY("ME SSAGE IEN" ))
  7839   "RTN","SDM XLKRQ",184 ,0)
  7840    s ENCIEN= $G(ARY("EN COUNTER IE N"))
  7841   "RTN","SDM XLKRQ",185 ,0)
  7842    Q
  7843   "RTN","SDM XLKRQ",186 ,0)
  7844   CACHEARY(A RY,PATIEN, CLINIEN,AP PTDT,ORDID ,CONSID,EN CIEN) ;Set s the IDs  used for l ocking in  a SDMX sta ndard sche duling arr ay
  7845   "RTN","SDM XLKRQ",187 ,0)
  7846    S ARY("PA TIENT IEN" )=$G(PATIE N)
  7847   "RTN","SDM XLKRQ",188 ,0)
  7848    S ARY("CL INIC")=$G( CLINIEN)
  7849   "RTN","SDM XLKRQ",189 ,0)
  7850    S ARY("AP PTDT")=$G( APPTDT)
  7851   "RTN","SDM XLKRQ",190 ,0)
  7852    S ARY("OR DER ID")=$ G(ORDID)
  7853   "RTN","SDM XLKRQ",191 ,0)
  7854    S ARY("CO NSULT ID") =$G(CONSID )
  7855   "RTN","SDM XLKRQ",192 ,0)
  7856    S ARY("EN COUNTER IE N")=$G(ENC IEN)
  7857   "RTN","SDM XLKRQ",193 ,0)
  7858    Q
  7859   "RTN","SDM XLKRQ",194 ,0)
  7860    Q  ;;#eor #
  7861   "RTN","SDM XMAKE")
  7862   0^34^B1213 03995
  7863   "RTN","SDM XMAKE",1,0 )
  7864   SDMXMAKE ; MASS/BB,DA P - Appoin tment Crea tion API;2 017-09-07; 2018-05-25  15:03:21; 8.3;pLg9RT rSnedByUkI RO4etwxEh8 paUDEyR2jL MVcwVPE=
  7865   "RTN","SDM XMAKE",2,0 )
  7866    ;;5.3;Sch eduling;** 676**;SEPT EMBER 07,2 017;Build  99
  7867   "RTN","SDM XMAKE",3,0 )
  7868    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  7869   "RTN","SDM XMAKE",4,0 )
  7870    ;  ICR#   Supported
  7871   "RTN","SDM XMAKE",5,0 )
  7872    ;  10005   DT^DICRW
  7873   "RTN","SDM XMAKE",6,0 )
  7874    ;  10103   $$NOW^XLF DT
  7875   "RTN","SDM XMAKE",7,0 )
  7876    ;  2053   FILE^DIE
  7877   "RTN","SDM XMAKE",8,0 )
  7878    ;  2053   UPDATE^DIE
  7879   "RTN","SDM XMAKE",9,0 )
  7880    ;  10009   FILE^DICN
  7881   "RTN","SDM XMAKE",10, 0)
  7882    ;  ###  S TATUS^ORCS AVE2
  7883   "RTN","SDM XMAKE",11, 0)
  7884    ;  10006   ^DIC
  7885   "RTN","SDM XMAKE",12, 0)
  7886    ;  10018   ^DIE
  7887   "RTN","SDM XMAKE",13, 0)
  7888    ;  ###  $ $CPAIR^SCR PW71
  7889   "RTN","SDM XMAKE",14, 0)
  7890    ;  10035   ^DPT
  7891   "RTN","SDM XMAKE",15, 0)
  7892    ;  10040   ^SC
  7893   "RTN","SDM XMAKE",16, 0)
  7894    ;   4685   ^ORD
  7895   "RTN","SDM XMAKE",17, 0)
  7896    ;  ###     ^OR
  7897   "RTN","SDM XMAKE",18, 0)
  7898    Q
  7899   "RTN","SDM XMAKE",19, 0)
  7900   MAKE(PATIE N,CLINIEN, APPTTYPE,A PPTDT,DURA TION,USERD UZ,PATELIG ,COMMENT,P ID,ORDARY, WLKINFLG,C ONSARY,OLD CLIN,ACTIO N,ACTIONLI ST,MSGARY, APPTARY) ; FILES APPO INTMENT DA TE
  7901   "RTN","SDM XMAKE",20, 0)
  7902    ;   WILL  CREATE AN  APPOINTMEN T IF THE A PPOINTMENT  DOES NOT  EXIST OR U PDATE IF T HE APPOINT MENT DOES  EXIST
  7903   "RTN","SDM XMAKE",21, 0)
  7904    ;   PASSE D IN PARAM ETERS
  7905   "RTN","SDM XMAKE",22, 0)
  7906    ;       P ATIEN (I,R EQ KEY) -  PATIENT ID
  7907   "RTN","SDM XMAKE",23, 0)
  7908    ;       C LINIEN (I, REQ KEY) -  CLINIC ID
  7909   "RTN","SDM XMAKE",24, 0)
  7910    ;       A PPTTYPE (I ,OPT) - AP POINTMENT  TYPE INTEN AL VALUE
  7911   "RTN","SDM XMAKE",25, 0)
  7912    ;       A PPTDT (I,R EQ KEY) -  APPOINTMEN T DATE+TIM E
  7913   "RTN","SDM XMAKE",26, 0)
  7914    ;       D URATION (I ,REQ) - AP POINTMENT  LENGTH IN  MINUTES
  7915   "RTN","SDM XMAKE",27, 0)
  7916    ;       U SERDUZ (I, REQ) - DAT A ENTRY CL ERK
  7917   "RTN","SDM XMAKE",28, 0)
  7918    ;       P ATELIG (I, OPT) -   P ATIENT ELI GIBILITY
  7919   "RTN","SDM XMAKE",29, 0)
  7920    ;       C OMMENT (I, OPT) - REA SON FOR AP POINTMENT  COMMENT
  7921   "RTN","SDM XMAKE",30, 0)
  7922    ;       P ID (I,OPT)  - PATIENT  INDICATED  DATE
  7923   "RTN","SDM XMAKE",31, 0)
  7924    ;       O RDARY (I,O PT) - CONS ULT'S ORDE R ID
  7925   "RTN","SDM XMAKE",32, 0)
  7926    ;       C ONSARY  (I ,OPT) - CO NSULT ID
  7927   "RTN","SDM XMAKE",33, 0)
  7928    ;       O LDCLIN (I, OPT) - OLD  CLINIC IF  REASSIGNI NG
  7929   "RTN","SDM XMAKE",34, 0)
  7930    ;       A CTION (I,O PT)- THE S CHEDULING  ACTION (SC HEDULE, UP DATE, UNCA NCEL)
  7931   "RTN","SDM XMAKE",35, 0)
  7932    ;       A CTIONLIST  (I,OPT)- T HE SERIES  OF SCHEDUL ING ACTION S
  7933   "RTN","SDM XMAKE",36, 0)
  7934    ;       M SGARY (I,O PT)  - THE  PARSED ME SSAGE DATA  ARRAY
  7935   "RTN","SDM XMAKE",37, 0)
  7936    ;       A PPTARY (I, OPT) - THE  PARSED VI STA APPOIN TMENT ARRA Y
  7937   "RTN","SDM XMAKE",38, 0)
  7938    ;Clean in puts
  7939   "RTN","SDM XMAKE",39, 0)
  7940    S PATIEN= $G(PATIEN) ,CLINIEN=$ G(CLINIEN) ,APPTTYPE= $G(APPTTYP E),OLDCLIN =$G(OLDCLI N),APPTDT= $G(APPTDT)
  7941   "RTN","SDM XMAKE",40, 0)
  7942    S DURATIO N=$G(DURAT ION),USERD UZ=$G(USER DUZ),PATEL IG=$G(PATE LIG),COMME NT=$G(COMM ENT)
  7943   "RTN","SDM XMAKE",41, 0)
  7944    S PID=$G( PID),WLKIN FLG=$G(WLK INFLG),ACT ION=$G(ACT ION)
  7945   "RTN","SDM XMAKE",42, 0)
  7946    ;
  7947   "RTN","SDM XMAKE",43, 0)
  7948    ; Check R equirement s
  7949   "RTN","SDM XMAKE",44, 0)
  7950    I ($G(PAT IEN)="")!( $G(CLINIEN )="")!($G( APPTDT)="" )!($G(DURA TION)="")! ($G(USERDU Z)="") Q " Missing Pa rameters"
  7951   "RTN","SDM XMAKE",45, 0)
  7952    ;
  7953   "RTN","SDM XMAKE",46, 0)
  7954    N CLINLIN E,DINUM,DI C,DA,X,Y,D LAYGO,DIE, DR,TMPYCLN C,TMPD,OLD CMMT,MADEO N,NOW,ISNW APPT,CNNOT ES,APPTSTA T,ENCSTAT, OUTENC,SCE 0
  7955   "RTN","SDM XMAKE",47, 0)
  7956    N COUNT,O RDPERF,MAS SFDA,MASSI ENS,MASSMS G,U,OLDCNS LT,CSLTFLA G,OK,TMPCO M,POV,SRT, CNREASON,C NTYPE,COPR OC,SCEFDA, SCEIEN,CSL TIEN
  7957   "RTN","SDM XMAKE",48, 0)
  7958    N SDERR,S DEVENT,SDR OOT ;Check  out assum es these
  7959   "RTN","SDM XMAKE",49, 0)
  7960    S (CLINLI NE,DINUM,D IC,DA,X,Y, DLAYGO,DIE ,DR,TMPYCL NC,TMPD,OL DCMMT,MADE ON,NOW,APP TSTAT,COPR OC,ENCSTAT ,SCEIEN,SC E0)=""
  7961   "RTN","SDM XMAKE",50, 0)
  7962    S (COUNT, ORDPERF,MA SSMSG,U,OL DCNSLT,CSL TFLAG,OK,T MPCOM,POV, SRT,ISNWAP PT,CNREASO N,CNTYPE,C NNOTES,SCE FDA,OUTENC ,CSLTIEN)= ""
  7963   "RTN","SDM XMAKE",51, 0)
  7964    ;
  7965   "RTN","SDM XMAKE",52, 0)
  7966    S U="^"
  7967   "RTN","SDM XMAKE",53, 0)
  7968    S ISNWAPP T=$S((ACTI ON="UNDOCA NCEL"):1,1 :0)    ;Us ed to dete rmine if w e should c all the ev ent driver
  7969   "RTN","SDM XMAKE",54, 0)
  7970    ;
  7971   "RTN","SDM XMAKE",55, 0)
  7972    ;Format o r create s ome inputs  for filin g
  7973   "RTN","SDM XMAKE",56, 0)
  7974    S POV=$S( (WLKINFLG= 1):4,1:3)
  7975   "RTN","SDM XMAKE",57, 0)
  7976    S SRT=$S( (WLKINFLG= 1):"W",1:" O")
  7977   "RTN","SDM XMAKE",58, 0)
  7978    ;
  7979   "RTN","SDM XMAKE",59, 0)
  7980    ;Updating  cancel st atuses
  7981   "RTN","SDM XMAKE",60, 0)
  7982    S APPTSTA T=$G(APPTA RY("STATUS "))
  7983   "RTN","SDM XMAKE",61, 0)
  7984    ;
  7985   "RTN","SDM XMAKE",62, 0)
  7986    I (APPTST AT="CANCEL LED") D
  7987   "RTN","SDM XMAKE",63, 0)
  7988    . S CNREA SON=$G(MSG ARY("CANCE L REASON") )
  7989   "RTN","SDM XMAKE",64, 0)
  7990    . I CNREA SON'="" D
  7991   "RTN","SDM XMAKE",65, 0)
  7992    . . S CNT YPE=$P($G( ^SD(409.2, CNREASON,0 )),"^",2)
  7993   "RTN","SDM XMAKE",66, 0)
  7994    . . I (CN TYPE="B")! (CNTYPE="" ) S CNTYPE ="C"
  7995   "RTN","SDM XMAKE",67, 0)
  7996    . . I CNT YPE="P" S  CNTYPE="PC "
  7997   "RTN","SDM XMAKE",68, 0)
  7998    . . S CNN OTES=$G(MS GARY("CANC EL REMARK" ))
  7999   "RTN","SDM XMAKE",69, 0)
  8000    ;
  8001   "RTN","SDM XMAKE",70, 0)
  8002    D DT^DICR W ;Sets DT  = date of  action. P TFU assume s DT
  8003   "RTN","SDM XMAKE",71, 0)
  8004    S NOW=$$N OW^XLFDT()  ;NOW is p rone to ge tting kill ed or rese t in other  called ro utines
  8005   "RTN","SDM XMAKE",72, 0)
  8006    ;
  8007   "RTN","SDM XMAKE",73, 0)
  8008    ; Set app ropraite m ade on Dat e/time and  schedulin g user
  8009   "RTN","SDM XMAKE",74, 0)
  8010    S MADEON= $G(APPTARY ("MADE ON  DATE")) ;O riginal da te made
  8011   "RTN","SDM XMAKE",75, 0)
  8012    I MADEON= "" S MADEO N=$G(MSGAR Y("MADE ON  DATE"))   ;message m ade on dat e
  8013   "RTN","SDM XMAKE",76, 0)
  8014    I MADEON= "" S MADEO N=NOW
  8015   "RTN","SDM XMAKE",77, 0)
  8016    ;
  8017   "RTN","SDM XMAKE",78, 0)
  8018    ; Schedul ing User
  8019   "RTN","SDM XMAKE",79, 0)
  8020    I $G(APPT ARY("USER" ))'="" S U SERDUZ=$G( APPTARY("U SER")) ;Or iginal app t creation  user will  overwrite  the curre nt user
  8021   "RTN","SDM XMAKE",80, 0)
  8022    ;
  8023   "RTN","SDM XMAKE",81, 0)
  8024    I $G(PID) ="" S PID= NOW
  8025   "RTN","SDM XMAKE",82, 0)
  8026    S PID=$P( PID,".")    ;Get the  date porti on
  8027   "RTN","SDM XMAKE",83, 0)
  8028    ;
  8029   "RTN","SDM XMAKE",84, 0)
  8030    ;
  8031   "RTN","SDM XMAKE",85, 0)
  8032    ;Filing t o DPT
  8033   "RTN","SDM XMAKE",86, 0)
  8034    ;Update a n existing  entry in  Patient Fi le
  8035   "RTN","SDM XMAKE",87, 0)
  8036    I $D(^DPT (PATIEN,"S ",APPTDT,0 )) D
  8037   "RTN","SDM XMAKE",88, 0)
  8038    . S MASSI ENS=APPTDT _","_PATIE N_","
  8039   "RTN","SDM XMAKE",89, 0)
  8040    . S MASSF DA(2.98,MA SSIENS,.01 )=CLINIEN   ;CLINIC
  8041   "RTN","SDM XMAKE",90, 0)
  8042    . I $G(CN TYPE)'=""  S MASSFDA( 2.98,MASSI ENS,"3")=C NTYPE ;CAN CEL TYPE
  8043   "RTN","SDM XMAKE",91, 0)
  8044    . S MASSF DA(2.98,MA SSIENS,"9" )=POV  ;PU RPOSE OF V ISIT
  8045   "RTN","SDM XMAKE",92, 0)
  8046    . S MASSF DA(2.98,MA SSIENS,"9. 5")=$G(APP TTYPE)  ;A PPOINTMENT  TYPE
  8047   "RTN","SDM XMAKE",93, 0)
  8048    . I $G(CN REASON)'=" " S MASSFD A(2.98,MAS SIENS,"16" )=CNREASON    ;CANCEL  REASON
  8049   "RTN","SDM XMAKE",94, 0)
  8050    . I $G(CN NOTES)'=""  S MASSFDA (2.98,MASS IENS,"17") =$E(CNNOTE S,1,160) ; CANCEL REM ARK
  8051   "RTN","SDM XMAKE",95, 0)
  8052    . I $G(OL DCLIN)'=""  S MASSFDA (2.98,MASS IENS,"18") =OLDCLIN ; CANCELLED- BY CLINIC
  8053   "RTN","SDM XMAKE",96, 0)
  8054    . S MASSF DA(2.98,MA SSIENS,"19 ")=USERDUZ  ;DATA ENT RY CLERK
  8055   "RTN","SDM XMAKE",97, 0)
  8056    . S MASSF DA(2.98,MA SSIENS,"20 ")=MADEON  ;DATE APPT . MADE
  8057   "RTN","SDM XMAKE",98, 0)
  8058    . S MASSF DA(2.98,MA SSIENS,"25 ")=SRT ;SC HEDULING R EQUEST TYP E
  8059   "RTN","SDM XMAKE",99, 0)
  8060    . S MASSF DA(2.98,MA SSIENS,"26 ")="0"  ;N EXT AVA. A PPT. INDIC ATOR - Alw ays "Other  than Next  Available "
  8061   "RTN","SDM XMAKE",100 ,0)
  8062    . S MASSF DA(2.98,MA SSIENS,"27 ")=PID  ;D ESIRED DAT E OF APPOI NTMENT
  8063   "RTN","SDM XMAKE",101 ,0)
  8064    . S MASSF DA(2.98,MA SSIENS,"28 ")=$$PTFU( PATIEN,CLI NIEN)  ;FO LLOW-UP VI SIT
  8065   "RTN","SDM XMAKE",102 ,0)
  8066    . D FILE^ DIE("","MA SSFDA","MA SSMSG")
  8067   "RTN","SDM XMAKE",103 ,0)
  8068    ;
  8069   "RTN","SDM XMAKE",104 ,0)
  8070    E  D    ; Create a n ew entry
  8071   "RTN","SDM XMAKE",105 ,0)
  8072    . S ISNWA PPT=1
  8073   "RTN","SDM XMAKE",106 ,0)
  8074    . S MASSI ENS="?+1," _PATIEN_", "  ;? MEAN S LOOK UP,  +1 MEANS  ADD NODE F OR SUBSCRI PT 1
  8075   "RTN","SDM XMAKE",107 ,0)
  8076    . S MASSI ENS(1)=APP TDT
  8077   "RTN","SDM XMAKE",108 ,0)
  8078    . S MASSF DA(2.98,MA SSIENS,".0 1")=CLINIE N ;CLINIC
  8079   "RTN","SDM XMAKE",109 ,0)
  8080    . S MASSF DA(2.98,MA SSIENS,"9" )=POV ;PUR POSE OF VI SIT
  8081   "RTN","SDM XMAKE",110 ,0)
  8082    . S MASSF DA(2.98,MA SSIENS,"9. 5")=$G(APP TTYPE) ;AP POINTMENT  TYPE
  8083   "RTN","SDM XMAKE",111 ,0)
  8084    . S MASSF DA(2.98,MA SSIENS,"16 ")=""
  8085   "RTN","SDM XMAKE",112 ,0)
  8086    . S MASSF DA(2.98,MA SSIENS,"19 ")=USERDUZ  ;DATA ENT RY CLERK
  8087   "RTN","SDM XMAKE",113 ,0)
  8088    . S MASSF DA(2.98,MA SSIENS,"20 ")=MADEON  ;DATE APPT . MADE
  8089   "RTN","SDM XMAKE",114 ,0)
  8090    . S MASSF DA(2.98,MA SSIENS,"25 ")=SRT ;SC HEDULING R EQUEST TYP E
  8091   "RTN","SDM XMAKE",115 ,0)
  8092    . S MASSF DA(2.98,MA SSIENS,"26 ")="0" ;NE XT AVA. AP PT. INDICA TOR - Alwa ys "Other  than Next  Available"
  8093   "RTN","SDM XMAKE",116 ,0)
  8094    . S MASSF DA(2.98,MA SSIENS,"27 ")=PID ;DE SIRED DATE  OF APPOIN TMENT
  8095   "RTN","SDM XMAKE",117 ,0)
  8096    . S MASSF DA(2.98,MA SSIENS,"28 ")=$$PTFU( PATIEN,CLI NIEN) ;FOL LOW-UP VIS IT
  8097   "RTN","SDM XMAKE",118 ,0)
  8098    . D UPDAT E^DIE(""," MASSFDA"," MASSIENS", "MASSMSG")
  8099   "RTN","SDM XMAKE",119 ,0)
  8100    ;
  8101   "RTN","SDM XMAKE",120 ,0)
  8102    ; Resync  SCE when w e get upda te message s (same st atus)
  8103   "RTN","SDM XMAKE",121 ,0)
  8104    S OUTENC= $G(APPTARY ("ENCOUNTE R IEN"))
  8105   "RTN","SDM XMAKE",122 ,0)
  8106    I (ACTION ="UPDATE") ,(OUTENC'= ""),$D(^SC E(OUTENC,0 )) D
  8107   "RTN","SDM XMAKE",123 ,0)
  8108    . ;Check  out and No  Show will  set SCE t hemselves
  8109   "RTN","SDM XMAKE",124 ,0)
  8110    . I $$INS TRING^SDMX CORE("CHEC KOUT",ACTI ONLIST) Q
  8111   "RTN","SDM XMAKE",125 ,0)
  8112    . I $$INS TRING^SDMX CORE("NOSH OW",ACTION LIST) Q
  8113   "RTN","SDM XMAKE",126 ,0)
  8114    . ;
  8115   "RTN","SDM XMAKE",127 ,0)
  8116    . S SCE0= $G(^SCE(OU TENC,0))
  8117   "RTN","SDM XMAKE",128 ,0)
  8118    . S COPRO C=$P(SCE0, "^",7)
  8119   "RTN","SDM XMAKE",129 ,0)
  8120    . S ENCST AT=$P(SCE0 ,"^",12)
  8121   "RTN","SDM XMAKE",130 ,0)
  8122    . ;
  8123   "RTN","SDM XMAKE",131 ,0)
  8124    . I (APPT STAT="CHEC KED OUT"), (COPROC="" ) D  Q
  8125   "RTN","SDM XMAKE",132 ,0)
  8126    . . S SDE VENT=$NA(S DEVENT)
  8127   "RTN","SDM XMAKE",133 ,0)
  8128    . . S SDR OOT=$NA(SD EVENT)
  8129   "RTN","SDM XMAKE",134 ,0)
  8130    . . S @SD EVENT@("EV ENT")="CHE CK-OUT"
  8131   "RTN","SDM XMAKE",135 ,0)
  8132    . . S @SD ROOT@("EVE NT")="CHEC K-OUT"
  8133   "RTN","SDM XMAKE",136 ,0)
  8134    . . S @SD ROOT@("DAT E/TIME")=$ G(APPTARY( "CHECKOUT  DT"))
  8135   "RTN","SDM XMAKE",137 ,0)
  8136    . . S @SD ROOT@("USE R")=$G(APP TARY("CHEC KOUT USER" ))
  8137   "RTN","SDM XMAKE",138 ,0)
  8138    . . D INI T^SDAPI(PA TIEN,APPTD T,CLINIEN, .SDEVENT,. SDROOT,0)
  8139   "RTN","SDM XMAKE",139 ,0)
  8140    . . S OK= $$EN^SDAPI AP(PATIEN, APPTDT,CLI NIEN,$G(AP PTARY("CHE CKOUT USER ")),0)
  8141   "RTN","SDM XMAKE",140 ,0)
  8142    . ;
  8143   "RTN","SDM XMAKE",141 ,0)
  8144    . S SCEIE N=OUTENC_" ,"
  8145   "RTN","SDM XMAKE",142 ,0)
  8146    . I (APPT STAT="CANC ELLED"),(' $$INSTRING ^SDMXCORE( ENCSTAT,"5 ,9")) D  Q
  8147   "RTN","SDM XMAKE",143 ,0)
  8148    . . I CNT YPE="C" S  SCEFDA(409 .68,SCEIEN ,".12")=5  ;cancelled  by clinic
  8149   "RTN","SDM XMAKE",144 ,0)
  8150    . . I CNT YPE="PC" S  SCEFDA(40 9.68,SCEIE N,".12")=9  ;patient  cancelled
  8151   "RTN","SDM XMAKE",145 ,0)
  8152    . . I $D( SCEFDA(409 .68,SCEIEN ,".12")) D  FILE^DIE( "","SCEFDA ","")
  8153   "RTN","SDM XMAKE",146 ,0)
  8154    . ;
  8155   "RTN","SDM XMAKE",147 ,0)
  8156    . I (APPT STAT="NOSH OW"),('$$I NSTRING^SD MXCORE(ENC STAT,"4"))  D  Q
  8157   "RTN","SDM XMAKE",148 ,0)
  8158    . . S SCE FDA(409.68 ,SCEIEN,". 12")=4 ;No  show
  8159   "RTN","SDM XMAKE",149 ,0)
  8160    . . D FIL E^DIE(""," SCEFDA","" )
  8161   "RTN","SDM XMAKE",150 ,0)
  8162    ;
  8163   "RTN","SDM XMAKE",151 ,0)
  8164    ;Set up C linic file  for appoi ntment ent ries
  8165   "RTN","SDM XMAKE",152 ,0)
  8166    K DIC,DA, X,Y,DLAYGO
  8167   "RTN","SDM XMAKE",153 ,0)
  8168    I '$D(^SC (CLINIEN," S",0)) S ^ SC(CLINIEN ,"S",0)="^ 44.001DA^^ "
  8169   "RTN","SDM XMAKE",154 ,0)
  8170    I '$D(^SC (CLINIEN," S",APPTDT, 0)) D  I $ G(Y)<1 Q " Error in 4 4.001"
  8171   "RTN","SDM XMAKE",155 ,0)
  8172    . S DIC=" ^SC("_CLIN IEN_",""S" ","
  8173   "RTN","SDM XMAKE",156 ,0)
  8174    . S DA(1) =CLINIEN
  8175   "RTN","SDM XMAKE",157 ,0)
  8176    . S (X,DI NUM)=APPTD T
  8177   "RTN","SDM XMAKE",158 ,0)
  8178    . S DIC(" P")="44.00 1DA",DIC(0 )="L",DLAY GO=44.001
  8179   "RTN","SDM XMAKE",159 ,0)
  8180    . S Y=1 I  '$D(@(DIC _X_")")) D  FILE^DICN
  8181   "RTN","SDM XMAKE",160 ,0)
  8182    ;
  8183   "RTN","SDM XMAKE",161 ,0)
  8184    ; CONSULT  LINKING
  8185   "RTN","SDM XMAKE",162 ,0)
  8186    I $$INSTR ING^SDMXCO RE($G(MSGA RY("STATUS ")),"SCHED ULED,CHECK ED IN,CHEC KED OUT"," ,") D
  8187   "RTN","SDM XMAKE",163 ,0)
  8188    . D CONSL INK(PATIEN ,APPTDT,CL INIEN,COMM ENT,.CONSA RY,.ORDARY )
  8189   "RTN","SDM XMAKE",164 ,0)
  8190    . S CSLTI EN=$G(CONS ARY(1))
  8191   "RTN","SDM XMAKE",165 ,0)
  8192    ;
  8193   "RTN","SDM XMAKE",166 ,0)
  8194    ;Set up f iling data  arrays an d find if  the appoin tment alre ady exists
  8195   "RTN","SDM XMAKE",167 ,0)
  8196    K DIC,DA, X,Y,DLAYGO ,DINUM
  8197   "RTN","SDM XMAKE",168 ,0)
  8198    S DIC="^S C("_CLINIE N_",""S"", "_APPTDT_" ,1,"
  8199   "RTN","SDM XMAKE",169 ,0)
  8200    S DA(2)=C LINIEN,DA( 1)=APPTDT, X=PATIEN ; Set node l evels 2, 1  and index
  8201   "RTN","SDM XMAKE",170 ,0)
  8202    S DIC("P" )="44.003P A",DIC(0)= "L",DLAYGO =44.003
  8203   "RTN","SDM XMAKE",171 ,0)
  8204    D ^DIC      ;Found c linic line  earlier,  search is  no longer  necessary
  8205   "RTN","SDM XMAKE",172 ,0)
  8206    S CLINLIN E=+$G(Y)
  8207   "RTN","SDM XMAKE",173 ,0)
  8208    ;File the  data
  8209   "RTN","SDM XMAKE",174 ,0)
  8210    I (CLINLI NE<1) D  ; Create a n ew entry i f none are  found
  8211   "RTN","SDM XMAKE",175 ,0)
  8212    . S DIC(" DR")="1/// /"_DURATIO N_";3////" _$S(COMMEN T="":"@",1 :"^S X=COM MENT")_";7 ////"_USER DUZ_";8/// /"_MADEON_ ";30////"_ $G(PATELIG )_";688/// /"_$G(CSLT IEN)
  8213   "RTN","SDM XMAKE",176 ,0)
  8214    . D FILE^ DICN
  8215   "RTN","SDM XMAKE",177 ,0)
  8216    . S CLINL INE=+$G(Y)
  8217   "RTN","SDM XMAKE",178 ,0)
  8218    E  D    ; Update an  existing e ntry
  8219   "RTN","SDM XMAKE",179 ,0)
  8220    . S DIE=D IC  ;DIE n ow holds t he subfile 's root
  8221   "RTN","SDM XMAKE",180 ,0)
  8222    . S DA=CL INLINE  ;+ Y contains  the inter nal entry  number of  subentry c hosen
  8223   "RTN","SDM XMAKE",181 ,0)
  8224    . S DR="1 ////"_DURA TION_";3// //"_$S(COM MENT="":"@ ",1:"^S X= COMMENT")_ ";30////"_ $G(PATELIG )_";688/// /"_$G(CSLT IEN) ;Remo ved ";7/// /"_USERDUZ _
  8225   "RTN","SDM XMAKE",182 ,0)
  8226    . D ^DIE
  8227   "RTN","SDM XMAKE",183 ,0)
  8228    ;Call eve nt driver  on newly c reated app ointments  only
  8229   "RTN","SDM XMAKE",184 ,0)
  8230    I ISNWAPP T D EVT(PA TIEN,APPTD T,CLINIEN, CLINLINE)
  8231   "RTN","SDM XMAKE",185 ,0)
  8232    Q 1
  8233   "RTN","SDM XMAKE",186 ,0)
  8234   EVT(DFN,SD ,SC,SDY) ; handle eve nt logging  directly  to avoid C I/CO promp t
  8235   "RTN","SDM XMAKE",187 ,0)
  8236    S DFN=$G( DFN),SD=$G (SD),SC=$G (SC),SDY=$ G(SDY),U=$ G(U) ;Vari able names  are impor tant- prot ocols assu me they're  set
  8237   "RTN","SDM XMAKE",188 ,0)
  8238    N SDATA,S DMKHDL,SDH DL
  8239   "RTN","SDM XMAKE",189 ,0)
  8240    S (SDATA, SDMKHDL,SD HDL)=""
  8241   "RTN","SDM XMAKE",190 ,0)
  8242    K ^TMP("S DAMEVT",$J )
  8243   "RTN","SDM XMAKE",191 ,0)
  8244    S SDMKHDL =$$HANDLE^ SDAMEVT(1)
  8245   "RTN","SDM XMAKE",192 ,0)
  8246    S (^TMP(" SDAMEVT",$ J,"BEFORE" ,"DPT"),^T MP("SDAMEV T",$J,"BEF ORE","SC") ,SDATA("BE FORE","STA TUS"),^TMP ("SDAMEVT" ,$J,"BEFOR E","STATUS "),^TMP("S DEVT",$J,S DMKHDL,1," DPT",0,"BE FORE"),^TM P("SDEVT", $J,SDMKHDL ,1,"SC",0, "BEFORE")) =""
  8247   "RTN","SDM XMAKE",193 ,0)
  8248    D AFTER^S DAMEVT(.SD ATA,DFN,SD ,SC,$G(SDY ),SDMKHDL)
  8249   "RTN","SDM XMAKE",194 ,0)
  8250    S SDATA=$ G(SDY)_U_D FN_U_SD_U_ SC
  8251   "RTN","SDM XMAKE",195 ,0)
  8252    D EVT^SDA MEVT(.SDAT A,1,+$G(SD AMODE),SDM KHDL)
  8253   "RTN","SDM XMAKE",196 ,0)
  8254    Q
  8255   "RTN","SDM XMAKE",197 ,0)
  8256   PTFU(DFN,S C)    ;Det ermine if  this is a  follow-up  (return to  clinic wi thin 24 mo nths)
  8257   "RTN","SDM XMAKE",198 ,0)
  8258    ;Input: D FN=patient  ifn
  8259   "RTN","SDM XMAKE",199 ,0)
  8260    ;Input: S C=clinic i fn
  8261   "RTN","SDM XMAKE",200 ,0)
  8262    ;Output:  '1' if see n within 2 4 months,  '0' otherw ise
  8263   "RTN","SDM XMAKE",201 ,0)
  8264    S DFN=$G( DFN),SC=$G (SC),U=$G( U)
  8265   "RTN","SDM XMAKE",202 ,0)
  8266    I ($G(DFN )="")!($G( SC)="") Q  0  ;variab le check
  8267   "RTN","SDM XMAKE",203 ,0)
  8268    N SDBDT,S DT,SDX,SDY ,SDCP,SDCP 1,SC0,SDEN C,SDENC0,S DCT
  8269   "RTN","SDM XMAKE",204 ,0)
  8270    S (SDBDT, SDT,SDX,SD Y,SDCP,SDC P1,SC0,SDE NC,SDENC0, SDCT)=""
  8271   "RTN","SDM XMAKE",205 ,0)
  8272    ;set up v ariables
  8273   "RTN","SDM XMAKE",206 ,0)
  8274    S SDBDT=( $G(DT)-200 00)+.24,SD T=$G(DT)_. 999999,(SD CT,SDY)=0
  8275   "RTN","SDM XMAKE",207 ,0)
  8276    S SC0=$G( ^SC(+SC,0) ),SDX=$$CP AIR^SCRPW7 1($G(SC0), .SDCP)  ;g et credit  pair for t his clinic
  8277   "RTN","SDM XMAKE",208 ,0)
  8278    ;Iterate  through en counters
  8279   "RTN","SDM XMAKE",209 ,0)
  8280    F  S SDT= $O(^SCE("A DFN",DFN,S DT),-1) Q: ((SDT<SDBD T)!(SDY))   D
  8281   "RTN","SDM XMAKE",210 ,0)
  8282    . S SDENC =0 F  S SD ENC=$O(^SC E("ADFN",D FN,SDT,SDE NC)) Q:((' SDENC)!(SD Y))  D
  8283   "RTN","SDM XMAKE",211 ,0)
  8284    . . S SDE NC0=$G(^SC E(SDENC,0) )  ;get en counter no de
  8285   "RTN","SDM XMAKE",212 ,0)
  8286    . . Q:$P( SDENC0,U,6 )  ;parent  encounter s only
  8287   "RTN","SDM XMAKE",213 ,0)
  8288    . . S SDX =$P(SDENC0 ,U,4) Q:'S DX  ;get c linic
  8289   "RTN","SDM XMAKE",214 ,0)
  8290    . . S SC0 =$G(^SC(SD X,0))
  8291   "RTN","SDM XMAKE",215 ,0)
  8292    . . S SDX =$$CPAIR^S CRPW71(SC0 ,.SDCP1)   ;get credi t pair for  encounter
  8293   "RTN","SDM XMAKE",216 ,0)
  8294    . . S SDY =SDCP=SDCP 1  ;compar e credit p airs
  8295   "RTN","SDM XMAKE",217 ,0)
  8296    . . S SDC T=SDCT+1 W :SDCT#10=0  "."
  8297   "RTN","SDM XMAKE",218 ,0)
  8298    . . Q
  8299   "RTN","SDM XMAKE",219 ,0)
  8300    . Q
  8301   "RTN","SDM XMAKE",220 ,0)
  8302    Q SDY
  8303   "RTN","SDM XMAKE",221 ,0)
  8304   CSLTAPTS(G MRIEN,APPT DT,CLINIEN ,COUNT) ;  Check if c onsult is  linked to  any other  appointmen ts
  8305   "RTN","SDM XMAKE",222 ,0)
  8306    ; Returns  1 if it i s linked t o at least  one other  appointme nt
  8307   "RTN","SDM XMAKE",223 ,0)
  8308    ; GMRIEN  - Consult  to check
  8309   "RTN","SDM XMAKE",224 ,0)
  8310    ; APPTDT  - Date tim e that app ointment i s schduled  for consu lts
  8311   "RTN","SDM XMAKE",225 ,0)
  8312    ; CLINIEN  - Clinic  appointmen t is sched uled in
  8313   "RTN","SDM XMAKE",226 ,0)
  8314    ; Count -  node on a ppt date/t ime that c orresponds  to the ap pointment.
  8315   "RTN","SDM XMAKE",227 ,0)
  8316    S GMRIEN= $G(GMRIEN) ,APPTDT=$G (APPTDT),C LINIEN=$G( CLINIEN),C OUNT=$G(CO UNT)
  8317   "RTN","SDM XMAKE",228 ,0)
  8318    I (GMRIEN ="")!(APPT DT="")!(CL INIEN="")! (COUNT="")  Q 0
  8319   "RTN","SDM XMAKE",229 ,0)
  8320    I $O(^SC( "AWAS1",GM RIEN,CLINI EN))'="" Q  1
  8321   "RTN","SDM XMAKE",230 ,0)
  8322    I $O(^SC( "AWAS1",GM RIEN,CLINI EN),-1)'=" " Q 1
  8323   "RTN","SDM XMAKE",231 ,0)
  8324    I $O(^SC( "AWAS1",GM RIEN,CLINI EN,APPTDT) )'="" Q 1
  8325   "RTN","SDM XMAKE",232 ,0)
  8326    I $O(^SC( "AWAS1",GM RIEN,CLINI EN,APPTDT) ,-1)'="" Q  1
  8327   "RTN","SDM XMAKE",233 ,0)
  8328    I $O(^SC( "AWAS1",GM RIEN,CLINI EN,APPTDT, COUNT))'=" " Q 1
  8329   "RTN","SDM XMAKE",234 ,0)
  8330    I $O(^SC( "AWAS1",GM RIEN,CLINI EN,APPTDT, COUNT),-1) '="" Q 1
  8331   "RTN","SDM XMAKE",235 ,0)
  8332    Q 0
  8333   "RTN","SDM XMAKE",236 ,0)
  8334    ;
  8335   "RTN","SDM XMAKE",237 ,0)
  8336   CONSLINK(P ATIEN,APPT DT,CLINIEN ,COMMENT,C ONSARY,ORD ARY) ; Con sult and o rder linki ng
  8337   "RTN","SDM XMAKE",238 ,0)
  8338    ;
  8339   "RTN","SDM XMAKE",239 ,0)
  8340    ;
  8341   "RTN","SDM XMAKE",240 ,0)
  8342    N COUNT,T MPD,TMPCOM ,TMPYCLNC, ORDPERF,OL DCNSLT,ORD NUM,ORDERI D,CONSID,C ONSNUM,IGN STATS,STAT US,OK
  8343   "RTN","SDM XMAKE",241 ,0)
  8344    S (COUNT, TMPD,TMPCO M,TMPYCLNC ,ORDPERF,O LDCNSLT,OR DNUM,ORDER ID,CONSID, CONSNUM,IG NSTATS)=""
  8345   "RTN","SDM XMAKE",242 ,0)
  8346    ;
  8347   "RTN","SDM XMAKE",243 ,0)
  8348    ; Consult  statuses  that we do n't want t o update t o schedule d: Discont inued,Comp lete,Parti al Results ,Discontin ued/edit,c ancelled
  8349   "RTN","SDM XMAKE",244 ,0)
  8350    S IGNSTAT S="1,2,8,9 ,12,13"
  8351   "RTN","SDM XMAKE",245 ,0)
  8352    ;
  8353   "RTN","SDM XMAKE",246 ,0)
  8354    S COUNT=$ $FIND^SDAM 2(PATIEN,A PPTDT,CLIN IEN)
  8355   "RTN","SDM XMAKE",247 ,0)
  8356    S COMMENT =$S($L($G( COMMENT))> 150:$E($G( COMMENT),1 ,149)_"*", 1:$G(COMME NT)) ;trun cate if lo nger han 1 50 charact ers
  8357   "RTN","SDM XMAKE",248 ,0)
  8358    S (TMPD,T MPCOM)=COM MENT,TMPYC LNC=CLINIE N_"^"_$P($ G(^SC(CLIN IEN,0)),"^ ")
  8359   "RTN","SDM XMAKE",249 ,0)
  8360    I COUNT'= "" S OLDCN SLT=$G(^SC (CLINIEN," S",APPTDT, 1,COUNT,"C ONS"))
  8361   "RTN","SDM XMAKE",250 ,0)
  8362    ;
  8363   "RTN","SDM XMAKE",251 ,0)
  8364    ; Link ne w consults  if they a ren't alre ady schedu led
  8365   "RTN","SDM XMAKE",252 ,0)
  8366    F CONSNUM =1:1:$G(CO NSARY(0))  D
  8367   "RTN","SDM XMAKE",253 ,0)
  8368    . S CONSI D=$G(CONSA RY(CONSNUM ))
  8369   "RTN","SDM XMAKE",254 ,0)
  8370    . S STATU S=$P($G(^G MR(123,CON SID,0)),"^ ",12)
  8371   "RTN","SDM XMAKE",255 ,0)
  8372    . I $$INS TRING^SDMX CORE(STATU S,IGNSTATS ,",") Q
  8373   "RTN","SDM XMAKE",256 ,0)
  8374    . D EDITC S^SDCNSLT( APPTDT,TMP D,TMPYCLNC ,CONSID) ;  Mark as s cheduled
  8375   "RTN","SDM XMAKE",257 ,0)
  8376    . D TRUPD MSG^ORMXTR (CONSID) ;  Update th e status o f the cons ult in MAS S by trigg ering an u pdate mess age
  8377   "RTN","SDM XMAKE",258 ,0)
  8378    ;
  8379   "RTN","SDM XMAKE",259 ,0)
  8380    ;Unlink o ld consult  if it is  no longer  in the lis t of curre nt linked  consults
  8381   "RTN","SDM XMAKE",260 ,0)
  8382    I ($G(OLD CNSLT)'="" ),('$$INST RING^SDMXC ORE(OLDCNS LT,CONSARY ,",")),'$$ CSLTAPTS(O LDCNSLT,AP PTDT,CLINI EN,COUNT)  D
  8383   "RTN","SDM XMAKE",261 ,0)
  8384    . S OK=$$ UPCONREQ^S DMXCANC(CL INIEN,APPT DT,"C",COU NT)
  8385   "RTN","SDM XMAKE",262 ,0)
  8386    ;
  8387   "RTN","SDM XMAKE",263 ,0)
  8388    ; Update  order stat uses to "C omplte" if  they are  to be comp leted.
  8389   "RTN","SDM XMAKE",264 ,0)
  8390    F ORDNUM= 1:1:$G(ORD ARY(0)) D
  8391   "RTN","SDM XMAKE",265 ,0)
  8392    . S ORDER ID=$G(ORDA RY(ORDNUM) )
  8393   "RTN","SDM XMAKE",266 ,0)
  8394    . I ORDER ID="" Q
  8395   "RTN","SDM XMAKE",267 ,0)
  8396    . S ORDPE RF=$G(^OR( 100,ORDERI D,.1,1,0))  ;what is  the perfor mable?
  8397   "RTN","SDM XMAKE",268 ,0)
  8398    . I ($G(O RDPERF)'=" "),($P($G( ^ORD(101.4 3,ORDPERF, 0)),"^",9) =2) D STAT US^ORCSAVE 2(ORDERID, 2) ;perfor mable item  11 says i f interfac e should c omplete or der or not
  8399   "RTN","SDM XMAKE",269 ,0)
  8400    Q  ;;#eor #
  8401   "RTN","SDM XNS")
  8402   0^35^B1788 4729
  8403   "RTN","SDM XNS",1,0)
  8404   SDMXNS ;MA SS/PJS - A ppointment  No-Show A PI;8/30/17  ;2018-05- 29 10:26:0 3;8.3;hZa8 8li/xGWF65 WGC2jCWqgK 3zcP8EKuJ4 GAgegZT/Q=
  8405   "RTN","SDM XNS",2,0)
  8406    ;;5.3;Sch eduling;** 676**;AUGU ST 30,2017 ;Build 99
  8407   "RTN","SDM XNS",3,0)
  8408    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  8409   "RTN","SDM XNS",4,0)
  8410    ;  ICR#   Supported
  8411   "RTN","SDM XNS",5,0)
  8412    ;  5729   $$FIND^SDA M2
  8413   "RTN","SDM XNS",6,0)
  8414    ;  10103   $$NOW^XLF DT
  8415   "RTN","SDM XNS",7,0)
  8416    ;  2053   FILE^DIE
  8417   "RTN","SDM XNS",8,0)
  8418    ;  10040   ^SC
  8419   "RTN","SDM XNS",9,0)
  8420    Q
  8421   "RTN","SDM XNS",10,0)
  8422   NOSHOW(DFN ,APPDT,USE R,CLINIC,C ONSARY) ;  turns an a ppointment  into a no -show
  8423   "RTN","SDM XNS",11,0)
  8424    ;  DFN (I ,REQ) - In ternal ID  for the pa tient
  8425   "RTN","SDM XNS",12,0)
  8426    ;  APPDT  (I,REQ) -  VistA date  time for  the appoin tment
  8427   "RTN","SDM XNS",13,0)
  8428    ;  USER ( I,REQ) - U ser Id for  who is no -showing t he order
  8429   "RTN","SDM XNS",14,0)
  8430    ;  CLINIC  (I,REQ) -  Clinic IE N that the  appointme nt occurs  in
  8431   "RTN","SDM XNS",15,0)
  8432    ;  CONSAR Y (I,OPT)   - Array o f consults  that were  linked.   top node i s list of  consults.  0 node is
  8433   "RTN","SDM XNS",16,0)
  8434    ;                      count of  consults,  and other  numbered  nodes are  the nth co nsult.
  8435   "RTN","SDM XNS",17,0)
  8436    N MASSFDA ,MASSIENS, MASSMSG,AP PTSTRING,S DATA,SDDA, SDNSHDL,U, SDENC0,SDA MODE
  8437   "RTN","SDM XNS",18,0)
  8438    N SCEFDA, OUTENC,SCE IEN
  8439   "RTN","SDM XNS",19,0)
  8440    S DFN=$G( DFN),APPDT =$G(APPDT) ,USER=$G(U SER),CLINI C=$G(CLINI C),U="^"
  8441   "RTN","SDM XNS",20,0)
  8442    S SDNSHDL =$$HANDLE^ SDAMEVT(1)   ; setup  event hand le
  8443   "RTN","SDM XNS",21,0)
  8444    S SDDA=$$ FIND^SDAM2 (DFN,APPDT ,CLINIC)   ;setup SDD A - number  of appoin tment node  in SC
  8445   "RTN","SDM XNS",22,0)
  8446    D BEFORE^ SDAMEVT(.S DATA,DFN,A PPDT,CLINI C,SDDA,SDN SHDL)  ; S et up befo re state
  8447   "RTN","SDM XNS",23,0)
  8448    S MASSIEN S=APPDT_", "_DFN_","
  8449   "RTN","SDM XNS",24,0)
  8450    S MASSFDA (2.98,MASS IENS,"3")= "N" ;STATU S. COMMENT ED WOULD H ANDLE INPA TIENT
  8451   "RTN","SDM XNS",25,0)
  8452    S MASSFDA (2.98,MASS IENS,"14") =USER   ;  USER
  8453   "RTN","SDM XNS",26,0)
  8454    S MASSFDA (2.98,MASS IENS,"15") =$$NOW^XLF DT()
  8455   "RTN","SDM XNS",27,0)
  8456    D FILE^DI E("","MASS FDA","MASS MSG")
  8457   "RTN","SDM XNS",28,0)
  8458    ;
  8459   "RTN","SDM XNS",29,0)
  8460    S OUTENC= $P($G(^DPT (DFN,"S",A PPDT,0))," ^",20)
  8461   "RTN","SDM XNS",30,0)
  8462    I (OUTENC '=""),$D(^ SCE(OUTENC )) D
  8463   "RTN","SDM XNS",31,0)
  8464    . S SCEIE N=OUTENC_" ,"
  8465   "RTN","SDM XNS",32,0)
  8466    . S SCEFD A(409.68,S CEIEN,".12 ")=4 ;No S how
  8467   "RTN","SDM XNS",33,0)
  8468    . D FILE^ DIE("","SC EFDA","")
  8469   "RTN","SDM XNS",34,0)
  8470    ;
  8471   "RTN","SDM XNS",35,0)
  8472    D AFTER^S DAMEVT(.SD ATA,DFN,AP PDT,CLINIC ,SDDA,SDNS HDL)
  8473   "RTN","SDM XNS",36,0)
  8474    D EVT(.SD ATA,DFN,AP PDT,CLINIC ,SDDA,SDNS HDL,.CONSA RY)  ; cal l event pr otocol/aft er state
  8475   "RTN","SDM XNS",37,0)
  8476    ;
  8477   "RTN","SDM XNS",38,0)
  8478    Q $G(MASS MSG)
  8479   "RTN","SDM XNS",39,0)
  8480   UNNOSHOW(D FN,APPDT,N OOP,CLINIC ) ; revert s an appoi ntment fro m a no sho w to a sch eduled sta tus
  8481   "RTN","SDM XNS",40,0)
  8482    ;  DFN (I ,REQ) - ID  for thepa tient
  8483   "RTN","SDM XNS",41,0)
  8484    ;  APPDT  (I,REQ) -  VistA date  time for  the appoin tment
  8485   "RTN","SDM XNS",42,0)
  8486    ;  NOOP ( I,OPT)  -  no operati on - param eter depre cated
  8487   "RTN","SDM XNS",43,0)
  8488    ;  CLINIC  (I,REQ) -  Clinic IE N that the  appointme nt occurs  in
  8489   "RTN","SDM XNS",44,0)
  8490    ;  ORDARY  (I,OPT)   - Array of  orders th at were sc heduled.   top node i s list of  orders. 0  node is
  8491   "RTN","SDM XNS",45,0)
  8492    ;                      count of  orders, a nd other n umbered no des are th e nth orde r.
  8493   "RTN","SDM XNS",46,0)
  8494    N MASSFDA ,MASSIENS, MASSMSG,SD NSHDL,SDDA ,SDATA,TMP YCLNC,TMPD ,SCNAME,U
  8495   "RTN","SDM XNS",47,0)
  8496    N SCEFDA, OUTENC,SCE IEN
  8497   "RTN","SDM XNS",48,0)
  8498    S DFN=$G( DFN),APPDT =$G(APPDT) ,CNSLTLNK= $G(CNSLTLN K),CLINIC= $G(CLINIC) ,U="^"
  8499   "RTN","SDM XNS",49,0)
  8500    S SDNSHDL =$$HANDLE^ SDAMEVT(1)  ; setup e vent handl e
  8501   "RTN","SDM XNS",50,0)
  8502    S SDDA=$$ FIND^SDAM2 (DFN,APPDT ,CLINIC)
  8503   "RTN","SDM XNS",51,0)
  8504    ;D BEFORE ^SDAMEVT(. SDATA,DFN, APPDT,CLIN IC,SDDA,SD NSHDL)
  8505   "RTN","SDM XNS",52,0)
  8506    S MASSIEN S=APPDT_", "_DFN_","
  8507   "RTN","SDM XNS",53,0)
  8508    S MASSFDA (2.98,MASS IENS,"3")= "@" ;STATU S. COMMENT ED WOULD H ANDLE INPA TIENT
  8509   "RTN","SDM XNS",54,0)
  8510    S MASSFDA (2.98,MASS IENS,"14") ="@"   ; U SER
  8511   "RTN","SDM XNS",55,0)
  8512    S MASSFDA (2.98,MASS IENS,"15") ="@"
  8513   "RTN","SDM XNS",56,0)
  8514    D FILE^DI E("","MASS FDA","MASS MSG")
  8515   "RTN","SDM XNS",57,0)
  8516    ;
  8517   "RTN","SDM XNS",58,0)
  8518    ; Remove  all check  in/out dat a in the " C" node
  8519   "RTN","SDM XNS",59,0)
  8520    i SDDA'=" " d
  8521   "RTN","SDM XNS",60,0)
  8522    . I $G(^S C(CLINIC," S",APPDT,1 ,SDDA,"C") )="" q
  8523   "RTN","SDM XNS",61,0)
  8524    . K MASSI ENS,MASSFD A
  8525   "RTN","SDM XNS",62,0)
  8526    . S MASSI ENS=SDDA_" ,"_APPDT_" ,"_CLINIC_ ","
  8527   "RTN","SDM XNS",63,0)
  8528    . S MASSF DA(44.003, MASSIENS,3 02)="@"
  8529   "RTN","SDM XNS",64,0)
  8530    . S MASSF DA(44.003, MASSIENS,3 03)="@"
  8531   "RTN","SDM XNS",65,0)
  8532    . S MASSF DA(44.003, MASSIENS,3 04)="@"
  8533   "RTN","SDM XNS",66,0)
  8534    . S MASSF DA(44.003, MASSIENS,3 05)="@"
  8535   "RTN","SDM XNS",67,0)
  8536    . S MASSF DA(44.003, MASSIENS,3 06)="@"
  8537   "RTN","SDM XNS",68,0)
  8538    . S MASSF DA(44.003, MASSIENS,3 09)="@"
  8539   "RTN","SDM XNS",69,0)
  8540    . D FILE^ DIE("","MA SSFDA","")
  8541   "RTN","SDM XNS",70,0)
  8542    . ;Remove  the C nod e which no  longer ha s any data :
  8543   "RTN","SDM XNS",71,0)
  8544    . K ^SC(C LINIC,"S", APPDT,1,SD DA,"C")
  8545   "RTN","SDM XNS",72,0)
  8546    ;
  8547   "RTN","SDM XNS",73,0)
  8548    ;D AFTER^ SDAMEVT(.S DATA,DFN,A PPDT,CLINI C,SDDA,SDN SHDL)
  8549   "RTN","SDM XNS",74,0)
  8550    ;D EVT(.S DATA,DFN,A PPDT,CLINI C,SDDA,SDN SHDL)
  8551   "RTN","SDM XNS",75,0)
  8552    S OUTENC= $P($G(^DPT (DFN,"S",A PPDT,0))," ^",20)
  8553   "RTN","SDM XNS",76,0)
  8554    I (OUTENC '=""),$D(^ SCE(OUTENC )) D
  8555   "RTN","SDM XNS",77,0)
  8556    . S SCEIE N=OUTENC_" ,"
  8557   "RTN","SDM XNS",78,0)
  8558    . S SCEFD A(409.68,S CEIEN,".12 ")=14 ;No  Show
  8559   "RTN","SDM XNS",79,0)
  8560    . D FILE^ DIE("","SC EFDA","")
  8561   "RTN","SDM XNS",80,0)
  8562    ;Relink c onsult mov ed to upda te
  8563   "RTN","SDM XNS",81,0)
  8564    ;I CNSLTL NK="" Q $G (MASSMSG)
  8565   "RTN","SDM XNS",82,0)
  8566    ;D LINK^S DCNSLT(CLI NIC,SDDA,A PPDT,CNSLT LNK)
  8567   "RTN","SDM XNS",83,0)
  8568    ;S SCNAME =$P($G(^SC (CLINIC,0) ),"^")
  8569   "RTN","SDM XNS",84,0)
  8570    ;S TMPYCL NC=CLINIC_ U_SCNAME
  8571   "RTN","SDM XNS",85,0)
  8572    ;S TMPD=$ P($G(^SC(C LINIC,"S", APPDT,1,SD DA,0)),"^" ,4)
  8573   "RTN","SDM XNS",86,0)
  8574    ;D EDITCS ^SDCNSLT(A PPDT,TMPD, TMPYCLNC,C NSLTLNK)
  8575   "RTN","SDM XNS",87,0)
  8576    Q $G(MASS MSG)
  8577   "RTN","SDM XNS",88,0)
  8578   EVT(SDATA, DFN,SDDTM, CLINIC,SDD A,SDNSHDL, CONSARY) ;  calls int o the cons ult linkin g and no s how event  driver
  8579   "RTN","SDM XNS",89,0)
  8580    ;  SDATA  (IO,REQ) -  State dat a about th e appointm ent
  8581   "RTN","SDM XNS",90,0)
  8582    ;  DFN (I ,REQ) - IE N for pati ent
  8583   "RTN","SDM XNS",91,0)
  8584    ;  SDDTM  (I,REQ) -  internal a ppointment  date/time
  8585   "RTN","SDM XNS",92,0)
  8586    ;  CLINIC  (I,REQ) -  clinic IE N
  8587   "RTN","SDM XNS",93,0)
  8588    ;  SDDA ( I,REQ) - n umber of a ppointment  node in ^ SC global
  8589   "RTN","SDM XNS",94,0)
  8590    ;  SDNSHD L (I,REQ)  - even han dle
  8591   "RTN","SDM XNS",95,0)
  8592    ;  CONSAR Y (I,OPT)   - Array o f consults  that were  linked.   top node i s list of  consults.  0 node is
  8593   "RTN","SDM XNS",96,0)
  8594    ;                       count o f consults , and othe r numbered  nodes are  the nth c onsult.
  8595   "RTN","SDM XNS",97,0)
  8596    N I,SDINP ,Y,SDSTAT, SDTIME,SDY ES,SM,SM1, CONSNODE
  8597   "RTN","SDM XNS",98,0)
  8598    N SD1,SD2 ,SDMSG,SDT ,SDCT,CNST LNK,CN,CNP AT,DONE
  8599   "RTN","SDM XNS",99,0)
  8600    S DFN=$G( DFN),SDDTM =$G(SDDTM) ,CLINIC=$G (CLINIC),S DDA=$G(SDD A),SDNSHDL =$G(SDNSHD L)
  8601   "RTN","SDM XNS",100,0 )
  8602    I (DFN="" )!(SDDTM=" ")!(SDDA=" "),(CLINIC ="") Q
  8603   "RTN","SDM XNS",101,0 )
  8604    S U="^"
  8605   "RTN","SDM XNS",102,0 )
  8606    ; D NOSHO W^SDAMEVT( .SDATA,DFN ,SDDTM,CLI NIC,SDDA,0 ,SDNSHDL)
  8607   "RTN","SDM XNS",103,0 )
  8608    S SDATA=S DDA_U_DFN_ U_SDDTM_U_ CLINIC
  8609   "RTN","SDM XNS",104,0 )
  8610    D EVT^SDA MEVT(.SDAT A,3,0,SDNS HDL)
  8611   "RTN","SDM XNS",105,0 )
  8612    S CNSTLNK =$P($G(^SC (CLINIC,"S ",SDDTM,1, SDDA,"CONS ")),U)
  8613   "RTN","SDM XNS",106,0 )
  8614    ;
  8615   "RTN","SDM XNS",107,0 )
  8616    I (CNSTLN K'=""),('$ $INSTRING^ SDMXCORE(C NSTLNK,$G( CONSARY)," ,")) D
  8617   "RTN","SDM XNS",108,0 )
  8618    . S CONSA RY(0)=$G(C ONSARY(0)) +1
  8619   "RTN","SDM XNS",109,0 )
  8620    . S CONSA RY(CONSARY (0))=CNSTL NK
  8621   "RTN","SDM XNS",110,0 )
  8622    . I $G(CO NSARY)=""  S CONSARY= CNSTLNK
  8623   "RTN","SDM XNS",111,0 )
  8624    . E  S CO NSARY=CONS ARY_","_CN STLNK
  8625   "RTN","SDM XNS",112,0 )
  8626    ;
  8627   "RTN","SDM XNS",113,0 )
  8628    ; Update  the ^GMR g lobal with  the no sh ow status  status
  8629   "RTN","SDM XNS",114,0 )
  8630    F CONSNOD E=1:1:$G(C ONSARY(0))  D
  8631   "RTN","SDM XNS",115,0 )
  8632    . S CNSTL NK=CONSARY (CONSNODE)
  8633   "RTN","SDM XNS",116,0 )
  8634    . I $$CSL TAPTS^SDMX MAKE(CNSTL NK,SDDTM,C LINIC,SDDA ) Q  ; don 't update  status for  consults  attached t o other ap pts
  8635   "RTN","SDM XNS",117,0 )
  8636    . D NOSHO W^SDCNSLT( CLINIC,SDD TM,DFN,CNS TLNK,SDDA)
  8637   "RTN","SDM XNS",118,0 )
  8638    ;
  8639   "RTN","SDM XNS",119,0 )
  8640    Q    ;
  8641   "RTN","SDM XNS",120,0 )
  8642    Q  ;;#eor #
  8643   "RTN","SDM XPOST")
  8644   0^44^B2034 392
  8645   "RTN","SDM XPOST",1,0 )
  8646   SDMXPOST ;  MASS/MKN  - Post-ins tall routi ne;12/13/2 017
  8647   "RTN","SDM XPOST",2,0 )
  8648    ;;5.3;Sch eduling;** 676**;Dece mber 13,20 17;Build 9 9
  8649   "RTN","SDM XPOST",3,0 )
  8650    ;VA DIREC TIVE 6402,  this rout ine should  not be mo dified.
  8651   "RTN","SDM XPOST",4,0 )
  8652    ;
  8653   "RTN","SDM XPOST",5,0 )
  8654   EN ;The ac tual post  install do es nothing . The purp ose of thi s routine  is
  8655   "RTN","SDM XPOST",6,0 )
  8656    ; to prov ide a "bac k out" fun ction at t ag BACKOUT
  8657   "RTN","SDM XPOST",7,0 )
  8658    Q
  8659   "RTN","SDM XPOST",8,0 )
  8660    ;
  8661   "RTN","SDM XPOST",9,0 )
  8662   BACKOUT ;
  8663   "RTN","SDM XPOST",10, 0)
  8664    N FN,FNA, IEN97,N,NA ,X
  8665   "RTN","SDM XPOST",11, 0)
  8666    S IEN97=$ O(^XPD(9.7 ,"B","SD*5 .3*676","" ),-1),TEMP ="Temporar y backup f ile:"
  8667   "RTN","SDM XPOST",12, 0)
  8668    I 'IEN97  W !,"SD*5. 3*676 Inst all not fo und" Q
  8669   "RTN","SDM XPOST",13, 0)
  8670    S N=0,NA= "" F  S N= $O(^XPD(9. 7,IEN97,"M ES",N)) Q: N=""  S X= ^XPD(9.7,I EN97,"MES" ,N,0) D
  8671   "RTN","SDM XPOST",14, 0)
  8672    .I $E(X,1 ,$L(TEMP)) =TEMP S NA =$P(X,":", 2)
  8673   "RTN","SDM XPOST",15, 0)
  8674    I NA="" W  !,"Backup  file name  not found  in instal lation fil e" Q
  8675   "RTN","SDM XPOST",16, 0)
  8676    W !,"Back up file "_ TEMP_" fou nd; restor e commenci ng..."
  8677   "RTN","SDM XPOST",17, 0)
  8678    S FN=44 S  FNA="File  "_FN W !, "Restoring  data dict ionary for  file #"_F N_"..." D
  8679   "RTN","SDM XPOST",18, 0)
  8680    .I '$D(@N A@(FNA)) W  !,"File # "_FN_" not  found in  backup fil e" Q
  8681   "RTN","SDM XPOST",19, 0)
  8682    .K ^DD(FN ) M ^DD(FN )=@NA@(FNA )
  8683   "RTN","SDM XPOST",20, 0)
  8684    W !,"SD*5 .3*676 Bac k out fini shed!"
  8685   "RTN","SDM XPOST",21, 0)
  8686    Q
  8687   "RTN","SDM XPOST",22, 0)
  8688    ;
  8689   "RTN","SDM XPRE")
  8690   0^43^B1473 467
  8691   "RTN","SDM XPRE",1,0)
  8692   SDMXPRE ;  MASS/MKN -  Pre-insta ll routine ;12/13/201 7
  8693   "RTN","SDM XPRE",2,0)
  8694    ;;5.3;Sch eduling;** 676**;Dece mber 13,20 17;Build 9 9
  8695   "RTN","SDM XPRE",3,0)
  8696    ;VA DIREC TIVE 6402,  this rout ine should  not be mo dified.
  8697   "RTN","SDM XPRE",4,0)
  8698    ;
  8699   "RTN","SDM XPRE",5,0)
  8700    ;  ICR#    Supported  Reference s
  8701   "RTN","SDM XPRE",6,0)
  8702    ;  10103   $FMADD^XL FDT
  8703   "RTN","SDM XPRE",7,0)
  8704    ;
  8705   "RTN","SDM XPRE",8,0)
  8706   EN ;Make a  copy of d ata dictio naries for  the files  in patch  SD*5*3*676
  8707   "RTN","SDM XPRE",9,0)
  8708    ;
  8709   "RTN","SDM XPRE",10,0 )
  8710    N FN,NA
  8711   "RTN","SDM XPRE",11,0 )
  8712    D MES^XPD UTL("Pre I nstall rou tine start ing. Savin g data dic tionaries. ..")
  8713   "RTN","SDM XPRE",12,0 )
  8714    S NA=$NA( ^XTMP("SD_ 5_3_676"_$ J)) K @NA  S @NA@(0)= $$FMADD^XL FDT(DT,60) _U_DT
  8715   "RTN","SDM XPRE",13,0 )
  8716    D MES^XPD UTL("This  is the tem porary fil e that wou ld be used  for a ""b ack out"": ")
  8717   "RTN","SDM XPRE",14,0 )
  8718    D MES^XPD UTL("Tempo rary backu p file:"_N A)
  8719   "RTN","SDM XPRE",15,0 )
  8720    S FN=44 D  MES^XPDUT L("Saving  DD for fil e "_FN) M  @NA@("File  "_FN)=^DD (FN)
  8721   "RTN","SDM XPRE",16,0 )
  8722    ;
  8723   "RTN","SDM XPRE",17,0 )
  8724    D MES^XPD UTL("Pre I nstall rou tine ended ")
  8725   "RTN","SDM XPRE",18,0 )
  8726    Q
  8727   "RTN","SDM XPRE",19,0 )
  8728    ;
  8729   "RTN","SDM XSCHI")
  8730   0^36^B1513 65777
  8731   "RTN","SDM XSCHI",1,0 )
  8732   SDMXSCHI ; MASS/RPC,D AP - Incom ing Schedu ling Messa ge Entry P oint;08/22 /2017;2018 -06-01 09: 29:03;8.3; AP1eACn8KA jeoognJN1S hWKXaI8Znp TrpJ9lqgJQ 1wE=
  8733   "RTN","SDM XSCHI",2,0 )
  8734    ;;5.3;Sch eduling;** 676**;AUGU ST 22,2017 ;Build 99
  8735   "RTN","SDM XSCHI",3,0 )
  8736    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  8737   "RTN","SDM XSCHI",4,0 )
  8738    ;  ICR#   Supported
  8739   "RTN","SDM XSCHI",5,0 )
  8740    ;  4718   $$STARTMSG ^HLOPRS(
  8741   "RTN","SDM XSCHI",6,0 )
  8742    ;  4718   $$NEXTSEG^ HLOPRS
  8743   "RTN","SDM XSCHI",7,0 )
  8744    ;  2263   $$GET^XPAR
  8745   "RTN","SDM XSCHI",8,0 )
  8746    ;  4718   $$GET^HLOP RS
  8747   "RTN","SDM XSCHI",9,0 )
  8748    ;  10103   $$HL7TFM^ XLFDT
  8749   "RTN","SDM XSCHI",10, 0)
  8750    ;  ###  $ $TRANORCD^ ORMXFMT
  8751   "RTN","SDM XSCHI",11, 0)
  8752    ;  2056   $$GET1^DIQ
  8753   "RTN","SDM XSCHI",12, 0)
  8754    ;  10103   $$NOW^XLF DT
  8755   "RTN","SDM XSCHI",13, 0)
  8756    ;  10006   ^DIC
  8757   "RTN","SDM XSCHI",14, 0)
  8758    ;  10040   ^SC
  8759   "RTN","SDM XSCHI",15, 0)
  8760    ;  ###     ^OR
  8761   "RTN","SDM XSCHI",16, 0)
  8762    ;  ###    $$VLDPAT^D GMXVLD
  8763   "RTN","SDM XSCHI",17, 0)
  8764    ;
  8765   "RTN","SDM XSCHI",18, 0)
  8766    Q
  8767   "RTN","SDM XSCHI",19, 0)
  8768   PARSEMSG()  ;Primary  entry rout ine for HL O based sc heduling p rocessing.
  8769   "RTN","SDM XSCHI",20, 0)
  8770    ;       W ill take a ll schedul ing messag es through  this one  point.
  8771   "RTN","SDM XSCHI",21, 0)
  8772    ;
  8773   "RTN","SDM XSCHI",22, 0)
  8774    ; FROM HL O processi ng code.
  8775   "RTN","SDM XSCHI",23, 0)
  8776    ;   HLMSG IEN: At th e point HL O calls th is message  handler,  the variab le
  8777   "RTN","SDM XSCHI",24, 0)
  8778    ;              is se t to the I EN of the  message in  the HLO M ESSAGE ADM INISTRATIO N file, #7 79.2.
  8779   "RTN","SDM XSCHI",25, 0)
  8780    ; OUTPUT:
  8781   "RTN","SDM XSCHI",26, 0)
  8782    ;   MSGAR Y - data l ayer of me ssage data  formatted  and ready  to file t o vista. S ee SDMXSCH P for node s
  8783   "RTN","SDM XSCHI",27, 0)
  8784    N $ETRAP, $ESTACK S  $ETRAP="D  LOGSEND^SD MXCORE" ;S ets an err or trap
  8785   "RTN","SDM XSCHI",28, 0)
  8786    D INITINC ^SDMXCORE  ;Indicate  that this  is filing  an incomin g message
  8787   "RTN","SDM XSCHI",29, 0)
  8788    N MSG,HDR ,SEG,SEGTY PE,MSGARY, LASTSEG,HD RTIME,ABOR T,BASEDT,C LINARY,COU NT,PROVDTL ,DFN
  8789   "RTN","SDM XSCHI",30, 0)
  8790    S (MSG,HD R,SEG,SEGT YPE,MSGARY ,LASTSEG,H DRTIME,ABO RT,BASEDT, CLINARY,CO UNT,PROVDT L,DFN)=""
  8791   "RTN","SDM XSCHI",31, 0)
  8792    ; initial ize messag e from que ue
  8793   "RTN","SDM XSCHI",32, 0)
  8794    I '$$STAR TMSG^HLOPR S(.MSG,$G( HLMSGIEN), .HDR) D ER RLOG^SDMXE RRO(99999, "Message I D "_$G(HLM SGIEN)_"no  longer on  queue")
  8795   "RTN","SDM XSCHI",33, 0)
  8796    I $G(HDR( "MESSAGE T YPE"))'="S IU" D ERRL OG^SDMXERR O(200,"Sch eduling me ssage type  not recei ved on sch eduling in terface. M essage typ e received : "_$G(HDR ("MESSAGE  TYPE"))_"  With messa ge control  ID of: "_ $G(HDR("ME SSAGE CONT ROL ID")))
  8797   "RTN","SDM XSCHI",34, 0)
  8798    S HDRTIME =$P($G(HDR (2)),"|",2 )
  8799   "RTN","SDM XSCHI",35, 0)
  8800    S MSGARY( "MESSAGE I EN")=$G(HL MSGIEN)
  8801   "RTN","SDM XSCHI",36, 0)
  8802    ; determi ne schedul ing action  event fro m message  event
  8803   "RTN","SDM XSCHI",37, 0)
  8804    D SETEVEN T($G(HDR(" EVENT")),. MSGARY)
  8805   "RTN","SDM XSCHI",38, 0)
  8806    I $G(MSGA RY("EVENT" ))="" D ER RLOG^SDMXE RRO(201,"E VENT COULD  NOT BE DE TERMINED", 1) Q
  8807   "RTN","SDM XSCHI",39, 0)
  8808    ; Process  segments
  8809   "RTN","SDM XSCHI",40, 0)
  8810    F  Q:('$$ NEXTSEG^HL OPRS(.MSG, .SEG)!$G(A BORT))  D
  8811   "RTN","SDM XSCHI",41, 0)
  8812    . S SEGTY PE=$G(SEG( "SEGMENT T YPE"))
  8813   "RTN","SDM XSCHI",42, 0)
  8814    . I SEGTY PE'="NTE"  S LASTSEG= SEGTYPE
  8815   "RTN","SDM XSCHI",43, 0)
  8816    . ; Proce ss segment s by type
  8817   "RTN","SDM XSCHI",44, 0)
  8818    . I SEGTY PE="SCH" D  SCH(.SEG, .MSGARY,.A BORT,.BASE DT) Q  ;SC H MUST BE  PROCESSED  FIRST SOME  VALIDATIO N DEPENDS  ON APPOINT MENT STATU S IN SCH-2 5
  8819   "RTN","SDM XSCHI",45, 0)
  8820    . I SEGTY PE="NTE" D  NTE(.SEG, .MSGARY,LA STSEG,.CLI NARY,.ABOR T,.PROVDTL ) Q
  8821   "RTN","SDM XSCHI",46, 0)
  8822    . I SEGTY PE="PID" D  PID(.SEG, .MSGARY,.A BORT) Q
  8823   "RTN","SDM XSCHI",47, 0)
  8824    . I SEGTY PE="PV1" D  PV1(.SEG, .MSGARY,HD RTIME,.ABO RT) Q
  8825   "RTN","SDM XSCHI",48, 0)
  8826    . ;Repeat ing segmen t
  8827   "RTN","SDM XSCHI",49, 0)
  8828    . I SEGTY PE="OBX" D  OBX(.SEG, .MSGARY) Q
  8829   "RTN","SDM XSCHI",50, 0)
  8830    . ;Repeat ing segmen t block
  8831   "RTN","SDM XSCHI",51, 0)
  8832    . I SEGTY PE="RGS" D  RGS(.SEG, .MSGARY) Q
  8833   "RTN","SDM XSCHI",52, 0)
  8834    . I SEGTY PE="AIS" D  AIS(.SEG, .MSGARY) Q
  8835   "RTN","SDM XSCHI",53, 0)
  8836    . I SEGTY PE="AIG" D  AIG(.SEG, .MSGARY,.P ROVDTL,BAS EDT) Q
  8837   "RTN","SDM XSCHI",54, 0)
  8838    . I SEGTY PE="AIP" D  AIP(.SEG, .MSGARY,.P ROVDTL,BAS EDT) Q
  8839   "RTN","SDM XSCHI",55, 0)
  8840    ;
  8841   "RTN","SDM XSCHI",56, 0)
  8842    I $G(ABOR T) D DONEI NC^SDMXCOR E Q
  8843   "RTN","SDM XSCHI",57, 0)
  8844    ; Set pat ient DFN
  8845   "RTN","SDM XSCHI",58, 0)
  8846    S DFN=$G( MSGARY("PA TIENT IEN" ))
  8847   "RTN","SDM XSCHI",59, 0)
  8848    I $G(MSGA RY("APPTTY PE"))="" S  MSGARY("A PPTTYPE")= 9   ;Defau lt to regu lar appoin tment type  when none  is select ed.
  8849   "RTN","SDM XSCHI",60, 0)
  8850    I $G(CLIN ARY(0))=""  D ERRLOG^ SDMXERRO(3 17,"No cli nics were  specified  in the mes sage.",1)  Q
  8851   "RTN","SDM XSCHI",61, 0)
  8852    F COUNT=1 :1:$G(CLIN ARY(0)) D
  8853   "RTN","SDM XSCHI",62, 0)
  8854    . S MSGAR Y("CLINIC" )=$G(CLINA RY(COUNT))
  8855   "RTN","SDM XSCHI",63, 0)
  8856    . I $$GET ^XPAR("SYS ","SDMX PR OVIDER TIM E")=1 D  ; 1 = SCH DT  and AIP/A IG duratio n
  8857   "RTN","SDM XSCHI",64, 0)
  8858    . . S MSG ARY("APPTD T")=$G(BAS EDT)+(0.00 01*(COUNT- 1))
  8859   "RTN","SDM XSCHI",65, 0)
  8860    . . S MSG ARY("DURAT ION")=$G(C LINARY(COU NT,"LN"))
  8861   "RTN","SDM XSCHI",66, 0)
  8862    . E  I $$ GET^XPAR(" SYS","SDMX  PROVIDER  TIME")=3 D   ;3 = AIP /AIG DT an d duration
  8863   "RTN","SDM XSCHI",67, 0)
  8864    . . S MSG ARY("APPTD T")=$G(CLI NARY(COUNT ,"DT"))
  8865   "RTN","SDM XSCHI",68, 0)
  8866    . . S MSG ARY("DURAT ION")=$G(C LINARY(COU NT,"LN"))
  8867   "RTN","SDM XSCHI",69, 0)
  8868    . E  D  ; 2 = SCH DT  and durat ion, fall  on SCH if  config not  set
  8869   "RTN","SDM XSCHI",70, 0)
  8870    . . S MSG ARY("APPTD T")=$G(BAS EDT)+(0.00 01*(COUNT- 1))  ;Incr ement time  by 1 minu te for eac h addition al clinic,  for DPT n odes
  8871   "RTN","SDM XSCHI",71, 0)
  8872    . D BUILD ^SDMXSCHP( .MSGARY)
  8873   "RTN","SDM XSCHI",72, 0)
  8874    D DONEINC ^SDMXCORE
  8875   "RTN","SDM XSCHI",73, 0)
  8876    Q
  8877   "RTN","SDM XSCHI",74, 0)
  8878    ;
  8879   "RTN","SDM XSCHI",75, 0)
  8880   SETEVENT(E VENT,MSGAR Y) ;Takes  the schedu ling event  and sets  a message  event to p rocess.
  8881   "RTN","SDM XSCHI",76, 0)
  8882    ;  EVENT  (I/REQ) -  Message ev ent from t he MSH hea der. EX. S 12, S14
  8883   "RTN","SDM XSCHI",77, 0)
  8884    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  8885   "RTN","SDM XSCHI",78, 0)
  8886    I $G(EVEN T)="" Q
  8887   "RTN","SDM XSCHI",79, 0)
  8888    I EVENT=" S12" S MSG ARY("EVENT ")="SCHEDU LE"
  8889   "RTN","SDM XSCHI",80, 0)
  8890    I EVENT=" S14" S MSG ARY("EVENT ")="UPDATE "
  8891   "RTN","SDM XSCHI",81, 0)
  8892    I EVENT=" S15" S MSG ARY("EVENT ")="CANCEL "
  8893   "RTN","SDM XSCHI",82, 0)
  8894    I EVENT=" S26" S MSG ARY("EVENT ")="NOSHOW "
  8895   "RTN","SDM XSCHI",83, 0)
  8896    Q
  8897   "RTN","SDM XSCHI",84, 0)
  8898    ;
  8899   "RTN","SDM XSCHI",85, 0)
  8900   SCH(SCH,MS GARY,ABORT ,BASEDT) ; SCH segmen t processi ng.:
  8901   "RTN","SDM XSCHI",86, 0)
  8902    ;  SEG (I /REQ) - SC H message  segment da ta
  8903   "RTN","SDM XSCHI",87, 0)
  8904    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  8905   "RTN","SDM XSCHI",88, 0)
  8906    ;  ABORT  (O,OPT) -  Error para meter if w e did not  receive an  appointme nt date an d time. Fa tal case t o this mes sage.
  8907   "RTN","SDM XSCHI",89, 0)
  8908    ;  BASEDT  (O,REQ) -  appointme nt base da te/time to  use. May  be increme nted later  if proces sing multi ple joint  clinic sch eduling
  8909   "RTN","SDM XSCHI",90, 0)
  8910    N ORDIDTY P,ORDREP,M SGORD,ORDI D,CONSID
  8911   "RTN","SDM XSCHI",91, 0)
  8912    ; Appoint ment Ident ifiers
  8913   "RTN","SDM XSCHI",92, 0)
  8914    S MSGARY( "PLACER ID ")=$$GET^H LOPRS(.SCH ,1,1)  ;SC H-1.1
  8915   "RTN","SDM XSCHI",93, 0)
  8916    S MSGARY( "FILLER ID ")=$$GET^H LOPRS(.SCH ,2,1)  ;SC H-2.1
  8917   "RTN","SDM XSCHI",94, 0)
  8918    ; Cancel  Reason
  8919   "RTN","SDM XSCHI",95, 0)
  8920    I $G(MSGA RY("EVENT" ))="CANCEL " S MSGARY ("CANCEL R EASON")=$$ GETRSN(.SC H)    ;SCH -6
  8921   "RTN","SDM XSCHI",96, 0)
  8922    ; Duratio n
  8923   "RTN","SDM XSCHI",97, 0)
  8924    S MSGARY( "DURATION" )=$$GETLEN (.SCH)   ; SCH-9,10
  8925   "RTN","SDM XSCHI",98, 0)
  8926    I '$G(MSG ARY("DURAT ION")) S A BORT=1 Q
  8927   "RTN","SDM XSCHI",99, 0)
  8928    ; Appoint ment Date
  8929   "RTN","SDM XSCHI",100 ,0)
  8930    S BASEDT= $$HL7TFM^X LFDT($$GET ^HLOPRS(.S CH,11,4)," L")   ;SCH -11.4
  8931   "RTN","SDM XSCHI",101 ,0)
  8932    I +BASEDT '>0 D ERRL OG^SDMXERR O(305,"NO  APPOINTMEN T DATE AND  TIME",1)  S ABORT=1  Q
  8933   "RTN","SDM XSCHI",102 ,0)
  8934    ; User
  8935   "RTN","SDM XSCHI",103 ,0)
  8936    S MSGARY( "USER")=$$ GETUSER(.S CH)     ;S CH-20
  8937   "RTN","SDM XSCHI",104 ,0)
  8938    ; Status
  8939   "RTN","SDM XSCHI",105 ,0)
  8940    S MSGARY( "STATUS")= $$GETSTAT( .SCH)   ;S CH-25
  8941   "RTN","SDM XSCHI",106 ,0)
  8942    ; Linked  Consults/O rders
  8943   "RTN","SDM XSCHI",107 ,0)
  8944    F ORDREP= 1:1:$O(SCH (27,""),-1 ) D
  8945   "RTN","SDM XSCHI",108 ,0)
  8946    . S MSGOR D=$$GET^HL OPRS(.SCH, 27,1,1,ORD REP)
  8947   "RTN","SDM XSCHI",109 ,0)
  8948    . S ORDID TYP=$P(MSG ORD,"-",1)  ;Placer I D Type
  8949   "RTN","SDM XSCHI",110 ,0)
  8950    . S ORDID =$P(MSGORD ,"-",2) ;P lacer ID
  8951   "RTN","SDM XSCHI",111 ,0)
  8952    . I ORDID ="" Q
  8953   "RTN","SDM XSCHI",112 ,0)
  8954    . I ORDID TYP=$$TRAN ORCD^ORMXF MT(2,"^GMR (123") D   Q
  8955   "RTN","SDM XSCHI",113 ,0)
  8956    . . S MSG ARY("CONSU LT ID",0)= $G(MSGARY( "CONSULT I D",0))+1
  8957   "RTN","SDM XSCHI",114 ,0)
  8958    . . S MSG ARY("CONSU LT ID",MSG ARY("CONSU LT ID",0)) =ORDID
  8959   "RTN","SDM XSCHI",115 ,0)
  8960    . . S MSG ARY("CONSU LT ID")=$G (MSGARY("C ONSULT ID" ))_","_ORD ID
  8961   "RTN","SDM XSCHI",116 ,0)
  8962    . I (ORDI DTYP=$$TRA NORCD^ORMX FMT(2,"^OR (100"))!(O RDIDTYP="" ) D
  8963   "RTN","SDM XSCHI",117 ,0)
  8964    . . S CON SID=$$ORD2 CONS^SDMXC ORE(ORDID)
  8965   "RTN","SDM XSCHI",118 ,0)
  8966    . . I CON SID'="" D
  8967   "RTN","SDM XSCHI",119 ,0)
  8968    . . . S M SGARY("CON SULT ID",0 )=$G(MSGAR Y("CONSULT  ID",0))+1
  8969   "RTN","SDM XSCHI",120 ,0)
  8970    . . . S M SGARY("CON SULT ID",M SGARY("CON SULT ID",0 ))=CONSID
  8971   "RTN","SDM XSCHI",121 ,0)
  8972    . . . S M SGARY("CON SULT ID")= $G(MSGARY( "CONSULT I D"))_","_C ONSID
  8973   "RTN","SDM XSCHI",122 ,0)
  8974    . . E  D
  8975   "RTN","SDM XSCHI",123 ,0)
  8976    . . . S M SGARY("ORD ER ID",0)= $G(MSGARY( "ORDER ID" ,0))+1
  8977   "RTN","SDM XSCHI",124 ,0)
  8978    . . . S M SGARY("ORD ER ID TYPE ",0)=$G(MS GARY("ORDE R ID TYPE" ,0))+1
  8979   "RTN","SDM XSCHI",125 ,0)
  8980    . . . S M SGARY("ORD ER ID",MSG ARY("ORDER  ID",0))=O RDID
  8981   "RTN","SDM XSCHI",126 ,0)
  8982    . . . S M SGARY("ORD ER ID TYPE ",MSGARY(" ORDER ID T YPE",0))=O RDIDTYP
  8983   "RTN","SDM XSCHI",127 ,0)
  8984    . . . S M SGARY("ORD ER ID")=$G (MSGARY("O RDER ID")) _","_ORDID
  8985   "RTN","SDM XSCHI",128 ,0)
  8986    S MSGARY( "ORDER ID" )=$E($G(MS GARY("ORDE R ID")),2, $L($G(MSGA RY("ORDER  ID")))) ;r emove lead ing comma
  8987   "RTN","SDM XSCHI",129 ,0)
  8988    S MSGARY( "CONSULT I D")=$E($G( MSGARY("CO NSULT ID") ),2,$L($G( MSGARY("CO NSULT ID") )))
  8989   "RTN","SDM XSCHI",130 ,0)
  8990    Q
  8991   "RTN","SDM XSCHI",131 ,0)
  8992    ;
  8993   "RTN","SDM XSCHI",132 ,0)
  8994   NTE(NTE,MS GARY,LASTS EG,CLINARY ,ABORT,PRO VDTL) ;NTE  segment p rocessing.
  8995   "RTN","SDM XSCHI",133 ,0)
  8996    ;  NTE (I /REQ) - NT E message  segment da ta
  8997   "RTN","SDM XSCHI",134 ,0)
  8998    ;  MSGARY  (I/O,REQ)  - message  array str ucture wit h deformat ed and tra nslated da ta ready f or filing.  See PARSE MSG for de tails.
  8999   "RTN","SDM XSCHI",135 ,0)
  9000    ;  LASTSE G (I,REQ)  - segment  previous t o the NTE  to determi ne context  of note.
  9001   "RTN","SDM XSCHI",136 ,0)
  9002    ;  CLINAR Y (I/O,REQ ) - List o f Clinics  to be sche duled. Cou ld contain  more than  one for j oint appoi ntments
  9003   "RTN","SDM XSCHI",137 ,0)
  9004    ;  ABORT  (O,REQ) -  quit param eter to th e whole ta g. Having  one clinic  unmapped  must stop  filing.
  9005   "RTN","SDM XSCHI",138 ,0)
  9006    ;  PROVDT L (I/OPT)  - passed w hen NTE co ncerns a p receding A IP or AIG  segment
  9007   "RTN","SDM XSCHI",139 ,0)
  9008    N NOTE,NO TETYPE,CLI NIC
  9009   "RTN","SDM XSCHI",140 ,0)
  9010    S (NOTE,N OTETYPE,CL INIC)=""
  9011   "RTN","SDM XSCHI",141 ,0)
  9012    S LASTSEG =$G(LASTSE G)
  9013   "RTN","SDM XSCHI",142 ,0)
  9014    S NOTE=$$ GET^HLOPRS (.NTE,3,1)   ;NTE-3.1
  9015   "RTN","SDM XSCHI",143 ,0)
  9016    S NOTETYP E=$$GET^HL OPRS(.NTE, 4,1)  ;NTE -4.1
  9017   "RTN","SDM XSCHI",144 ,0)
  9018    ; Process  NTE follo wing SCH f or schedul ing commen ts.
  9019   "RTN","SDM XSCHI",145 ,0)
  9020    S NOTE=$T R(NOTE,"^" ,"?")  ;FI LEMAN can' t handle " ^"
  9021   "RTN","SDM XSCHI",146 ,0)
  9022    I LASTSEG ="SCH" D
  9023   "RTN","SDM XSCHI",147 ,0)
  9024    . I ($G(M SGARY("COM MENT"))'=" "),(NOTE'= "") S MSGA RY("COMMEN T")=$G(MSG ARY("COMME NT"))_" "
  9025   "RTN","SDM XSCHI",148 ,0)
  9026    . S MSGAR Y("COMMENT ")=$G(MSGA RY("COMMEN T"))_NOTE
  9027   "RTN","SDM XSCHI",149 ,0)
  9028    ;
  9029   "RTN","SDM XSCHI",150 ,0)
  9030    ; Process  NTE follo wing AIG/A IP for get ting clini cs
  9031   "RTN","SDM XSCHI",151 ,0)
  9032    I (LASTSE G="AIP")!( LASTSEG="A IG") D
  9033   "RTN","SDM XSCHI",152 ,0)
  9034    . I NOTET YPE="CLINI C" D
  9035   "RTN","SDM XSCHI",153 ,0)
  9036    . . S CLI NIC=$$GETC LIN(NOTE)
  9037   "RTN","SDM XSCHI",154 ,0)
  9038    . . I CLI NIC="" D E RRLOG^SDMX ERRO(300," CLINIC MAP PING ERROR  VALUE") S  ABORT=1 Q
  9039   "RTN","SDM XSCHI",155 ,0)
  9040    . . I $$G ETFLAG^SDM XFLAG(CLIN IC)=0 D ER RLOG^SDMXE RRO(318,"M ASS READ O NLY FLAG I S 0 FOR CL INIC "_CLI NIC,1)
  9041   "RTN","SDM XSCHI",156 ,0)
  9042    . . I $G( PROVDTL("D T"))="" Q
  9043   "RTN","SDM XSCHI",157 ,0)
  9044    . . I $G( CLINARY(CL INIC,$G(PR OVDTL("DT" ))))=1 Q
  9045   "RTN","SDM XSCHI",158 ,0)
  9046    . . S CLI NARY(0)=$G (CLINARY(0 ))+1
  9047   "RTN","SDM XSCHI",159 ,0)
  9048    . . S CLI NARY(CLINA RY(0))=CLI NIC
  9049   "RTN","SDM XSCHI",160 ,0)
  9050    . . S CLI NARY(CLINI C,$G(PROVD TL("DT"))) =1
  9051   "RTN","SDM XSCHI",161 ,0)
  9052    . . S CLI NARY(CLINA RY(0),"DT" )=$G(PROVD TL("DT"))
  9053   "RTN","SDM XSCHI",162 ,0)
  9054    . . S CLI NARY(CLINA RY(0),"LN" )=$G(PROVD TL("LN"))
  9055   "RTN","SDM XSCHI",163 ,0)
  9056    Q
  9057   "RTN","SDM XSCHI",164 ,0)
  9058    ;
  9059   "RTN","SDM XSCHI",165 ,0)
  9060   PID(PID,MS GARY,ABORT ) ;PID seg ment proce ssing.
  9061   "RTN","SDM XSCHI",166 ,0)
  9062    ;  PID (I /REQ) - PI D message  segment da ta
  9063   "RTN","SDM XSCHI",167 ,0)
  9064    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  9065   "RTN","SDM XSCHI",168 ,0)
  9066    ;  ABORT  (O,OPT) -  Error para meter if w e failed t o find a v alid patie nt. Fatal  case to th is message .
  9067   "RTN","SDM XSCHI",169 ,0)
  9068    N IDENTIF IERS,IENCH ECK,OK
  9069   "RTN","SDM XSCHI",170 ,0)
  9070    S (IDENTI FIERS,IENC HECK,OK)=" "
  9071   "RTN","SDM XSCHI",171 ,0)
  9072    ; Get IDs  for this  namespace  from the i dentifier  list
  9073   "RTN","SDM XSCHI",172 ,0)
  9074    D GETIDS( .PID,.IDEN TIFIERS)
  9075   "RTN","SDM XSCHI",173 ,0)
  9076    ; Validat e IDs
  9077   "RTN","SDM XSCHI",174 ,0)
  9078    S IENCHEC K=$$GTIENI CN($G(IDEN TIFIERS("P ATIENT ICN ")))
  9079   "RTN","SDM XSCHI",175 ,0)
  9080    I IENCHEC K'="" D  I  1
  9081   "RTN","SDM XSCHI",176 ,0)
  9082    . I IENCH ECK=$G(IDE NTIFIERS(" PATIENT IE N")) S MSG ARY("PATIE NT IEN")=$ G(IDENTIFI ERS("PATIE NT IEN"))  Q
  9083   "RTN","SDM XSCHI",177 ,0)
  9084    . I $G(MS GARY("PATI ENT IEN")) ="" S MSGA RY("PATIEN T IEN")=IE NCHECK Q
  9085   "RTN","SDM XSCHI",178 ,0)
  9086    . D ERRLO G^SDMXERRO (204,"ICN/ IEN patien t mismatch ",1) S ABO RT=1 Q
  9087   "RTN","SDM XSCHI",179 ,0)
  9088    E  S MSGA RY("PATIEN T IEN")=$G (IDENTIFIE RS("PATIEN T IEN"))
  9089   "RTN","SDM XSCHI",180 ,0)
  9090    ; Handle  error cond itions
  9091   "RTN","SDM XSCHI",181 ,0)
  9092    I $G(ABOR T) Q   ;an  error occ urred in i dentifier  validation
  9093   "RTN","SDM XSCHI",182 ,0)
  9094    I $G(MSGA RY("PATIEN T IEN"))=" " D ERRLOG ^SDMXERRO( 4050,"No I dentifiers  found to  lookup a p atient",1)  S ABORT=1  Q
  9095   "RTN","SDM XSCHI",183 ,0)
  9096    I ($G(MSG ARY("PATIE NT IEN"))= "") Q
  9097   "RTN","SDM XSCHI",184 ,0)
  9098    I ($G(^DP T($G(MSGAR Y("PATIENT  IEN")),0) )="") D ER RLOG^SDMXE RRO(204,"P atient IEN  does not  exist in t he system" ,1) S ABOR T=1 Q
  9099   "RTN","SDM XSCHI",185 ,0)
  9100    ; Perform  Patient V alidation
  9101   "RTN","SDM XSCHI",186 ,0)
  9102    S OK=$$VL DPAT^DGMXV LD(.PID,$G (MSGARY("P ATIENT IEN ")))  ; Th is can sen d error me ssages
  9103   "RTN","SDM XSCHI",187 ,0)
  9104    Q
  9105   "RTN","SDM XSCHI",188 ,0)
  9106    ;
  9107   "RTN","SDM XSCHI",189 ,0)
  9108   PV1(PV1,MS GARY,HDRTI ME,ABORT)  ;PV1 segme nt process ing.
  9109   "RTN","SDM XSCHI",190 ,0)
  9110    ;  PV1 (I /REQ) - PV 1 message  segment da ta
  9111   "RTN","SDM XSCHI",191 ,0)
  9112    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  9113   "RTN","SDM XSCHI",192 ,0)
  9114    ;  HDRTIM E (I,OPT)  - TIME FRO M MSH-7, U SED AS A D EFAULTING  OPTION
  9115   "RTN","SDM XSCHI",193 ,0)
  9116    ;  ABORT  (O,OPT) -  Error para meter if w e failed t o find a v alid patie nt. Fatal  case to th is message .
  9117   "RTN","SDM XSCHI",194 ,0)
  9118    N ERROR
  9119   "RTN","SDM XSCHI",195 ,0)
  9120    S ERROR=" "
  9121   "RTN","SDM XSCHI",196 ,0)
  9122    S MSGARY( "CHECKINDT ")=$$DETTI ME($$GET^H LOPRS(.PV1 ,44,1),$G( HDRTIME),. ERROR)   ; PV1-44.1
  9123   "RTN","SDM XSCHI",197 ,0)
  9124    I ($G(ERR OR)'=""),( $G(MSGARY( "STATUS")) ="CHECKED  IN") D ERR LOG^SDMXER RO(306,"NO  CHECK IN  TIME IN PV 1-44 "_ERR OR,1)
  9125   "RTN","SDM XSCHI",198 ,0)
  9126    S MSGARY( "CHECKOUTD T")=$$DETT IME($$GET^ HLOPRS(.PV 1,45,1),$G (HDRTIME), .ERROR)    ;PV1-45.1
  9127   "RTN","SDM XSCHI",199 ,0)
  9128    I ($G(ERR OR)'=""),( $G(MSGARY( "STATUS")) ="CHECKED  OUT") D ER RLOG^SDMXE RRO(307,"N O CHECK IN  TIME IN P V1-45 "_ER ROR,1)
  9129   "RTN","SDM XSCHI",200 ,0)
  9130    Q
  9131   "RTN","SDM XSCHI",201 ,0)
  9132   OBX(OBX,MS GARY,HDRTI ME) ;OBX s egment pro cessing.
  9133   "RTN","SDM XSCHI",202 ,0)
  9134    ;   OBX ( I/REQ) - O BX message  segment d ata
  9135   "RTN","SDM XSCHI",203 ,0)
  9136    ;   MSGAR Y (I/O,REQ ) message  array stru cture with  deformate d and tran slated dat a ready fo r filing.  See PARSEM SG for det ails.
  9137   "RTN","SDM XSCHI",204 ,0)
  9138    ;   HDRTI ME (I,OPT)  - TIME FR OM MSH-7,  USED AS A  DEFAULTING  OPTION
  9139   "RTN","SDM XSCHI",205 ,0)
  9140    N OBSTYPE ,ERROR,MAD EON
  9141   "RTN","SDM XSCHI",206 ,0)
  9142    S (OBSTYP E,ERROR,MA DEON)=""
  9143   "RTN","SDM XSCHI",207 ,0)
  9144    ; Get Obs ervation T ype
  9145   "RTN","SDM XSCHI",208 ,0)
  9146    S OBSTYPE =$$GET^HLO PRS(.OBX,3 ,1)  ;OBX- 3.1
  9147   "RTN","SDM XSCHI",209 ,0)
  9148    ; Process  appointme nt eligibi lity
  9149   "RTN","SDM XSCHI",210 ,0)
  9150    I OBSTYPE ="APPT ELI GIBILITY"  S MSGARY(" ELIGIBILIT Y")=$$GETE LIG(.OBX)    ;OBX-5
  9151   "RTN","SDM XSCHI",211 ,0)
  9152    ; Process  Appointme nt Type
  9153   "RTN","SDM XSCHI",212 ,0)
  9154    I OBSTYPE ="APPT TYP E" S MSGAR Y("APPTTYP E")=$$GETT YPE(.OBX)    ;OBX-5
  9155   "RTN","SDM XSCHI",213 ,0)
  9156    ; Process  Walk in f lag
  9157   "RTN","SDM XSCHI",214 ,0)
  9158    I OBSTYPE ="WALK-IN"  D
  9159   "RTN","SDM XSCHI",215 ,0)
  9160    . S MSGAR Y("WALK IN ")=$$GET^H LOPRS(.OBX ,5,1)  ;OB X-5.1 for  boolean fl ag
  9161   "RTN","SDM XSCHI",216 ,0)
  9162    . I '$$IN STRING^SDM XCORE($G(M SGARY("WAL K IN")),"0 ,1") D ERR LOG^SDMXER RO(311,"WA LKIN FLAG  MAPPING ER ROR",1)
  9163   "RTN","SDM XSCHI",217 ,0)
  9164    ; Process  Patient I ndicated D ate
  9165   "RTN","SDM XSCHI",218 ,0)
  9166    I OBSTYPE ="REQUESTE D DATE" D
  9167   "RTN","SDM XSCHI",219 ,0)
  9168    . S MSGAR Y("PAT IND ICATED DAT E")=$$DETT IME($$GET^ HLOPRS(.OB X,5,1),$G( HDRTIME),. ERROR) ;OB X-5.1 for  boolean fl ag
  9169   "RTN","SDM XSCHI",220 ,0)
  9170    . I $G(ER ROR)'="" D  ERRLOG^SD MXERRO(310 ,"NO PATIE NT INDICAT ED DATE "_ ERROR,1)
  9171   "RTN","SDM XSCHI",221 ,0)
  9172    ; Process  Made on d ate/Time
  9173   "RTN","SDM XSCHI",222 ,0)
  9174    I OBSTYPE ="APPT MAD E DT" D
  9175   "RTN","SDM XSCHI",223 ,0)
  9176    . S MADEO N=$$HL7TFM ^XLFDT($$G ET^HLOPRS( .OBX,5,1), "L")   ;OB X-5
  9177   "RTN","SDM XSCHI",224 ,0)
  9178    . I +MADE ON>0 S MSG ARY("MADE  ON DATE")= MADEON
  9179   "RTN","SDM XSCHI",225 ,0)
  9180    Q
  9181   "RTN","SDM XSCHI",226 ,0)
  9182   RGS(RGS,MS GARY) ; RG S segment  processing .
  9183   "RTN","SDM XSCHI",227 ,0)
  9184    ;              Per H L7 this se gment repe ats and ha s multiple  AIS/AIG/A IP segment s undernea th.
  9185   "RTN","SDM XSCHI",228 ,0)
  9186    ;  RGS (I /REQ) - RG S message  segment da ta
  9187   "RTN","SDM XSCHI",229 ,0)
  9188    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  9189   "RTN","SDM XSCHI",230 ,0)
  9190    Q
  9191   "RTN","SDM XSCHI",231 ,0)
  9192   AIS(AIS,MS GARY) ;AIS  segment p rocessing.
  9193   "RTN","SDM XSCHI",232 ,0)
  9194    ;             Per HL 7 this fie ld can rep eat within  each RGS  group.
  9195   "RTN","SDM XSCHI",233 ,0)
  9196    ;  AIS (I /REQ) - AI S message  segment da ta
  9197   "RTN","SDM XSCHI",234 ,0)
  9198    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  9199   "RTN","SDM XSCHI",235 ,0)
  9200    Q
  9201   "RTN","SDM XSCHI",236 ,0)
  9202   AIP(AIP,MS GARY,PROVD TL,BASEDTE ) ;AIP seg ment proce ssing.
  9203   "RTN","SDM XSCHI",237 ,0)
  9204    ;             Per HL 7 this fie ld can rep eat within  each RGS  group.
  9205   "RTN","SDM XSCHI",238 ,0)
  9206    ;  AIP (I /REQ) - AI P message  segment da ta
  9207   "RTN","SDM XSCHI",239 ,0)
  9208    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  9209   "RTN","SDM XSCHI",240 ,0)
  9210    ;  PROVDT L (O,REQ)  - AIP date /time and  length
  9211   "RTN","SDM XSCHI",241 ,0)
  9212    ;  BASEDT E (I,REQ)  - Appt D/T  from SCH
  9213   "RTN","SDM XSCHI",242 ,0)
  9214    N DATE,DU RATION
  9215   "RTN","SDM XSCHI",243 ,0)
  9216    S DATE=$$ HL7TFM^XLF DT($$GET^H LOPRS(.AIP ,6,1),"L")    ;AIP-6
  9217   "RTN","SDM XSCHI",244 ,0)
  9218    I +DATE>0  S PROVDTL ("DT")=DAT E
  9219   "RTN","SDM XSCHI",245 ,0)
  9220    E  S PROV DTL("DT")= $G(BASEDTE )
  9221   "RTN","SDM XSCHI",246 ,0)
  9222    ;
  9223   "RTN","SDM XSCHI",247 ,0)
  9224    S DURATIO N=+$$GETLE N(.AIP)            ;A IP-9
  9225   "RTN","SDM XSCHI",248 ,0)
  9226    I DURATIO N>0 S PROV DTL("LN")= DURATION
  9227   "RTN","SDM XSCHI",249 ,0)
  9228    E  S PROV DTL("LN")= $G(MSGARY( "DURATION" ))
  9229   "RTN","SDM XSCHI",250 ,0)
  9230    Q
  9231   "RTN","SDM XSCHI",251 ,0)
  9232   AIG(AIG,MS GARY,PROVD TL,BASEDTE ) ;AIG seg ment proce ssing.
  9233   "RTN","SDM XSCHI",252 ,0)
  9234    ;             Per HL 7 this fie ld can rep eat within  each RGS  group.
  9235   "RTN","SDM XSCHI",253 ,0)
  9236    ;  AIG (I /REQ) - AI G message  segment da ta
  9237   "RTN","SDM XSCHI",254 ,0)
  9238    ;  MSGARY  (I/O,REQ)  message a rray struc ture with  deformated  and trans lated data  ready for  filing. S ee PARSEMS G for deta ils.
  9239   "RTN","SDM XSCHI",255 ,0)
  9240    ;  PROVDT L (O,REQ)  - AIG date /time and  length
  9241   "RTN","SDM XSCHI",256 ,0)
  9242    ;  BASEDT E (I,REQ)  - Appt D/T  from SCH
  9243   "RTN","SDM XSCHI",257 ,0)
  9244    I +$$HL7T FM^XLFDT($ $GET^HLOPR S(.AIG,8,1 ),"L")>0 S  PROVDTL(" DT")=$$HL7 TFM^XLFDT( $$GET^HLOP RS(.AIG,8, 1),"L")  ; AIG-8
  9245   "RTN","SDM XSCHI",258 ,0)
  9246    E  S PROV DTL("DT")= $G(BASEDTE )
  9247   "RTN","SDM XSCHI",259 ,0)
  9248    I $$GETLE N(.AIG)'=" " S PROVDT L("LN")=$$ GETLEN(.AI G)  ;AIG-1 1
  9249   "RTN","SDM XSCHI",260 ,0)
  9250    E  S PROV DTL("LN")= $G(MSGARY( "DURATION" ))
  9251   "RTN","SDM XSCHI",261 ,0)
  9252    Q
  9253   "RTN","SDM XSCHI",262 ,0)
  9254    ;
  9255   "RTN","SDM XSCHI",263 ,0)
  9256   GETRSN(SCH ) ; Collec ts appoint ment reaso n and tran slates int o internal  format.
  9257   "RTN","SDM XSCHI",264 ,0)
  9258    ;          Tries usi ng the Tit le to look up the rea son. If th at fails u ses the ID  to lookup
  9259   "RTN","SDM XSCHI",265 ,0)
  9260    ;          the reaso n against  the title.  If that f ails tries  using the  ID agains t the ID.
  9261   "RTN","SDM XSCHI",266 ,0)
  9262    ;   SCH ( I/REQ) - S CH message  segment d ata
  9263   "RTN","SDM XSCHI",267 ,0)
  9264    Q $$DATAL KUP^SDMXCO RE(.SCH,"4 09.2","^SD (409.2,",6 ,302,"APPO INTMENT RE ASON MAPPI NG ERROR")
  9265   "RTN","SDM XSCHI",268 ,0)
  9266   GETTYPE(OB X) ;transl ates appoi ntment typ e into int ernal form at
  9267   "RTN","SDM XSCHI",269 ,0)
  9268    ;   OBX ( I/REQ) - O BX message  segment d ata
  9269   "RTN","SDM XSCHI",270 ,0)
  9270    N APPTTYP E
  9271   "RTN","SDM XSCHI",271 ,0)
  9272    S APPTTYP E=$$DATALK UP^SDMXCOR E(.OBX,"40 9.1","^SD( 409.1,",5, 303,"APPOI NTMENT TYP E MAPPING  ERROR")
  9273   "RTN","SDM XSCHI",272 ,0)
  9274    I $G(APPT TYPE)="" S  APPTTYPE= 9
  9275   "RTN","SDM XSCHI",273 ,0)
  9276    Q APPTTYP E
  9277   "RTN","SDM XSCHI",274 ,0)
  9278   GETLEN(SEG ) ;Transla tes durati on into Mi nutes. Ass umes minut es unless  set to S o r SEC for  the units
  9279   "RTN","SDM XSCHI",275 ,0)
  9280    ;  Only o ne paramet er at a ti me should  be passed- in, depend ing on wha t segment  is calling  this tag
  9281   "RTN","SDM XSCHI",276 ,0)
  9282    ;  SEG (I /OPT) - SC H,AIP,or A IG message  segment d ata
  9283   "RTN","SDM XSCHI",277 ,0)
  9284    N DURATIO N,UNIT
  9285   "RTN","SDM XSCHI",278 ,0)
  9286    I ($G(SEG ("SEGMENT  TYPE"))="S CH") D
  9287   "RTN","SDM XSCHI",279 ,0)
  9288    . S DURAT ION=+$$GET ^HLOPRS(.S EG,9,1)  ; SCH-9
  9289   "RTN","SDM XSCHI",280 ,0)
  9290    . I DURAT ION=0 D ER RLOG^SDMXE RRO(304,"N O APPOINTM ENT DURATI ON RECIEVE D IN SCH", 1) Q
  9291   "RTN","SDM XSCHI",281 ,0)
  9292    . S UNIT= $$GET^HLOP RS(.SEG,10 ,1)     ;S CH-10
  9293   "RTN","SDM XSCHI",282 ,0)
  9294    E  I ($G( SEG("SEGME NT TYPE")) ="AIP") D
  9295   "RTN","SDM XSCHI",283 ,0)
  9296    . S DURAT ION=+$$GET ^HLOPRS(.S EG,9,1)  ; AIP-9
  9297   "RTN","SDM XSCHI",284 ,0)
  9298    . I DURAT ION=0 D ER RLOG^SDMXE RRO(304,"N O APPOINTM ENT DURATI ON RECIEVE D IN AIP", 1) Q
  9299   "RTN","SDM XSCHI",285 ,0)
  9300    . S UNIT= $$GET^HLOP RS(.SEG,10 ,1)     ;A IP-10
  9301   "RTN","SDM XSCHI",286 ,0)
  9302    E  I ($G( SEG("SEGME NT TYPE")) ="AIG") D
  9303   "RTN","SDM XSCHI",287 ,0)
  9304    . S DURAT ION=+$$GET ^HLOPRS(.S EG,11,1)   ;AIG-11
  9305   "RTN","SDM XSCHI",288 ,0)
  9306    . I DURAT ION=0 D ER RLOG^SDMXE RRO(304,"N O APPOINTM ENT DURATI ON RECIEVE D IN AIG", 1) Q
  9307   "RTN","SDM XSCHI",289 ,0)
  9308    . S UNIT= $$GET^HLOP RS(.SEG,12 ,1)     ;A IG-12
  9309   "RTN","SDM XSCHI",290 ,0)
  9310    ; Transla te to minu tes
  9311   "RTN","SDM XSCHI",291 ,0)
  9312    I $$INSTR ING^SDMXCO RE($G(UNIT ),"S,SEC")  S DURATIO N=$G(DURAT ION)/60
  9313   "RTN","SDM XSCHI",292 ,0)
  9314    Q $G(DURA TION)
  9315   "RTN","SDM XSCHI",293 ,0)
  9316   GETUSER(SC H) ;collec ts appoint ment enter ed by user  and confi rms they a re a user  in the 200  file
  9317   "RTN","SDM XSCHI",294 ,0)
  9318    ;  SCH (I /REQ) - SC H message  segment da ta
  9319   "RTN","SDM XSCHI",295 ,0)
  9320    N USER
  9321   "RTN","SDM XSCHI",296 ,0)
  9322    S USER=$$ GET^HLOPRS (.SCH,20,1 )
  9323   "RTN","SDM XSCHI",297 ,0)
  9324    I $$GET1^ DIQ(200,US ER,".01")' ="" Q USER
  9325   "RTN","SDM XSCHI",298 ,0)
  9326    E  S USER =.5 D ERRL OG^SDMXERR O(308,"USE R MAPPING  ERROR",1)  ;Default t o FileMan  User .5
  9327   "RTN","SDM XSCHI",299 ,0)
  9328    Q USER
  9329   "RTN","SDM XSCHI",300 ,0)
  9330   GETSTAT(SC H) ; Trans lates stat us into ap propriate  scheduling  statuses
  9331   "RTN","SDM XSCHI",301 ,0)
  9332    ;           Options:  (SCHEDULE D,CHECKED  IN,CHECKED  OUT,CANCE LLED,NO SH OW)
  9333   "RTN","SDM XSCHI",302 ,0)
  9334    ;   SCH ( I/REQ) - S CH message  segment d ata
  9335   "RTN","SDM XSCHI",303 ,0)
  9336    N STATUS, ID,TITLE
  9337   "RTN","SDM XSCHI",304 ,0)
  9338    S ID=$$GE T^HLOPRS(. SCH,25,1)
  9339   "RTN","SDM XSCHI",305 ,0)
  9340    S TITLE=$ $GET^HLOPR S(.SCH,25, 2)
  9341   "RTN","SDM XSCHI",306 ,0)
  9342    I $$INSTR ING^SDMXCO RE(TITLE," SCHEDULED, CHECKED IN ,CHECKED O UT,CANCELL ED,NO SHOW ") Q TITLE
  9343   "RTN","SDM XSCHI",307 ,0)
  9344    I $$INSTR ING^SDMXCO RE(ID,"SCH EDULED,CHE CKED IN,CH ECKED OUT, CANCELLED, NO SHOW")  Q ID
  9345   "RTN","SDM XSCHI",308 ,0)
  9346    I (ID'="" )!(TITLE'= "") D ERRL OG^SDMXERR O(309,"SCH EDULING ST ATUS MAPPI NG ERROR", 1)
  9347   "RTN","SDM XSCHI",309 ,0)
  9348    Q "NA"
  9349   "RTN","SDM XSCHI",310 ,0)
  9350   GETIDS(PID ,IDENTIFIE RS) ;PID-3  IDs
  9351   "RTN","SDM XSCHI",311 ,0)
  9352    ;  PID (I ,REQ) - PI D message  segment da ta
  9353   "RTN","SDM XSCHI",312 ,0)
  9354    ;  IDENTI FIERS (O,R EQ) - Iden tifier arr ay to retu rn
  9355   "RTN","SDM XSCHI",313 ,0)
  9356    ;
  9357   "RTN","SDM XSCHI",314 ,0)
  9358    K IDENTIF IERS    ;f orce outpu t paramete r
  9359   "RTN","SDM XSCHI",315 ,0)
  9360    N REP,ID, ASSIGN,IDT YPE
  9361   "RTN","SDM XSCHI",316 ,0)
  9362    S (REP,ID ,ASSIGN,ID TYPE)=""
  9363   "RTN","SDM XSCHI",317 ,0)
  9364    ; Loop th rough all  repetition s of PID-3
  9365   "RTN","SDM XSCHI",318 ,0)
  9366    F REP=1:1 :$O(PID(3, ""),-1) D
  9367   "RTN","SDM XSCHI",319 ,0)
  9368    . S ID=$$ GET^HLOPRS (.PID,3,1, 1,REP)   ; PID-3.1
  9369   "RTN","SDM XSCHI",320 ,0)
  9370    . I ID=""  Q    ;Onl y check th e ID if it  exists
  9371   "RTN","SDM XSCHI",321 ,0)
  9372    . S ASSIG N=$$GET^HL OPRS(.PID, 3,4,1,REP)    ;PID-3. 4
  9373   "RTN","SDM XSCHI",322 ,0)
  9374    . S IDTYP E=$$GET^HL OPRS(.PID, 3,5,1,REP)    ;PID-3. 5
  9375   "RTN","SDM XSCHI",323 ,0)
  9376    . I $$ISP ATIEN(ASSI GN,IDTYPE)  S IDENTIF IERS("PATI ENT IEN")= ID Q
  9377   "RTN","SDM XSCHI",324 ,0)
  9378    . I $$ISP ATICN(ASSI GN,IDTYPE)  S IDENTIF IERS("PATI ENT ICN")= ID
  9379   "RTN","SDM XSCHI",325 ,0)
  9380    Q
  9381   "RTN","SDM XSCHI",326 ,0)
  9382   ISPATIEN(A SSIGN,IDTY PE) ;Deter mines if g iven id de scriptors  are the IE N for this  instance
  9383   "RTN","SDM XSCHI",327 ,0)
  9384    ;  ASSIGN  (I,OPT) -  Assigning  Authority  of this i dentifier
  9385   "RTN","SDM XSCHI",328 ,0)
  9386    ;  IDTYPE  (I,OPT) -  ID Type o f this ide ntifier
  9387   "RTN","SDM XSCHI",329 ,0)
  9388    I $G(IDTY PE)="IEN"  Q 1
  9389   "RTN","SDM XSCHI",330 ,0)
  9390    Q 0
  9391   "RTN","SDM XSCHI",331 ,0)
  9392   ISPATICN(A SSIGN,IDTY PE) ;Deter mines if g iven id de scriptors  are the IC N for this  instance
  9393   "RTN","SDM XSCHI",332 ,0)
  9394    ;   ASSIG N (I,OPT)  - Assignin g Authorit y of this  identifier
  9395   "RTN","SDM XSCHI",333 ,0)
  9396    ;   IDTYP E (I,OPT)  - ID Type  of this id entifier
  9397   "RTN","SDM XSCHI",334 ,0)
  9398    I $G(IDTY PE)="ICN"  Q 1
  9399   "RTN","SDM XSCHI",335 ,0)
  9400    Q 0
  9401   "RTN","SDM XSCHI",336 ,0)
  9402   GTIENICN(P ATICN) ;Lo okup the I EN for a g iven ICN
  9403   "RTN","SDM XSCHI",337 ,0)
  9404    ;   PATIC N (I,REQ)  - Patient  ICN
  9405   "RTN","SDM XSCHI",338 ,0)
  9406    N PATIEN
  9407   "RTN","SDM XSCHI",339 ,0)
  9408    S PATIEN= ""
  9409   "RTN","SDM XSCHI",340 ,0)
  9410    Q PATIEN
  9411   "RTN","SDM XSCHI",341 ,0)
  9412   GETCLIN(ID ) ;Collect s clinic f rom the PV 1-3.1 segm ent. There  is no tit le compone nt to this  data type .
  9413   "RTN","SDM XSCHI",342 ,0)
  9414    ;   ID (I /REQ) - Cl inic strin g to looku p clinic w ith
  9415   "RTN","SDM XSCHI",343 ,0)
  9416    ;
  9417   "RTN","SDM XSCHI",344 ,0)
  9418    ; Check R equirement s
  9419   "RTN","SDM XSCHI",345 ,0)
  9420    I $G(ID)= "" Q ""
  9421   "RTN","SDM XSCHI",346 ,0)
  9422    ;
  9423   "RTN","SDM XSCHI",347 ,0)
  9424    N CLINIC
  9425   "RTN","SDM XSCHI",348 ,0)
  9426    ; Try rob ust multi  tier looku p
  9427   "RTN","SDM XSCHI",349 ,0)
  9428    S CLINIC= $O(^SC("B" ,ID,""))
  9429   "RTN","SDM XSCHI",350 ,0)
  9430    I CLINIC' ="" Q CLIN IC
  9431   "RTN","SDM XSCHI",351 ,0)
  9432    I $G(^SC( ID,0))'=""  Q ID
  9433   "RTN","SDM XSCHI",352 ,0)
  9434    Q ""
  9435   "RTN","SDM XSCHI",353 ,0)
  9436   GETELIG(OB X) ;Collec ts appoint ment eligi bility and  translate s into int ernal form at
  9437   "RTN","SDM XSCHI",354 ,0)
  9438    ;          Tries usi ng the Tit le to look up the eli gibility.  If that fa ils uses t he
  9439   "RTN","SDM XSCHI",355 ,0)
  9440    ;          ID to loo kup the re ason again st the tit le. If tha t fails tr ies using  the ID aga inst the I D.
  9441   "RTN","SDM XSCHI",356 ,0)
  9442    ;  OBX (I /REQ) - OB X message  segment da ta
  9443   "RTN","SDM XSCHI",357 ,0)
  9444    Q $$DATAL KUP^SDMXCO RE(.OBX,"8 ","^DIC(8, ",5,316,"E ligibility  in OBX di d not map" )
  9445   "RTN","SDM XSCHI",358 ,0)
  9446   DETTIME(PV 1TIME,HDRT IME,ERROR)  ;RETURNS  THE BEST C HECK IN/OU T TIME AVA ILABLE IN  THE MESSAG E OR DEFAU LTS TO NOW
  9447   "RTN","SDM XSCHI",359 ,0)
  9448    ; PV1TIME  (I,OPT)    - HIGHEST  PRIORITY  TIME TO RE TURN FROM  EITHER PV1 -44 OR PV1 -45
  9449   "RTN","SDM XSCHI",360 ,0)
  9450    ; HDRTIME  (I,OPT)    - TIME FR OM MSH-7
  9451   "RTN","SDM XSCHI",361 ,0)
  9452    ; ERROR    (O,OPT)    - ERROR O UTPUT PARA METER
  9453   "RTN","SDM XSCHI",362 ,0)
  9454    N RET
  9455   "RTN","SDM XSCHI",363 ,0)
  9456    S RET=""
  9457   "RTN","SDM XSCHI",364 ,0)
  9458    K ERROR
  9459   "RTN","SDM XSCHI",365 ,0)
  9460    I $G(PV1T IME)'="" S  RET=$$HL7 TFM^XLFDT( PV1TIME,"L ") ;Return s -1 on ba d input, " " on "" in put
  9461   "RTN","SDM XSCHI",366 ,0)
  9462    I +RET>0  Q RET
  9463   "RTN","SDM XSCHI",367 ,0)
  9464    I $G(HDRT IME)'="" S  ERROR="FA LLING BACK  TO MSH-7"  S RET=$$H L7TFM^XLFD T(HDRTIME, "L")
  9465   "RTN","SDM XSCHI",368 ,0)
  9466    I +RET>0  Q RET
  9467   "RTN","SDM XSCHI",369 ,0)
  9468    S ERROR=" FALLING BA CK TO FILI NG TIME"
  9469   "RTN","SDM XSCHI",370 ,0)
  9470    Q $$NOW^X LFDT()
  9471   "RTN","SDM XSCHI",371 ,0)
  9472   DATALKUP(S EG,FILE,FI LEPATH,FIE LD,ERRCODE ,ERRTEXT)  ;Moved to  SDMXCORE f or routine  size issu es.
  9473   "RTN","SDM XSCHI",372 ,0)
  9474    ;Wrapped  here in ca se there a re any mis sed caller s
  9475   "RTN","SDM XSCHI",373 ,0)
  9476    Q $$DATAL KUP^SDMXCO RE(SEG,FIL E,FILEPATH ,FIELD,ERR CODE,ERRTE XT)
  9477   "RTN","SDM XSCHI",374 ,0)
  9478    Q  ;;#eor #
  9479   "RTN","SDM XSCHP")
  9480   0^37^B1223 23991
  9481   "RTN","SDM XSCHP",1,0 )
  9482   SDMXSCHP ; MASS/RPC,D AP - Appoi ntment Pro cessing ro utine usin g SAFE pro cessor;09/ 05/2017 ;2 018-05-25  14:11:59;8 .3;AP1eACn 8KAjeoognJ N1ShU2btra Jq4NYjYyHv 94eiUM=
  9483   "RTN","SDM XSCHP",2,0 )
  9484    ;;5.3;Sch eduling;** 676**;SEPT EMBER 05,2 017;Build  99
  9485   "RTN","SDM XSCHP",3,0 )
  9486    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  9487   "RTN","SDM XSCHP",4,0 )
  9488    Q
  9489   "RTN","SDM XSCHP",5,0 )
  9490   BUILD(MSGA RY) ; Appo intment bu ilding tag . Receives  data from  an inboun d message  formatted  to VistA e lements
  9491   "RTN","SDM XSCHP",6,0 )
  9492    ;            and mak es appropr iate decis ions as to  next step s to file  it to Vist A.
  9493   "RTN","SDM XSCHP",7,0 )
  9494    ; PARAMET ERS:
  9495   "RTN","SDM XSCHP",8,0 )
  9496    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9497   "RTN","SDM XSCHP",9,0 )
  9498    ;                          Arra y format b elow:
  9499   "RTN","SDM XSCHP",10, 0)
  9500    ;
  9501   "RTN","SDM XSCHP",11, 0)
  9502    ;   MSGAR Y("PATIENT  IEN") - I EN
  9503   "RTN","SDM XSCHP",12, 0)
  9504    ;   MSGAR Y("APPTDT" )  - date/ time of th e appointm ent in Vis tA format
  9505   "RTN","SDM XSCHP",13, 0)
  9506    ;   MSGAR Y("APPTTYP E") - appo intment ty pe
  9507   "RTN","SDM XSCHP",14, 0)
  9508    ;   MSGAR Y("CANCEL  REASON") -  reason fo r an appoi ntment. Wi ll be the  reason for  cancel if  being can celed;
  9509   "RTN","SDM XSCHP",15, 0)
  9510    ;   MSGAR Y("CANCEL  REMARK") -  cancel re ason comme nt. (Not c urrently s upported b y HL7 SIU  messaging.  Could be  added late r if neede d. Will be  in source  system.
  9511   "RTN","SDM XSCHP",16, 0)
  9512    ;   MSGAR Y("CANCFLA G") - 1 if  appointme nt is curr ently canc elled, nul l otherwis e (set lat er)
  9513   "RTN","SDM XSCHP",17, 0)
  9514    ;   MSGAR Y("OLD CLI NIC") - if  we change  the clini c of the a ppointment  but every thing else  stays the  same, we  need cache  off the o ld clinic  (set later )
  9515   "RTN","SDM XSCHP",18, 0)
  9516    ;   MSGAR Y("CHECKOU TDT")  - d ate/time o f check ou t
  9517   "RTN","SDM XSCHP",19, 0)
  9518    ;   MSGAR Y("CHECKIN DT")   - d ate/time o f check in
  9519   "RTN","SDM XSCHP",20, 0)
  9520    ;   MSGAR Y("COMMENT ") - appoi ntment cre ation comm ent
  9521   "RTN","SDM XSCHP",21, 0)
  9522    ;   MSGAR Y("CLINIC" )  - appoi ntment cli nic
  9523   "RTN","SDM XSCHP",22, 0)
  9524    ;   MSGAR Y("DURATIO N") - appo intment du ration
  9525   "RTN","SDM XSCHP",23, 0)
  9526    ;   MSGAR Y("ELIGIBI LITY") - V istA eligi bility cod e
  9527   "RTN","SDM XSCHP",24, 0)
  9528    ;   MSGAR Y("EVENT")   - appoin tment mess age event  (SCHEDULE/ UPDATE/CAN CEL/NOSHOW )(S12/S14/ S15/S26)
  9529   "RTN","SDM XSCHP",25, 0)
  9530    ;   MSGAR Y("FILLER  ID")  - ap pointment  filler ID
  9531   "RTN","SDM XSCHP",26, 0)
  9532    ;   MSGAR Y("NEXT AV AILABLE")  - If the a ppointment  was sched uled as ne xt availab le
  9533   "RTN","SDM XSCHP",27, 0)
  9534    ;   MSGAR Y("ORDER I D")      -  Order ID  on appoint ment/consu lt request s
  9535   "RTN","SDM XSCHP",28, 0)
  9536    ;   MSGAR Y("PAT IND ICATED DAT E")  - Dat e the star t of searc h was perf ormed on.
  9537   "RTN","SDM XSCHP",29, 0)
  9538    ;   MSGAR Y("PLACER  ID") - app ointment p lacer ID
  9539   "RTN","SDM XSCHP",30, 0)
  9540    ;   MSGAR Y("PROVIDE RS",0)  -  number of  providers
  9541   "RTN","SDM XSCHP",31, 0)
  9542    ;   MSGAR Y("PROVIDE RS",cnt,"I EN")  - pr ovider ide ntifier
  9543   "RTN","SDM XSCHP",32, 0)
  9544    ;   MSGAR Y("PROVIDE RS",cnt,"N AME")  - p rovider id entifier
  9545   "RTN","SDM XSCHP",33, 0)
  9546    ;   MSGAR Y("STATUS" ) - APPT s tatus (SCH EDULED,CHE CKED IN,CH ECKED OUT, CANCELLED, NO SHOW)
  9547   "RTN","SDM XSCHP",34, 0)
  9548    ;   MSGAR Y("USER")  - Scheduli ng user
  9549   "RTN","SDM XSCHP",35, 0)
  9550    ;
  9551   "RTN","SDM XSCHP",36, 0)
  9552    ;
  9553   "RTN","SDM XSCHP",37, 0)
  9554    N ACTIONL IST,LOCKAR Y,APPTARY
  9555   "RTN","SDM XSCHP",38, 0)
  9556    D GETAPPT ^SDMXGAPT( MSGARY("PA TIENT IEN" ),MSGARY(" APPTDT"),. APPTARY)
  9557   "RTN","SDM XSCHP",39, 0)
  9558    I '$$SEQU ENCE^SDMXL KRQ(.MSGAR Y,.LOCKARY ,$G(APPTAR Y("ENCOUNT ER IEN")))  Q  ;LOCKA RY contain s a copy o f MSGARY's  locked ID s in case  something  happens to  MSGARY
  9559   "RTN","SDM XSCHP",40, 0)
  9560    ; Determi ne schedul ing action s to take
  9561   "RTN","SDM XSCHP",41, 0)
  9562    S ACTIONL IST=$$ACTI ONS(.MSGAR Y,"","",.A PPTARY)
  9563   "RTN","SDM XSCHP",42, 0)
  9564    ;Don't al low cancel s when an  encounter  is linked  already
  9565   "RTN","SDM XSCHP",43, 0)
  9566    ;
  9567   "RTN","SDM XSCHP",44, 0)
  9568    ; Process  the actio n list
  9569   "RTN","SDM XSCHP",45, 0)
  9570    D PROCESS (ACTIONLIS T,.MSGARY, .APPTARY)
  9571   "RTN","SDM XSCHP",46, 0)
  9572    ;
  9573   "RTN","SDM XSCHP",47, 0)
  9574    D AFTRPRO C^SDMXLKRQ (.LOCKARY)
  9575   "RTN","SDM XSCHP",48, 0)
  9576    Q
  9577   "RTN","SDM XSCHP",49, 0)
  9578    ;
  9579   "RTN","SDM XSCHP",50, 0)
  9580   ACTIONS(MS GARY,PATIE NTIEN,APPT DT,APPTARY ) ; Compar es message  data agai nst the ex isting app ointment i n VistA to  determine
  9581   "RTN","SDM XSCHP",51, 0)
  9582    ;                                  the act ions that  need to be  taken on  the appoin tment.
  9583   "RTN","SDM XSCHP",52, 0)
  9584    ;
  9585   "RTN","SDM XSCHP",53, 0)
  9586    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9587   "RTN","SDM XSCHP",54, 0)
  9588    ;                          See  BUILD head er above f or array s tructure:
  9589   "RTN","SDM XSCHP",55, 0)
  9590    ;   PATIE NTIEN (I,O PT) - Pati ent IEN
  9591   "RTN","SDM XSCHP",56, 0)
  9592    ;   APPTD T     (I,O PT) - appo intment Da teTime in  VistA form at
  9593   "RTN","SDM XSCHP",57, 0)
  9594    ;   APPTA RY (I,OPT)  - THE PAR SED VISTA  APPOINTMEN T ARRAY
  9595   "RTN","SDM XSCHP",58, 0)
  9596    ;
  9597   "RTN","SDM XSCHP",59, 0)
  9598    ; Output:        Com ma delimit ed list of  actions t o perform.
  9599   "RTN","SDM XSCHP",60, 0)
  9600    ;                Pos sible acti ons includ e:
  9601   "RTN","SDM XSCHP",61, 0)
  9602    ;                SCH EDULE
  9603   "RTN","SDM XSCHP",62, 0)
  9604    ;                CHE CKIN
  9605   "RTN","SDM XSCHP",63, 0)
  9606    ;                CHE CKOUT
  9607   "RTN","SDM XSCHP",64, 0)
  9608    ;                CAN CEL
  9609   "RTN","SDM XSCHP",65, 0)
  9610    ;                NOS HOW
  9611   "RTN","SDM XSCHP",66, 0)
  9612    ;                UND OCHECKIN
  9613   "RTN","SDM XSCHP",67, 0)
  9614    ;                UND OCHECKOUT
  9615   "RTN","SDM XSCHP",68, 0)
  9616    ;                UND ONOSHOW
  9617   "RTN","SDM XSCHP",69, 0)
  9618    ;                UND OCANCEL
  9619   "RTN","SDM XSCHP",70, 0)
  9620    ;
  9621   "RTN","SDM XSCHP",71, 0)
  9622    N ACTIONL IST,MESSAG ESTATUS,AP PTSTATUS,C ONTEXTARY, EVENT
  9623   "RTN","SDM XSCHP",72, 0)
  9624    ;
  9625   "RTN","SDM XSCHP",73, 0)
  9626    ; check r equirement s
  9627   "RTN","SDM XSCHP",74, 0)
  9628    I $G(PATI ENTIEN)=""  S PATIENT IEN=$G(MSG ARY("PATIE NT IEN"))
  9629   "RTN","SDM XSCHP",75, 0)
  9630    I PATIENT IEN="" Q " "
  9631   "RTN","SDM XSCHP",76, 0)
  9632    I $G(APPT DT)="" S A PPTDT=$G(M SGARY("APP TDT"))
  9633   "RTN","SDM XSCHP",77, 0)
  9634    I APPTDT= "" Q ""
  9635   "RTN","SDM XSCHP",78, 0)
  9636    ;
  9637   "RTN","SDM XSCHP",79, 0)
  9638    ;
  9639   "RTN","SDM XSCHP",80, 0)
  9640    ; get App ointment f rom VistA  to compare  to the me ssage
  9641   "RTN","SDM XSCHP",81, 0)
  9642    ;
  9643   "RTN","SDM XSCHP",82, 0)
  9644    ;
  9645   "RTN","SDM XSCHP",83, 0)
  9646    I $G(APPT ARY("CLINI C"))'="",$ G(MSGARY(" CLINIC"))' ="" D CHEC KCL(.MSGAR Y,.APPTARY )
  9647   "RTN","SDM XSCHP",84, 0)
  9648    ;
  9649   "RTN","SDM XSCHP",85, 0)
  9650    ; setup p rimary key s to the c ontext log ic
  9651   "RTN","SDM XSCHP",86, 0)
  9652    S MESSAGE STATUS=$G( MSGARY("ST ATUS"))
  9653   "RTN","SDM XSCHP",87, 0)
  9654    S APPTSTA TUS=$G(APP TARY("STAT US"))
  9655   "RTN","SDM XSCHP",88, 0)
  9656    I APPTSTA TUS="" S A PPTSTATUS= "NA"   ;No  appointme nt status
  9657   "RTN","SDM XSCHP",89, 0)
  9658    S EVENT=$ G(MSGARY(" EVENT"))
  9659   "RTN","SDM XSCHP",90, 0)
  9660    ;
  9661   "RTN","SDM XSCHP",91, 0)
  9662    ; setup e vent. Cont ext for ca ncel and n o show are  specific
  9663   "RTN","SDM XSCHP",92, 0)
  9664    I '$$INST RING^SDMXC ORE(EVENT, "CANCEL,NO SHOW") S E VENT="APPT "
  9665   "RTN","SDM XSCHP",93, 0)
  9666    ;
  9667   "RTN","SDM XSCHP",94, 0)
  9668    ; Get con text Logic
  9669   "RTN","SDM XSCHP",95, 0)
  9670    D CONTEXT (.CONTEXTA RY)
  9671   "RTN","SDM XSCHP",96, 0)
  9672    ;
  9673   "RTN","SDM XSCHP",97, 0)
  9674    ; Determi ne Schedul ing action  list
  9675   "RTN","SDM XSCHP",98, 0)
  9676    S ACTIONL IST=$G(CON TEXTARY(EV ENT,APPTST ATUS,MESSA GESTATUS))
  9677   "RTN","SDM XSCHP",99, 0)
  9678    I ACTIONL IST'="" Q  ACTIONLIST
  9679   "RTN","SDM XSCHP",100 ,0)
  9680    S ACTIONL IST=$G(CON TEXTARY(EV ENT,APPTST ATUS))
  9681   "RTN","SDM XSCHP",101 ,0)
  9682    I ACTIONL IST'="" Q  ACTIONLIST
  9683   "RTN","SDM XSCHP",102 ,0)
  9684    S ACTIONL IST=$G(CON TEXTARY(EV ENT))
  9685   "RTN","SDM XSCHP",103 ,0)
  9686    Q ACTIONL IST
  9687   "RTN","SDM XSCHP",104 ,0)
  9688   CONTEXT(CO NTEXT) ; S AFE proces sor array  for compar isons of s cheduling  message st ate agains t
  9689   "RTN","SDM XSCHP",105 ,0)
  9690    ;               appo intment me ssage stat e to make  sure the a ppropriate  action is  taken
  9691   "RTN","SDM XSCHP",106 ,0)
  9692    ;               to g et the app ointment i n Sync wit h what is  in the mes sage.
  9693   "RTN","SDM XSCHP",107 ,0)
  9694    ;
  9695   "RTN","SDM XSCHP",108 ,0)
  9696    ;   CONTE XT (O,REQ)  - Context  array for  the appoi ntment act ion list
  9697   "RTN","SDM XSCHP",109 ,0)
  9698    ;                       CONTEXT (EVENT,APP TSTATUS,ME SSAGESTATU S)
  9699   "RTN","SDM XSCHP",110 ,0)
  9700    ;
  9701   "RTN","SDM XSCHP",111 ,0)
  9702    ;                       Availab le Events  are as fol lows:
  9703   "RTN","SDM XSCHP",112 ,0)
  9704    ;                         APPT   - use for  S12 and S 14 events  as they ca n be treat ed similar  for appoi ntment act ions to ta ke
  9705   "RTN","SDM XSCHP",113 ,0)
  9706    ;                         CANCE L - S15 ev ents have  special pr ecedent to  just perf orm the ac tion
  9707   "RTN","SDM XSCHP",114 ,0)
  9708    ;                         NOSHO W - S26 ev ents have  special pr ecedent to  just perf orm the ac tion.
  9709   "RTN","SDM XSCHP",115 ,0)
  9710    ;
  9711   "RTN","SDM XSCHP",116 ,0)
  9712    ;                       Availab le statuse s are as f ollows:
  9713   "RTN","SDM XSCHP",117 ,0)
  9714    ;                         SCHED ULED
  9715   "RTN","SDM XSCHP",118 ,0)
  9716    ;                         CHECK ED IN
  9717   "RTN","SDM XSCHP",119 ,0)
  9718    ;                         CHECK ED OUT
  9719   "RTN","SDM XSCHP",120 ,0)
  9720    ;                         CANCE LLED
  9721   "RTN","SDM XSCHP",121 ,0)
  9722    ;                         NO SH OW
  9723   "RTN","SDM XSCHP",122 ,0)
  9724    ;                         NA -  This statu s is used  for APPTST ATUS only  when no ap pointment  exists in  VistA
  9725   "RTN","SDM XSCHP",123 ,0)
  9726    ;
  9727   "RTN","SDM XSCHP",124 ,0)
  9728    ;
  9729   "RTN","SDM XSCHP",125 ,0)
  9730    K CONTEXT  S CONTEXT =""   ;for ce output  parameter
  9731   "RTN","SDM XSCHP",126 ,0)
  9732    ;
  9733   "RTN","SDM XSCHP",127 ,0)
  9734    ; Load co ntext to t he array.
  9735   "RTN","SDM XSCHP",128 ,0)
  9736    S CONTEXT ("APPT","S CHEDULED", "SCHEDULED ")="UPDATE "
  9737   "RTN","SDM XSCHP",129 ,0)
  9738    S CONTEXT ("APPT","S CHEDULED", "CHECKED I N")="UPDAT E,CHECKIN"
  9739   "RTN","SDM XSCHP",130 ,0)
  9740    S CONTEXT ("APPT","S CHEDULED", "CHECKED O UT")="UPDA TE,CHECKIN ,CHECKOUT"
  9741   "RTN","SDM XSCHP",131 ,0)
  9742    S CONTEXT ("APPT","S CHEDULED", "CANCELLED ")="UPDATE ,CANCEL"
  9743   "RTN","SDM XSCHP",132 ,0)
  9744    S CONTEXT ("APPT","S CHEDULED", "NO SHOW") ="UPDATE,N OSHOW"
  9745   "RTN","SDM XSCHP",133 ,0)
  9746    S CONTEXT ("APPT","C HECKED IN" ,"SCHEDULE D")="UPDAT E,UNDOCHEC KIN"
  9747   "RTN","SDM XSCHP",134 ,0)
  9748    S CONTEXT ("APPT","C HECKED IN" ,"CHECKED  IN")="UPDA TE"
  9749   "RTN","SDM XSCHP",135 ,0)
  9750    S CONTEXT ("APPT","C HECKED IN" ,"CHECKED  OUT")="UPD ATE,CHECKO UT"
  9751   "RTN","SDM XSCHP",136 ,0)
  9752    S CONTEXT ("APPT","C HECKED IN" ,"CANCELLE D")="UPDAT E,UNDOCHEC KIN,CANCEL "
  9753   "RTN","SDM XSCHP",137 ,0)
  9754    S CONTEXT ("APPT","C HECKED IN" ,"NO SHOW" )="UPDATE, UNDOCHECKI N,NOSHOW"
  9755   "RTN","SDM XSCHP",138 ,0)
  9756    S CONTEXT ("APPT","C HECKED OUT ","SCHEDUL ED")="UPDA TE,UNDOCHE CKOUT,UNDO CHECKIN"
  9757   "RTN","SDM XSCHP",139 ,0)
  9758    S CONTEXT ("APPT","C HECKED OUT ","CHECKED  IN")="UPD ATE,UNDOCH ECKOUT"
  9759   "RTN","SDM XSCHP",140 ,0)
  9760    S CONTEXT ("APPT","C HECKED OUT ","CHECKED  OUT")="UP DATE"
  9761   "RTN","SDM XSCHP",141 ,0)
  9762    S CONTEXT ("APPT","C HECKED OUT ","CANCELL ED")="UPDA TE,UNDOCHE CKOUT,UNDO CHECKIN,CA NCEL"
  9763   "RTN","SDM XSCHP",142 ,0)
  9764    S CONTEXT ("APPT","C HECKED OUT ","NO SHOW ")="UPDATE ,UNDOCHECK OUT,UNDOCH ECKIN,NOSH OW"
  9765   "RTN","SDM XSCHP",143 ,0)
  9766    S CONTEXT ("APPT","C ANCELLED", "SCHEDULED ")="UNDOCA NCEL"
  9767   "RTN","SDM XSCHP",144 ,0)
  9768    S CONTEXT ("APPT","C ANCELLED", "CHECKED I N")="UNDOC ANCEL,CHEC KIN"
  9769   "RTN","SDM XSCHP",145 ,0)
  9770    S CONTEXT ("APPT","C ANCELLED", "CHECKED O UT")="UNDO CANCEL,CHE CKIN,CHECK OUT"
  9771   "RTN","SDM XSCHP",146 ,0)
  9772    S CONTEXT ("APPT","C ANCELLED", "CANCELLED ")="UPDATE ,CANCEL"
  9773   "RTN","SDM XSCHP",147 ,0)
  9774    S CONTEXT ("APPT","C ANCELLED", "NO SHOW") ="UNDOCANC EL,NOSHOW"
  9775   "RTN","SDM XSCHP",148 ,0)
  9776    S CONTEXT ("APPT","N O SHOW","S CHEDULED") ="UPDATE,U NDONOSHOW"
  9777   "RTN","SDM XSCHP",149 ,0)
  9778    S CONTEXT ("APPT","N O SHOW","C HECKED IN" )="UPDATE, UNDONOSHOW ,CHECKIN"
  9779   "RTN","SDM XSCHP",150 ,0)
  9780    S CONTEXT ("APPT","N O SHOW","C HECKED OUT ")="UPDATE ,UNDONOSHO W,CHECKIN, CHECKOUT"
  9781   "RTN","SDM XSCHP",151 ,0)
  9782    S CONTEXT ("APPT","N O SHOW","C ANCELLED") ="UPDATE,U NDONOSHOW, CANCEL"
  9783   "RTN","SDM XSCHP",152 ,0)
  9784    S CONTEXT ("APPT","N O SHOW","N O SHOW")=" UPDATE,NOS HOW"
  9785   "RTN","SDM XSCHP",153 ,0)
  9786    S CONTEXT ("APPT","N A","SCHEDU LED")="SCH EDULE"
  9787   "RTN","SDM XSCHP",154 ,0)
  9788    S CONTEXT ("APPT","N A","CHECKE D IN")="SC HEDULE,CHE CKIN"
  9789   "RTN","SDM XSCHP",155 ,0)
  9790    S CONTEXT ("APPT","N A","CHECKE D OUT")="S CHEDULE,CH ECKIN,CHEC KOUT"
  9791   "RTN","SDM XSCHP",156 ,0)
  9792    S CONTEXT ("APPT","N A","CANCEL LED")="SCH EDULE,CANC EL"
  9793   "RTN","SDM XSCHP",157 ,0)
  9794    S CONTEXT ("APPT","N A","NO SHO W")="SCHED ULE,NOSHOW "
  9795   "RTN","SDM XSCHP",158 ,0)
  9796    S CONTEXT ("APPT","N A")="SCHED ULE"
  9797   "RTN","SDM XSCHP",159 ,0)
  9798    S CONTEXT ("APPT")=" UPDATE"
  9799   "RTN","SDM XSCHP",160 ,0)
  9800    S CONTEXT ("CANCEL") ="UPDATE,C ANCEL"
  9801   "RTN","SDM XSCHP",161 ,0)
  9802    S CONTEXT ("CANCEL", "CANCELLED ")="UPDATE ,CANCEL"
  9803   "RTN","SDM XSCHP",162 ,0)
  9804    S CONTEXT ("CANCEL", "NA")="SCH EDULE,CANC EL"
  9805   "RTN","SDM XSCHP",163 ,0)
  9806    S CONTEXT ("CANCEL", "CHECKED I N")="UPDAT E,UNDOCHEC KIN,CANCEL "
  9807   "RTN","SDM XSCHP",164 ,0)
  9808    S CONTEXT ("CANCEL", "CHECKED O UT")="UPDA TE,UNDOCHE CKOUT,UNDO CHECKIN,CA NCEL"
  9809   "RTN","SDM XSCHP",165 ,0)
  9810    S CONTEXT ("CANCEL", "NO SHOW") ="UPDATE,U NDONOSHOW, CANCEL"
  9811   "RTN","SDM XSCHP",166 ,0)
  9812    S CONTEXT ("CANCEL", "NO SHOW", "NO SHOW") ="UPDATE,N OSHOW"
  9813   "RTN","SDM XSCHP",167 ,0)
  9814    S CONTEXT ("NOSHOW") ="UPDATE,N OSHOW"
  9815   "RTN","SDM XSCHP",168 ,0)
  9816    S CONTEXT ("NOSHOW", "NO SHOW") ="UPDATE,N OSHOW"
  9817   "RTN","SDM XSCHP",169 ,0)
  9818    S CONTEXT ("NOSHOW", "NA")="SCH EDULE,NOSH OW"
  9819   "RTN","SDM XSCHP",170 ,0)
  9820    S CONTEXT ("NOSHOW", "CHECKED I N")="UPDAT E,UNDOCHEC KIN,NOSHOW "
  9821   "RTN","SDM XSCHP",171 ,0)
  9822    S CONTEXT ("NOSHOW", "CHECKED O UT")="UPDA TE,UNDOCHE CKOUT,UNDO CHECKIN,NO SHOW"
  9823   "RTN","SDM XSCHP",172 ,0)
  9824    S CONTEXT ("NOSHOW", "CANCELLED ")="UNDOCA NCEL,NOSHO W"
  9825   "RTN","SDM XSCHP",173 ,0)
  9826    S CONTEXT ("NOSHOW", "SCHEDULED ","NO SHOW ")="UPDATE ,NOSHOW"
  9827   "RTN","SDM XSCHP",174 ,0)
  9828    ;
  9829   "RTN","SDM XSCHP",175 ,0)
  9830    Q
  9831   "RTN","SDM XSCHP",176 ,0)
  9832   PROCESS(AC TIONLIST,M SGARY,APPT ARY) ; Con text logic  array for  compariso ns
  9833   "RTN","SDM XSCHP",177 ,0)
  9834    ;
  9835   "RTN","SDM XSCHP",178 ,0)
  9836    ;   ACTIO NLIST (I,R EQ) - Comm a delimite d list of  actions to  perform
  9837   "RTN","SDM XSCHP",179 ,0)
  9838    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9839   "RTN","SDM XSCHP",180 ,0)
  9840    ;   APPTA RY (I,OPT)  - THE PAR SED VISTA  APPOINTMEN T ARRAY
  9841   "RTN","SDM XSCHP",181 ,0)
  9842    N ACTION, COUNT,HLOD UZ
  9843   "RTN","SDM XSCHP",182 ,0)
  9844    S (ACTION ,COUNT)=""
  9845   "RTN","SDM XSCHP",183 ,0)
  9846    S HLODUZ= $G(DUZ)
  9847   "RTN","SDM XSCHP",184 ,0)
  9848    S DUZ=$G( MSGARY("US ER"))   ;s et DUZ var iable to b e assumed  into any p rocessing  APIs that  expect it.
  9849   "RTN","SDM XSCHP",185 ,0)
  9850    ;
  9851   "RTN","SDM XSCHP",186 ,0)
  9852    ; Process  action
  9853   "RTN","SDM XSCHP",187 ,0)
  9854    F COUNT=1 :1:$L($G(A CTIONLIST) ,",") D
  9855   "RTN","SDM XSCHP",188 ,0)
  9856    . S ACTIO N=$P($G(AC TIONLIST), ",",COUNT)
  9857   "RTN","SDM XSCHP",189 ,0)
  9858    . I $G(AC TION)="" Q
  9859   "RTN","SDM XSCHP",190 ,0)
  9860    . ; ACTIO N PROCESSI NG
  9861   "RTN","SDM XSCHP",191 ,0)
  9862    . I ACTIO N="SCHEDUL E" D SCHED ULE(.MSGAR Y,ACTION,A CTIONLIST, .APPTARY)  Q
  9863   "RTN","SDM XSCHP",192 ,0)
  9864    . ;
  9865   "RTN","SDM XSCHP",193 ,0)
  9866    . I ACTIO N="UPDATE"  D SCHEDUL E(.MSGARY, ACTION,ACT IONLIST,.A PPTARY) Q
  9867   "RTN","SDM XSCHP",194 ,0)
  9868    . ;
  9869   "RTN","SDM XSCHP",195 ,0)
  9870    . I ACTIO N="CHECKIN " D CHECKI N(.MSGARY)  Q
  9871   "RTN","SDM XSCHP",196 ,0)
  9872    . ;
  9873   "RTN","SDM XSCHP",197 ,0)
  9874    . I ACTIO N="CHECKOU T" D CHECK OUT(.MSGAR Y) Q
  9875   "RTN","SDM XSCHP",198 ,0)
  9876    . ;
  9877   "RTN","SDM XSCHP",199 ,0)
  9878    . I ACTIO N="CANCEL"  D CANCEL( .MSGARY) Q
  9879   "RTN","SDM XSCHP",200 ,0)
  9880    . ;
  9881   "RTN","SDM XSCHP",201 ,0)
  9882    . I ACTIO N="NOSHOW"  D NOSHOW( .MSGARY) Q
  9883   "RTN","SDM XSCHP",202 ,0)
  9884    . ;
  9885   "RTN","SDM XSCHP",203 ,0)
  9886    . I ACTIO N="UNDOCHE CKIN" D UN CHKIN(.MSG ARY) Q
  9887   "RTN","SDM XSCHP",204 ,0)
  9888    . ;
  9889   "RTN","SDM XSCHP",205 ,0)
  9890    . I ACTIO N="UNDOCHE CKOUT" D U NCHKOUT(.M SGARY) Q
  9891   "RTN","SDM XSCHP",206 ,0)
  9892    . ;
  9893   "RTN","SDM XSCHP",207 ,0)
  9894    . I ACTIO N="UNDONOS HOW" D UNN OSHOW(.MSG ARY) Q
  9895   "RTN","SDM XSCHP",208 ,0)
  9896    . ;
  9897   "RTN","SDM XSCHP",209 ,0)
  9898    . I ACTIO N="UNDOCAN CEL" D UNC ANCEL(.MSG ARY),SCHED ULE(.MSGAR Y,ACTION,A CTIONLIST, .APPTARY)  Q
  9899   "RTN","SDM XSCHP",210 ,0)
  9900    S DUZ=HLO DUZ
  9901   "RTN","SDM XSCHP",211 ,0)
  9902    Q
  9903   "RTN","SDM XSCHP",212 ,0)
  9904   SCHEDULE(M SGARY,ACTI ON,ACTIONL IST,APPTAR Y) ; Proce ss Schedul e messages
  9905   "RTN","SDM XSCHP",213 ,0)
  9906    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9907   "RTN","SDM XSCHP",214 ,0)
  9908    ;   ACTIO N (I,OPT)  - Scheduli ng action
  9909   "RTN","SDM XSCHP",215 ,0)
  9910    ;   ACTIO NLIST (I,O PT)- THE S ERIES OF S CHEDULING  ACTIONS
  9911   "RTN","SDM XSCHP",216 ,0)
  9912    ;   APPTA RY (I,OPT)  - THE PAR SED VISTA  APPOINTMEN T ARRAY
  9913   "RTN","SDM XSCHP",217 ,0)
  9914    N PATIEN, CLINIEN,AP TYP,APDT,D UR,USER,EL IG,COMM,PI DT,ORDARY, WIN,CONARY ,OLDCL,CAN FL
  9915   "RTN","SDM XSCHP",218 ,0)
  9916    S PATIEN= $G(MSGARY( "PATIENT I EN"))
  9917   "RTN","SDM XSCHP",219 ,0)
  9918    S CLINIEN =$G(MSGARY ("CLINIC") )
  9919   "RTN","SDM XSCHP",220 ,0)
  9920    S APTYP=$ G(MSGARY(" APPTTYPE") )
  9921   "RTN","SDM XSCHP",221 ,0)
  9922    S APDT=$G (MSGARY("A PPTDT"))
  9923   "RTN","SDM XSCHP",222 ,0)
  9924    S DUR=$G( MSGARY("DU RATION"))
  9925   "RTN","SDM XSCHP",223 ,0)
  9926    S USER=$G (MSGARY("U SER"))
  9927   "RTN","SDM XSCHP",224 ,0)
  9928    S ELIG=$G (MSGARY("E LIGIBILITY "))
  9929   "RTN","SDM XSCHP",225 ,0)
  9930    S COMM=$G (MSGARY("C OMMENT"))
  9931   "RTN","SDM XSCHP",226 ,0)
  9932    S PIDT=$G (MSGARY("P AT INDICAT ED DATE"))
  9933   "RTN","SDM XSCHP",227 ,0)
  9934    M ORDARY= MSGARY("OR DER ID")
  9935   "RTN","SDM XSCHP",228 ,0)
  9936    S WIN=$G( MSGARY("WA LK IN"))
  9937   "RTN","SDM XSCHP",229 ,0)
  9938    M CONARY= MSGARY("CO NSULT ID")
  9939   "RTN","SDM XSCHP",230 ,0)
  9940    S OLDCL=$ G(MSGARY(" OLD CLINIC "))
  9941   "RTN","SDM XSCHP",231 ,0)
  9942    S ACTION= $G(ACTION)
  9943   "RTN","SDM XSCHP",232 ,0)
  9944    D MAKE^SD MXMAKE(PAT IEN,CLINIE N,APTYP,AP DT,DUR,USE R,ELIG,COM M,PIDT,.OR DARY,WIN,. CONARY,OLD CL,ACTION, ACTIONLIST ,.MSGARY,. APPTARY) ;
  9945   "RTN","SDM XSCHP",233 ,0)
  9946    Q
  9947   "RTN","SDM XSCHP",234 ,0)
  9948   CHECKIN(MS GARY) ; Pr ocess  Che ck In mess ages
  9949   "RTN","SDM XSCHP",235 ,0)
  9950    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9951   "RTN","SDM XSCHP",236 ,0)
  9952    N USER
  9953   "RTN","SDM XSCHP",237 ,0)
  9954    S USER=$S (+$G(MSGAR Y("CHECKIN  USER"))>0 :$G(MSGARY ("CHECKIN  USER")),1: $G(MSGARY( "USER")))
  9955   "RTN","SDM XSCHP",238 ,0)
  9956    ;
  9957   "RTN","SDM XSCHP",239 ,0)
  9958    D CHKIN^S DMXCHKI($G (MSGARY("P ATIENT IEN ")),$G(MSG ARY("CLINI C")),$G(MS GARY("APPT DT")),$G(M SGARY("CHE CKINDT")), USER)
  9959   "RTN","SDM XSCHP",240 ,0)
  9960    Q
  9961   "RTN","SDM XSCHP",241 ,0)
  9962   CHECKOUT(M SGARY) ; P rocess Che ck Out mes sages
  9963   "RTN","SDM XSCHP",242 ,0)
  9964    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9965   "RTN","SDM XSCHP",243 ,0)
  9966    N USER
  9967   "RTN","SDM XSCHP",244 ,0)
  9968    S USER=$S (+$G(MSGAR Y("CHECKOU T USER"))> 0:$G(MSGAR Y("CHECKIN  USER")),1 :$G(MSGARY ("USER")))
  9969   "RTN","SDM XSCHP",245 ,0)
  9970    ;
  9971   "RTN","SDM XSCHP",246 ,0)
  9972    D CHKOUT^ SDMXCHKO($ G(MSGARY(" PATIENT IE N")),$G(MS GARY("CLIN IC")),$G(M SGARY("APP TDT")),$G( MSGARY("CH ECKOUTDT") ),USER)
  9973   "RTN","SDM XSCHP",247 ,0)
  9974    Q
  9975   "RTN","SDM XSCHP",248 ,0)
  9976   CANCEL(MSG ARY) ; Pro cess Cance l messages
  9977   "RTN","SDM XSCHP",249 ,0)
  9978    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9979   "RTN","SDM XSCHP",250 ,0)
  9980    ;
  9981   "RTN","SDM XSCHP",251 ,0)
  9982    N CONSARY
  9983   "RTN","SDM XSCHP",252 ,0)
  9984    M CONSARY =MSGARY("C ONSULT ID" )
  9985   "RTN","SDM XSCHP",253 ,0)
  9986    ;
  9987   "RTN","SDM XSCHP",254 ,0)
  9988    D CANCAPP T^SDMXCANC ($G(MSGARY ("PATIENT  IEN")),$G( MSGARY("CL INIC")),$G (MSGARY("A PPTDT")),$ G(MSGARY(" USER")),$G (MSGARY("C ANCEL REAS ON")),$G(M SGARY("CAN CEL REMARK ")),.CONSA RY)
  9989   "RTN","SDM XSCHP",255 ,0)
  9990    Q  ;
  9991   "RTN","SDM XSCHP",256 ,0)
  9992   NOSHOW(MSG ARY) ; Pro cess No Sh ow message s
  9993   "RTN","SDM XSCHP",257 ,0)
  9994    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  9995   "RTN","SDM XSCHP",258 ,0)
  9996    ;
  9997   "RTN","SDM XSCHP",259 ,0)
  9998    N CONSARY
  9999   "RTN","SDM XSCHP",260 ,0)
  10000    M CONSARY =MSGARY("C ONSULT ID" )
  10001   "RTN","SDM XSCHP",261 ,0)
  10002    ;
  10003   "RTN","SDM XSCHP",262 ,0)
  10004    D NOSHOW^ SDMXNS($G( MSGARY("PA TIENT IEN" )),$G(MSGA RY("APPTDT ")),$G(MSG ARY("USER" )),$G(MSGA RY("CLINIC ")),.CONSA RY)
  10005   "RTN","SDM XSCHP",263 ,0)
  10006    Q
  10007   "RTN","SDM XSCHP",264 ,0)
  10008   UNCHKIN(MS GARY) ; Pr ocess Undo  Check In  messages
  10009   "RTN","SDM XSCHP",265 ,0)
  10010    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  10011   "RTN","SDM XSCHP",266 ,0)
  10012    ;
  10013   "RTN","SDM XSCHP",267 ,0)
  10014    D CCHKIN^ SDMXCHKI($ G(MSGARY(" PATIENT IE N")),$G(MS GARY("CLIN IC")),$G(M SGARY("APP TDT"))) ;
  10015   "RTN","SDM XSCHP",268 ,0)
  10016    Q  ;
  10017   "RTN","SDM XSCHP",269 ,0)
  10018   UNCHKOUT(M SGARY) ; P rocess Und o Check Ou t messages
  10019   "RTN","SDM XSCHP",270 ,0)
  10020    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  10021   "RTN","SDM XSCHP",271 ,0)
  10022    ;
  10023   "RTN","SDM XSCHP",272 ,0)
  10024    D CHKODEL ^SDMXCHKO( $G(MSGARY( "PATIENT I EN")),$G(M SGARY("APP TDT")),$G( MSGARY("CL INIC"))) ;
  10025   "RTN","SDM XSCHP",273 ,0)
  10026    Q
  10027   "RTN","SDM XSCHP",274 ,0)
  10028   UNNOSHOW(M SGARY) ; P rocess und o No Show  messages
  10029   "RTN","SDM XSCHP",275 ,0)
  10030    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  10031   "RTN","SDM XSCHP",276 ,0)
  10032    D UNNOSHO W^SDMXNS($ G(MSGARY(" PATIENT IE N")),$G(MS GARY("APPT DT")),"",$ G(MSGARY(" CLINIC")))
  10033   "RTN","SDM XSCHP",277 ,0)
  10034    Q
  10035   "RTN","SDM XSCHP",278 ,0)
  10036   UNCANCEL(M SGARY) ; P rocess und o cancel m essages
  10037   "RTN","SDM XSCHP",279 ,0)
  10038    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  10039   "RTN","SDM XSCHP",280 ,0)
  10040    ;
  10041   "RTN","SDM XSCHP",281 ,0)
  10042    D UNCANCE L^SDMXUCAN ($G(MSGARY ("PATIENT  IEN")),$G( MSGARY("CL INIC")),$G (MSGARY("A PPTDT")),$ G(MSGARY(" USER")))
  10043   "RTN","SDM XSCHP",282 ,0)
  10044    Q
  10045   "RTN","SDM XSCHP",283 ,0)
  10046   CHECKCL(MS GARY,APPTA RY) ; Chan ge clinic  if necessa ry
  10047   "RTN","SDM XSCHP",284 ,0)
  10048    ;   MSGAR Y (I,REQ)  - Appointm ent data a rray from  the messag e in the V istA data  structure  format.
  10049   "RTN","SDM XSCHP",285 ,0)
  10050    ;   APPTA RY (I,REQ)  - Appoint ment data  array from  VistA dat a structur e format.
  10051   "RTN","SDM XSCHP",286 ,0)
  10052    N CLINCHN G
  10053   "RTN","SDM XSCHP",287 ,0)
  10054    S APPTARY ("ENCOUNTE R IEN")=$G (APPTARY(" ENCOUNTER  IEN")),APP TARY("CLIN IC")=$G(AP PTARY("CLI NIC")),MSG ARY("CLINI C")=$G(MSG ARY("CLINI C")),APPTA RY("STATUS ")=$G(APPT ARY("STATU S"))
  10055   "RTN","SDM XSCHP",288 ,0)
  10056    ;
  10057   "RTN","SDM XSCHP",289 ,0)
  10058    S CLINCHN G=(APPTARY ("CLINIC") '=MSGARY(" CLINIC"))
  10059   "RTN","SDM XSCHP",290 ,0)
  10060    ;
  10061   "RTN","SDM XSCHP",291 ,0)
  10062    I CLINCHN G D
  10063   "RTN","SDM XSCHP",292 ,0)
  10064    . I APPTA RY("ENCOUN TER IEN")= "" D  Q    ;If an enc ounter has n't been l inked yet,  cancel th e current  appointmen t and rema ke it with  the new c linic
  10065   "RTN","SDM XSCHP",293 ,0)
  10066    . . D PUL LFWD(.APPT ARY)
  10067   "RTN","SDM XSCHP",294 ,0)
  10068    . . I APP TARY("STAT US")="CANC ELLED" Q
  10069   "RTN","SDM XSCHP",295 ,0)
  10070    . . D FIL ECANC^SDMX CANC($G(MS GARY("PATI ENT IEN")) ,APPTARY(" CLINIC"),$ G(MSGARY(" APPTDT")), "C",$G(MSG ARY("USER" )),"",""," ",1)
  10071   "RTN","SDM XSCHP",296 ,0)
  10072    . . S APP TARY("STAT US")="CANC ELLED"
  10073   "RTN","SDM XSCHP",297 ,0)
  10074    . E  D  Q   ;If an e ncounter i s linked,  ignore the  clinic ch ange and u pdate the  current ap pointment
  10075   "RTN","SDM XSCHP",298 ,0)
  10076    . . S MSG ARY("CLINI C")=APPTAR Y("CLINIC" )
  10077   "RTN","SDM XSCHP",299 ,0)
  10078    . . D ERR LOG^SDMXER RO(351,"Cl inic chang e was not  filed, an  encounter  was alread y linked." ,1)
  10079   "RTN","SDM XSCHP",300 ,0)
  10080    Q
  10081   "RTN","SDM XSCHP",301 ,0)
  10082   PULLFWD(AP PTARY) ;Pu lls forwar d data for  clinic ch ange
  10083   "RTN","SDM XSCHP",302 ,0)
  10084    I $G(APPT ARY("CLINI C"))'="" S  MSGARY("O LD CLINIC" )=APPTARY( "CLINIC")
  10085   "RTN","SDM XSCHP",303 ,0)
  10086    I $G(APPT ARY("CHECK IN DT"))'= "" S MSGAR Y("CHECKIN DT")=APPTA RY("CHECKI N DT")
  10087   "RTN","SDM XSCHP",304 ,0)
  10088    I $G(APPT ARY("CHECK IN USER")) '="" S MSG ARY("CHECK IN USER")= APPTARY("C HECKIN USE R")
  10089   "RTN","SDM XSCHP",305 ,0)
  10090    I $G(APPT ARY("CHECK OUT DT"))' ="" S MSGA RY("CHECKO UTDT")=APP TARY("CHEC KOUT DT")
  10091   "RTN","SDM XSCHP",306 ,0)
  10092    I $G(APPT ARY("CHECK OUT USER") )'="" S MS GARY("CHEC KOUT USER" )=APPTARY( "CHECKOUT  USER")
  10093   "RTN","SDM XSCHP",307 ,0)
  10094    Q
  10095   "RTN","SDM XSCHP",308 ,0)
  10096    Q  ;;#eor #
  10097   "RTN","SDM XSCHT")
  10098   0^38^B5182 1384
  10099   "RTN","SDM XSCHT",1,0 )
  10100   SDMXSCHT ; MASS/SEL -  Appointme nt Trigger ;8/17/17
  10101   "RTN","SDM XSCHT",2,0 )
  10102    ;;5.3;Sch eduling;** 676**;AUGU ST 17,2017 ;Build 99
  10103   "RTN","SDM XSCHT",3,0 )
  10104    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  10105   "RTN","SDM XSCHT",4,0 )
  10106    ;  ICR#   Supported
  10107   "RTN","SDM XSCHT",5,0 )
  10108    ;  2263   $$GET^XPAR
  10109   "RTN","SDM XSCHT",6,0 )
  10110    ;  4716   $$NEWMSG^H LOAPI
  10111   "RTN","SDM XSCHT",7,0 )
  10112    ;  4716   $$ADDSEG^H LOAPI
  10113   "RTN","SDM XSCHT",8,0 )
  10114    ;  4717   $$SENDONE^ HLOAPI1
  10115   "RTN","SDM XSCHT",9,0 )
  10116    ;  4716   SET^HLOAPI
  10117   "RTN","SDM XSCHT",10, 0)
  10118    ;  4853   SETDT^HLOA PI4
  10119   "RTN","SDM XSCHT",11, 0)
  10120    ;  ###  $ $TRANORCD^ ORMXFMT
  10121   "RTN","SDM XSCHT",12, 0)
  10122    ;  ###     ^OR
  10123   "RTN","SDM XSCHT",13, 0)
  10124    ;  ###    PID^DGMXHL 7
  10125   "RTN","SDM XSCHT",14, 0)
  10126    ;  ###    SETXCN^DGM XHL7
  10127   "RTN","SDM XSCHT",15, 0)
  10128    Q
  10129   "RTN","SDM XSCHT",16, 0)
  10130   MAIN ; Tri ggers sche duling mes sages out  of VistA w hen an app ointment e vent occur s.
  10131   "RTN","SDM XSCHT",17, 0)
  10132    ; Receive d from SDA M APPOINTM ENT EVENTS  PROTOCOL
  10133   "RTN","SDM XSCHT",18, 0)
  10134    ;  SDATA  - uses str ucture <Ap pointment  IEN>^<DFN> ^<Appointm ent Date/T ime>^<Clin ic IEN>
  10135   "RTN","SDM XSCHT",19, 0)
  10136    ;  SDAMEV T - is the  schedulin g event
  10137   "RTN","SDM XSCHT",20, 0)
  10138    ;                1 =  MAKE
  10139   "RTN","SDM XSCHT",21, 0)
  10140    ;                2 =  CANCEL
  10141   "RTN","SDM XSCHT",22, 0)
  10142    ;                3 =  NO-SHOW
  10143   "RTN","SDM XSCHT",23, 0)
  10144    ;                4 =  CHECK-IN
  10145   "RTN","SDM XSCHT",24, 0)
  10146    ;                5 =  CHECK-OUT
  10147   "RTN","SDM XSCHT",25, 0)
  10148    ;                6 =  STOP CODE  ADD
  10149   "RTN","SDM XSCHT",26, 0)
  10150    ;                7 =  STOP CODE  CHANGE
  10151   "RTN","SDM XSCHT",27, 0)
  10152    ;                8 =  DISPOSITI ON ADD
  10153   "RTN","SDM XSCHT",28, 0)
  10154    ;                9 =  DISPOSITI ON CHANGE
  10155   "RTN","SDM XSCHT",29, 0)
  10156    ; If MASS  isn't ena bled, don' t trigger  messages
  10157   "RTN","SDM XSCHT",30, 0)
  10158    I '$$GET^ XPAR("SYS" ,"SDMX MAS S ENABLED" ) Q
  10159   "RTN","SDM XSCHT",31, 0)
  10160    ;
  10161   "RTN","SDM XSCHT",32, 0)
  10162    N CLINIC, FLAG,DFN,A PPTDT,APPT STAT
  10163   "RTN","SDM XSCHT",33, 0)
  10164    S CLINIC= $P($G(SDAT A),"^",4)
  10165   "RTN","SDM XSCHT",34, 0)
  10166    S DFN=$P( $G(SDATA), "^",2)
  10167   "RTN","SDM XSCHT",35, 0)
  10168    S APPTDT= $P($G(SDAT A),"^",3)
  10169   "RTN","SDM XSCHT",36, 0)
  10170    S FLAG=$$ GETFLAG^SD MXFLAG(CLI NIC)
  10171   "RTN","SDM XSCHT",37, 0)
  10172    I FLAG=0  Q   ;not a  MASS clin ic
  10173   "RTN","SDM XSCHT",38, 0)
  10174    S APPTSTA T=$$APTSTA T^SDMXGAPT (DFN,APPTD T)
  10175   "RTN","SDM XSCHT",39, 0)
  10176    ;
  10177   "RTN","SDM XSCHT",40, 0)
  10178    I $$INCIN TF^SDMXCOR E() Q  ;Do  not send  messages f rom incomi ng interfa ce
  10179   "RTN","SDM XSCHT",41, 0)
  10180    I ($G(SDA MEVT)="")! ($G(SDATA) ="") Q
  10181   "RTN","SDM XSCHT",42, 0)
  10182    I (SDAMEV T=4),(APPT STAT="CHEC KED IN") D  CHKIN(SDA TA)      ; Check In
  10183   "RTN","SDM XSCHT",43, 0)
  10184    E  I (SDA MEVT=5),(A PPTSTAT="C HECKED OUT ") D CHKOU T(SDATA)   ;Check Out
  10185   "RTN","SDM XSCHT",44, 0)
  10186    ;E  I SDA MEVT=2 D C ANCEL(SDAT A)  ;Cance l
  10187   "RTN","SDM XSCHT",45, 0)
  10188    Q
  10189   "RTN","SDM XSCHT",46, 0)
  10190   CHKIN(SDAT A) ; Trigg ers appoin tment chec k in messa ge out of  VistA
  10191   "RTN","SDM XSCHT",47, 0)
  10192    ;  SDATA  (I,REQ) -  <Appointme nt IEN>^<D FN>^<Appoi ntment Dat e/Time>^<C linic IEN>
  10193   "RTN","SDM XSCHT",48, 0)
  10194    ;  VPSREC  - set in  VPSRPC4 fo r kiosk ap pointment  record dat a. Checked  here to d etermine i f this che ck in came  from kios k.
  10195   "RTN","SDM XSCHT",49, 0)
  10196    ;
  10197   "RTN","SDM XSCHT",50, 0)
  10198    N OK,CHEC K
  10199   "RTN","SDM XSCHT",51, 0)
  10200    S CHECK=$ $GET^XPAR( "SYS","SDM X KIOSK CH ECK IN ONL Y")
  10201   "RTN","SDM XSCHT",52, 0)
  10202    I (CHECK' =0),($G(VP SREC)="")  Q
  10203   "RTN","SDM XSCHT",53, 0)
  10204    S OK=$$BU ILDHLO(SDA TA,"S14")
  10205   "RTN","SDM XSCHT",54, 0)
  10206    Q
  10207   "RTN","SDM XSCHT",55, 0)
  10208   CHKOUT(SDA TA) ;Trigg ers appoin tment chec k out mess age out of  VistA
  10209   "RTN","SDM XSCHT",56, 0)
  10210    ;  SDATA  (I,REQ) -  <Appointme nt IEN>^<D FN>^<Appoi ntment Dat e/Time>^<C linic IEN>
  10211   "RTN","SDM XSCHT",57, 0)
  10212    ;
  10213   "RTN","SDM XSCHT",58, 0)
  10214    N OK
  10215   "RTN","SDM XSCHT",59, 0)
  10216    S OK=$$BU ILDHLO(SDA TA,"S14")
  10217   "RTN","SDM XSCHT",60, 0)
  10218    Q
  10219   "RTN","SDM XSCHT",61, 0)
  10220   CANCEL(SDA TA) ; Trig gers appoi ntment can cel messag e out of V istA
  10221   "RTN","SDM XSCHT",62, 0)
  10222    ;  SDATA  (I,REQ) -  <Appointme nt IEN>^<D FN>^<Appoi ntment Dat e/Time>^<C linic IEN>
  10223   "RTN","SDM XSCHT",63, 0)
  10224    ;
  10225   "RTN","SDM XSCHT",64, 0)
  10226    N OK
  10227   "RTN","SDM XSCHT",65, 0)
  10228    S OK=$$BU ILDHLO(SDA TA,"S15")
  10229   "RTN","SDM XSCHT",66, 0)
  10230    Q
  10231   "RTN","SDM XSCHT",67, 0)
  10232   BUILDHLO(S DATA,EVENT ,LINK) ; B uilds sche duling mes sage using  HLO and q ueues it
  10233   "RTN","SDM XSCHT",68, 0)
  10234    ;  SDATA  (I,REQ) -  <Appointme nt IEN>^<D FN>^<Appoi ntment Dat e/Time>^<C linic IEN>
  10235   "RTN","SDM XSCHT",69, 0)
  10236    ;  EVENT  (I,REQ,DEF AULT:S14)  - Scheduli ng event ( Example: S 14)
  10237   "RTN","SDM XSCHT",70, 0)
  10238    ;  LINK ( I,OPT,DEFA ULT:SD SIU  OUT) - HL  Logical L ink to use .
  10239   "RTN","SDM XSCHT",71, 0)
  10240    ;
  10241   "RTN","SDM XSCHT",72, 0)
  10242    N PARMS,M SG,ERROR,S EG,HL,SCIE N,DFN,SDT, CLINIEN,AP PTARY,PROV NUM,RET,OB XNUM,WHOTO ,MASSESC,E SCCHAR
  10243   "RTN","SDM XSCHT",73, 0)
  10244    S RET=""
  10245   "RTN","SDM XSCHT",74, 0)
  10246    S OBXNUM= 0
  10247   "RTN","SDM XSCHT",75, 0)
  10248    S MASSESC =$$GET^XPA R("SYS","M ASS ASCII  CHARACTER  SWITCH")
  10249   "RTN","SDM XSCHT",76, 0)
  10250    S ESCCHAR =$$GET^XPA R("SYS","M ASS ASCII  CHAR REPLA CEMENT")
  10251   "RTN","SDM XSCHT",77, 0)
  10252    I $G(LINK )="" S LIN K="SD SIU  OUT"
  10253   "RTN","SDM XSCHT",78, 0)
  10254    S SCIEN=$ P(SDATA,"^ ",1)  ;App ointment I EN
  10255   "RTN","SDM XSCHT",79, 0)
  10256    S DFN=$P( SDATA,"^", 2)  ;Patie nt DFN
  10257   "RTN","SDM XSCHT",80, 0)
  10258    S SDT=$P( SDATA,"^", 3)  ;Appoi ntment Dat e/Time
  10259   "RTN","SDM XSCHT",81, 0)
  10260    S CLINIEN =$P(SDATA, "^",4)  ;C linic IEN
  10261   "RTN","SDM XSCHT",82, 0)
  10262    I $G(EVEN T)="" S EV ENT="S14"
  10263   "RTN","SDM XSCHT",83, 0)
  10264    S PARMS(" EVENT")=EV ENT
  10265   "RTN","SDM XSCHT",84, 0)
  10266    S PARMS(" MESSAGE TY PE")="SIU"
  10267   "RTN","SDM XSCHT",85, 0)
  10268    D GETAPPT ^SDMXGAPT( DFN,SDT,.A PPTARY)
  10269   "RTN","SDM XSCHT",86, 0)
  10270    I '$$NEWM SG^HLOAPI( .PARMS,.MS G,.ERROR)  S RET="FAI L!" Q RET
  10271   "RTN","SDM XSCHT",87, 0)
  10272    D SCH(SDA TA,.APPTAR Y,EVENT,.S EG)
  10273   "RTN","SDM XSCHT",88, 0)
  10274    I MASSESC  D ESCINVL D^SDMXCORE (.SEG,ESCC HAR)
  10275   "RTN","SDM XSCHT",89, 0)
  10276    I '$$ADDS EG^HLOAPI( .MSG,.SEG, .ERROR) S  RET="FAIL! " Q RET
  10277   "RTN","SDM XSCHT",90, 0)
  10278    I $G(APPT ARY("COMME NT"))'=""  D  I RET'= "" Q RET
  10279   "RTN","SDM XSCHT",91, 0)
  10280    . D NTE(. APPTARY,.S EG)
  10281   "RTN","SDM XSCHT",92, 0)
  10282    . I MASSE SC D ESCIN VLD^SDMXCO RE(.SEG,ES CCHAR)
  10283   "RTN","SDM XSCHT",93, 0)
  10284    . I '$$AD DSEG^HLOAP I(.MSG,.SE G,.ERROR)  S RET="FAI L!"
  10285   "RTN","SDM XSCHT",94, 0)
  10286    D PID^DGM XHL7(DFN,1 ,.SEG)
  10287   "RTN","SDM XSCHT",95, 0)
  10288    I MASSESC  D ESCINVL D^SDMXCORE (.SEG,ESCC HAR)
  10289   "RTN","SDM XSCHT",96, 0)
  10290    I '$$ADDS EG^HLOAPI( .MSG,.SEG, .ERROR) S  RET="FAIL! " Q RET
  10291   "RTN","SDM XSCHT",97, 0)
  10292    D PV1(SDA TA,.APPTAR Y,.SEG)
  10293   "RTN","SDM XSCHT",98, 0)
  10294    I MASSESC  D ESCINVL D^SDMXCORE (.SEG,ESCC HAR)
  10295   "RTN","SDM XSCHT",99, 0)
  10296    I '$$ADDS EG^HLOAPI( .MSG,.SEG, .ERROR) S  RET="FAIL! " Q RET
  10297   "RTN","SDM XSCHT",100 ,0)
  10298    I $G(APPT ARY("PAT I NDICATED D ATE"))'=""  D
  10299   "RTN","SDM XSCHT",101 ,0)
  10300    . S OBXNU M=OBXNUM+1
  10301   "RTN","SDM XSCHT",102 ,0)
  10302    . D OBXPI D(OBXNUM,A PPTARY("PA T INDICATE D DATE"),. SEG)
  10303   "RTN","SDM XSCHT",103 ,0)
  10304    . I MASSE SC D ESCIN VLD^SDMXCO RE(.SEG,ES CCHAR)
  10305   "RTN","SDM XSCHT",104 ,0)
  10306    . I '$$AD DSEG^HLOAP I(.MSG,.SE G,.ERROR)  S RET="FAI L!"
  10307   "RTN","SDM XSCHT",105 ,0)
  10308    I $G(APPT ARY("ELIGI BILITY"))' ="" D
  10309   "RTN","SDM XSCHT",106 ,0)
  10310    . S OBXNU M=OBXNUM+1
  10311   "RTN","SDM XSCHT",107 ,0)
  10312    . D OBXEL IG(OBXNUM, APPTARY("E LIGIBILITY "),.SEG)
  10313   "RTN","SDM XSCHT",108 ,0)
  10314    . I MASSE SC D ESCIN VLD^SDMXCO RE(.SEG,ES CCHAR)
  10315   "RTN","SDM XSCHT",109 ,0)
  10316    . I '$$AD DSEG^HLOAP I(.MSG,.SE G,.ERROR)  S RET="FAI L!"
  10317   "RTN","SDM XSCHT",110 ,0)
  10318    I RET'=""  Q RET
  10319   "RTN","SDM XSCHT",111 ,0)
  10320    D RGS(.AP PTARY,.SEG )
  10321   "RTN","SDM XSCHT",112 ,0)
  10322    I MASSESC  D ESCINVL D^SDMXCORE (.SEG,ESCC HAR)
  10323   "RTN","SDM XSCHT",113 ,0)
  10324    I '$$ADDS EG^HLOAPI( .MSG,.SEG, .ERROR) S  RET="FAIL! " Q RET
  10325   "RTN","SDM XSCHT",114 ,0)
  10326    D AIP(.AP PTARY,.SEG )
  10327   "RTN","SDM XSCHT",115 ,0)
  10328    I MASSESC  D ESCINVL D^SDMXCORE (.SEG,ESCC HAR)
  10329   "RTN","SDM XSCHT",116 ,0)
  10330    I '$$ADDS EG^HLOAPI( .MSG,.SEG, .ERROR) S  RET="FAIL! " Q RET
  10331   "RTN","SDM XSCHT",117 ,0)
  10332    S PARMS(" SENDING AP PLICATION" )="SD-SIU- OUT"
  10333   "RTN","SDM XSCHT",118 ,0)
  10334    S WHOTO(" RECEIVING  APPLICATIO N")="MASS"
  10335   "RTN","SDM XSCHT",119 ,0)
  10336    S WHOTO(" FACILITY L INK NAME") =LINK
  10337   "RTN","SDM XSCHT",120 ,0)
  10338    S RET=$$S ENDONE^HLO API1(.MSG, .PARMS,.WH OTO,.ERROR )
  10339   "RTN","SDM XSCHT",121 ,0)
  10340    Q RET
  10341   "RTN","SDM XSCHT",122 ,0)
  10342   SCH(SDATA, APPTARY,EV ENT,SEG) ; Builds SCH  segment
  10343   "RTN","SDM XSCHT",123 ,0)
  10344    ;     SCH -6 Appoint ment Reaso n - APPTAR Y("CANCEL  REASON") f or S15, AP PTARY("STA TUS") for  everything  else
  10345   "RTN","SDM XSCHT",124 ,0)
  10346    ;     SCH -8 Appoint ment Type  - APPTARY( "APPTTYPE" )
  10347   "RTN","SDM XSCHT",125 ,0)
  10348    ;     SCH -9 Appoint ment Durat ion - APPT ARY("DURAT ION")
  10349   "RTN","SDM XSCHT",126 ,0)
  10350    ;     SCH -10 Apoint ment Durat ion Unit -  "MIN"
  10351   "RTN","SDM XSCHT",127 ,0)
  10352    ;     SCH -11.4 Appo intment Da te/Time -  APPTARY("A PPTDT")
  10353   "RTN","SDM XSCHT",128 ,0)
  10354    ;     SCH -16 Appoin tment Sche duling Use r - APPTAR Y("USER"/" CHECKIN US ER"/"CHECK OUT USER")
  10355   "RTN","SDM XSCHT",129 ,0)
  10356    ;     SCH -20 Appoin tment Sche duling Use r - APPTAR Y("USER"/" CHECKIN US ER"/"CHECK OUT USER")
  10357   "RTN","SDM XSCHT",130 ,0)
  10358    ;     SCH -25 Appoin tment Stat us - APPTA RY("STATUS ")
  10359   "RTN","SDM XSCHT",131 ,0)
  10360    ;     SCH -27 Appoin tment link ed consult  order (Wi ll be the  ID from th e OR file
  10361   "RTN","SDM XSCHT",132 ,0)
  10362    ;
  10363   "RTN","SDM XSCHT",133 ,0)
  10364    ;  SDATA  (I,REQ) -  <Appointme nt IEN>^<D FN>^<Appoi ntment Dat e/Time>^<C linic IEN>
  10365   "RTN","SDM XSCHT",134 ,0)
  10366    ;  APPTAR Y (IO,REQ)  - Appoint ment array  from GETA PPT^SDMXGA PT
  10367   "RTN","SDM XSCHT",135 ,0)
  10368    ;  EVENT  (I,REQ) -  message ev ent (Examp le: S15)
  10369   "RTN","SDM XSCHT",136 ,0)
  10370    ;  SEG (O ,REQ) - HL O Segment
  10371   "RTN","SDM XSCHT",137 ,0)
  10372    ;
  10373   "RTN","SDM XSCHT",138 ,0)
  10374    N SCIEN,A PPTTYPE,AP PTDUR,DURU NIT,STODAY ,SDSTAT,US ER,CONSORD ,CONS,CLIN IEN,DFN
  10375   "RTN","SDM XSCHT",139 ,0)
  10376    K SEG S S EG=""
  10377   "RTN","SDM XSCHT",140 ,0)
  10378    S SCIEN=$ P(SDATA,"^ ",1)
  10379   "RTN","SDM XSCHT",141 ,0)
  10380    S DFN=$P( SDATA,"^", 2)
  10381   "RTN","SDM XSCHT",142 ,0)
  10382    S SDT=$P( SDATA,"^", 3)
  10383   "RTN","SDM XSCHT",143 ,0)
  10384    S CLINIEN =$P(SDATA, "^",4)
  10385   "RTN","SDM XSCHT",144 ,0)
  10386    I $G(SDAM EVT)=4 S U SER=$G(APP TARY("CHEC KIN USER") )
  10387   "RTN","SDM XSCHT",145 ,0)
  10388    I $G(SDAM EVT)=5 S U SER=$G(APP TARY("CHEC KOUT USER" ))
  10389   "RTN","SDM XSCHT",146 ,0)
  10390    I $G(USER )="" S USE R=$G(APPTA RY("USER") )
  10391   "RTN","SDM XSCHT",147 ,0)
  10392    D SET^HLO API(.SEG," SCH",0)  ; SCH
  10393   "RTN","SDM XSCHT",148 ,0)
  10394    S APPTTYP E=$G(APPTA RY("APPTTY PE"))
  10395   "RTN","SDM XSCHT",149 ,0)
  10396    I EVENT=" S15" D  ;S CH-6
  10397   "RTN","SDM XSCHT",150 ,0)
  10398    . D SET^H LOAPI(.SEG ,$G(APPTAR Y("CANCEL  REASON")), 6,1)
  10399   "RTN","SDM XSCHT",151 ,0)
  10400    . D SET^H LOAPI(.SEG ,$$GET1^DI Q(409.2,$G (APPTARY(" CANCEL REA SON")),.01 ),6,2)
  10401   "RTN","SDM XSCHT",152 ,0)
  10402    E  D SET^ HLOAPI(.SE G,$G(APPTA RY("STATUS ")),6)
  10403   "RTN","SDM XSCHT",153 ,0)
  10404    D SET^HLO API(.SEG,A PPTTYPE,8, 1)  ;SCH-8
  10405   "RTN","SDM XSCHT",154 ,0)
  10406    D SET^HLO API(.SEG,$ $GET1^DIQ( 409.1,$G(A PPTARY("AP PTTYPE")), .01),8,2)
  10407   "RTN","SDM XSCHT",155 ,0)
  10408    S APPTDUR =$G(APPTAR Y("DURATIO N"))
  10409   "RTN","SDM XSCHT",156 ,0)
  10410    D SET^HLO API(.SEG,A PPTDUR,9)   ;SCH-9
  10411   "RTN","SDM XSCHT",157 ,0)
  10412    S DURUNIT ="MIN"
  10413   "RTN","SDM XSCHT",158 ,0)
  10414    D SET^HLO API(.SEG,D URUNIT,10)   ;SCH-10
  10415   "RTN","SDM XSCHT",159 ,0)
  10416    D SETDT^H LOAPI4(.SE G,$G(APPTA RY("APPTDT ")),11,4)   ;SCH-11.4
  10417   "RTN","SDM XSCHT",160 ,0)
  10418    D SETXCN^ DGMXHL7(.S EG,USER,16 )  ;SCH-16
  10419   "RTN","SDM XSCHT",161 ,0)
  10420    D SETXCN^ DGMXHL7(.S EG,USER,20 )  ;SCH-20
  10421   "RTN","SDM XSCHT",162 ,0)
  10422    D SET^HLO API(.SEG,$ G(APPTARY( "STATUS")) ,25)  ;SCH -25
  10423   "RTN","SDM XSCHT",163 ,0)
  10424    S CONS=$G (APPTARY(" CONSULT"))
  10425   "RTN","SDM XSCHT",164 ,0)
  10426    I CONS'=" " D
  10427   "RTN","SDM XSCHT",165 ,0)
  10428    . S CONSO RD=$$GET1^ DIQ(123,CO NS,.03)
  10429   "RTN","SDM XSCHT",166 ,0)
  10430    I $G(CONS ORD)'="" D
  10431   "RTN","SDM XSCHT",167 ,0)
  10432    . D SET^H LOAPI(.SEG ,$$TRANORC D^ORMXFMT( 2,"^OR(100 ")_"-"_CON SORD,27,1)   ;SCH-27. 1
  10433   "RTN","SDM XSCHT",168 ,0)
  10434    Q
  10435   "RTN","SDM XSCHT",169 ,0)
  10436   PV1(SDATA, APPTARY,SE G) ;Builds  PV1 segme nt
  10437   "RTN","SDM XSCHT",170 ,0)
  10438    ;     PV1 -1 Set ID  - 1
  10439   "RTN","SDM XSCHT",171 ,0)
  10440    ;     PV1 -2 Patient  Class - O
  10441   "RTN","SDM XSCHT",172 ,0)
  10442    ;     PV1 -3 Assigne d Patient  Location -  Clinic IE N
  10443   "RTN","SDM XSCHT",173 ,0)
  10444    ;
  10445   "RTN","SDM XSCHT",174 ,0)
  10446    ;  SDATA  (I,REQ) -  <Appointme nt IEN>^<D FN>^<Appoi ntment Dat e/Time>^<C linic IEN>
  10447   "RTN","SDM XSCHT",175 ,0)
  10448    ;  APPTAR Y (IO,REQ)  - Appoint ment array  from GETA PPT^SDMXGA PT
  10449   "RTN","SDM XSCHT",176 ,0)
  10450    ;  SEG (O ,REQ) - HL O Segment
  10451   "RTN","SDM XSCHT",177 ,0)
  10452    ;
  10453   "RTN","SDM XSCHT",178 ,0)
  10454    K SEG S S EG=""
  10455   "RTN","SDM XSCHT",179 ,0)
  10456    N CLINIEN
  10457   "RTN","SDM XSCHT",180 ,0)
  10458    S CLINIEN =$P(SDATA, "^",4)
  10459   "RTN","SDM XSCHT",181 ,0)
  10460    D SET^HLO API(.SEG," PV1",0)  ; PV1
  10461   "RTN","SDM XSCHT",182 ,0)
  10462    D SET^HLO API(.SEG," O",2)  ;PV 1-2
  10463   "RTN","SDM XSCHT",183 ,0)
  10464    D SET^HLO API(.SEG,$ G(APPTARY( "CLINIC NA ME")),3)   ;PV1-3
  10465   "RTN","SDM XSCHT",184 ,0)
  10466    I $G(APPT ARY("CHECK IN DT"))'= "" D SETDT ^HLOAPI4(. SEG,APPTAR Y("CHECKIN  DT"),44)
  10467   "RTN","SDM XSCHT",185 ,0)
  10468    I $G(APPT ARY("CHECK OUT DT"))' ="" D SETD T^HLOAPI4( .SEG,APPTA RY("CHECKO UT DT"),45 )
  10469   "RTN","SDM XSCHT",186 ,0)
  10470    Q
  10471   "RTN","SDM XSCHT",187 ,0)
  10472   NTE(APPTAR Y,SEG) ;Bu ilds NTE s egment
  10473   "RTN","SDM XSCHT",188 ,0)
  10474    ;     NTE -3 Comment
  10475   "RTN","SDM XSCHT",189 ,0)
  10476    ;
  10477   "RTN","SDM XSCHT",190 ,0)
  10478    ;  APPTAR Y (IO,REQ)  - Appoint ment array  from GETA PPT^SDMXGA PT
  10479   "RTN","SDM XSCHT",191 ,0)
  10480    ;  SEG (O ,REQ) - HL O Segment
  10481   "RTN","SDM XSCHT",192 ,0)
  10482    ;
  10483   "RTN","SDM XSCHT",193 ,0)
  10484    K SEG S S EG=""
  10485   "RTN","SDM XSCHT",194 ,0)
  10486    D SET^HLO API(.SEG," NTE",0)  ; NTE
  10487   "RTN","SDM XSCHT",195 ,0)
  10488    D SET^HLO API(.SEG,$ G(APPTARY( "COMMENT") ),3,1)  ;N TE-3.1
  10489   "RTN","SDM XSCHT",196 ,0)
  10490    Q
  10491   "RTN","SDM XSCHT",197 ,0)
  10492   RGS(APPTAR Y,SEG) ;Bu ilds RGS s egment
  10493   "RTN","SDM XSCHT",198 ,0)
  10494    ;     RGS -1 Set ID  - 1
  10495   "RTN","SDM XSCHT",199 ,0)
  10496    ;     RGS -3 Resourc e Group ID  - Clinic  IEN
  10497   "RTN","SDM XSCHT",200 ,0)
  10498    ;
  10499   "RTN","SDM XSCHT",201 ,0)
  10500    ;  APPTAR Y (IO,REQ)  - Appoint ment array  from GETA PPT^SDMXGA PT
  10501   "RTN","SDM XSCHT",202 ,0)
  10502    ;  SEG (O ,REQ) - HL O Segment
  10503   "RTN","SDM XSCHT",203 ,0)
  10504    ;
  10505   "RTN","SDM XSCHT",204 ,0)
  10506    K SEG S S EG=""
  10507   "RTN","SDM XSCHT",205 ,0)
  10508    D SET^HLO API(.SEG," RGS",0)  ; RGS
  10509   "RTN","SDM XSCHT",206 ,0)
  10510    D SET^HLO API(.SEG,1 ,1)  ;RGS- 1
  10511   "RTN","SDM XSCHT",207 ,0)
  10512    D SET^HLO API(.SEG,$ G(APPTARY( "CLINIC")) ,3,1)  ;RG S-3.1
  10513   "RTN","SDM XSCHT",208 ,0)
  10514    D SET^HLO API(.SEG,$ G(APPTARY( "CLINIC NA ME")),3,2)   ;RGS-3.2
  10515   "RTN","SDM XSCHT",209 ,0)
  10516    Q
  10517   "RTN","SDM XSCHT",210 ,0)
  10518   AIP(APPTAR Y,SEG) ;Bu ilds AIP s egment
  10519   "RTN","SDM XSCHT",211 ,0)
  10520    ;     AIP -3 Schedul able Resou rce - Clin ic IEN
  10521   "RTN","SDM XSCHT",212 ,0)
  10522    ;
  10523   "RTN","SDM XSCHT",213 ,0)
  10524    ;  APPTAR Y (IO,REQ)  - Appoint ment array  from GETA PPT^SDMXGA PT
  10525   "RTN","SDM XSCHT",214 ,0)
  10526    ;  SEG (O ,REQ) - HL O Segment
  10527   "RTN","SDM XSCHT",215 ,0)
  10528    ;
  10529   "RTN","SDM XSCHT",216 ,0)
  10530    K SEG S S EG=""
  10531   "RTN","SDM XSCHT",217 ,0)
  10532    D SET^HLO API(.SEG," AIP",0)  ; AIP
  10533   "RTN","SDM XSCHT",218 ,0)
  10534    D SET^HLO API(.SEG,$ G(APPTARY( "CLINIC")) ,3,1)  ;AI P-3.1
  10535   "RTN","SDM XSCHT",219 ,0)
  10536    D SET^HLO API(.SEG,$ G(APPTARY( "CLINIC NA ME")),3,2)   ;AIP-3.2
  10537   "RTN","SDM XSCHT",220 ,0)
  10538    Q
  10539   "RTN","SDM XSCHT",221 ,0)
  10540   OBXELIG(SE TID,ELIG,S EG) ;Build s OBX segm ent for el igibility
  10541   "RTN","SDM XSCHT",222 ,0)
  10542    ;     OBX -1 Set ID
  10543   "RTN","SDM XSCHT",223 ,0)
  10544    ;     OBX -3 "APPT E LIGIBILITY "
  10545   "RTN","SDM XSCHT",224 ,0)
  10546    ;     OBX -5 Eligibi lity
  10547   "RTN","SDM XSCHT",225 ,0)
  10548    ;
  10549   "RTN","SDM XSCHT",226 ,0)
  10550    ;  SETID  (I,REQ) -  Set ID tha t's set in  OBX-1
  10551   "RTN","SDM XSCHT",227 ,0)
  10552    ;  ELIG ( I,REQ) - E ligibility  value fro m appointm ent array
  10553   "RTN","SDM XSCHT",228 ,0)
  10554    ;  SEG (O ,REQ) - HL O Segment
  10555   "RTN","SDM XSCHT",229 ,0)
  10556    ;
  10557   "RTN","SDM XSCHT",230 ,0)
  10558    K SEG S S EG=""
  10559   "RTN","SDM XSCHT",231 ,0)
  10560    D SET^HLO API(.SEG," OBX",0)  ; OBX
  10561   "RTN","SDM XSCHT",232 ,0)
  10562    D SET^HLO API(.SEG,S ETID,1)  ; OBX-1
  10563   "RTN","SDM XSCHT",233 ,0)
  10564    D SET^HLO API(.SEG," APPT ELIGI BILITY",3)   ;OBX-3
  10565   "RTN","SDM XSCHT",234 ,0)
  10566    D SET^HLO API(.SEG,E LIG,5,1)   ;OBX-5.1
  10567   "RTN","SDM XSCHT",235 ,0)
  10568    D SET^HLO API(.SEG," NAME",5,2)   ;OBX-5.2
  10569   "RTN","SDM XSCHT",236 ,0)
  10570    Q
  10571   "RTN","SDM XSCHT",237 ,0)
  10572   OBXPID(SET ID,PID,SEG ) ;Builds  OBX segmen t for pati ent indica ted date
  10573   "RTN","SDM XSCHT",238 ,0)
  10574    ;     OBX -1 Set ID
  10575   "RTN","SDM XSCHT",239 ,0)
  10576    ;     OBX -3 "REQUES TED DATE"
  10577   "RTN","SDM XSCHT",240 ,0)
  10578    ;     OBX -5 Patient  Indicated  Date
  10579   "RTN","SDM XSCHT",241 ,0)
  10580    ;
  10581   "RTN","SDM XSCHT",242 ,0)
  10582    ;  SETID  (I,REQ) -  Set ID tha t's set in  OBX-1
  10583   "RTN","SDM XSCHT",243 ,0)
  10584    ;  PID (I ,REQ) - Pa tient indi cated date
  10585   "RTN","SDM XSCHT",244 ,0)
  10586    ;  SEG (O ,REQ) - HL O Segment
  10587   "RTN","SDM XSCHT",245 ,0)
  10588    ;
  10589   "RTN","SDM XSCHT",246 ,0)
  10590    K SEG S S EG=""
  10591   "RTN","SDM XSCHT",247 ,0)
  10592    D SET^HLO API(.SEG," OBX",0)  ; OBX
  10593   "RTN","SDM XSCHT",248 ,0)
  10594    D SET^HLO API(.SEG,S ETID,1)  ; OBX-1
  10595   "RTN","SDM XSCHT",249 ,0)
  10596    D SET^HLO API(.SEG," REQUESTED  DATE",3)   ;OBX-3
  10597   "RTN","SDM XSCHT",250 ,0)
  10598    D SETDT^H LOAPI4(.SE G,PID,5)   ;OBX-5
  10599   "RTN","SDM XSCHT",251 ,0)
  10600    Q
  10601   "RTN","SDM XTRCT")
  10602   0^41^B1936 5757
  10603   "RTN","SDM XTRCT",1,0 )
  10604   SDMXTRCT ; MASS/JEO,R PC - EXTRA CTS THE SC HEDULED AP POINTMENTS  FROM THE  PATIENT FI LE AND TRI GGERS SIU  messages;9 /15/2017
  10605   "RTN","SDM XTRCT",2,0 )
  10606    ;;5.3;Sch eduling;** 676**;9/15 /2017;Buil d 99
  10607   "RTN","SDM XTRCT",3,0 )
  10608    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  10609   "RTN","SDM XTRCT",4,0 )
  10610    ; This ut ility will  trigger f uture appo intments o ut the SD- SIU-OUT HL O SIU inte rface.
  10611   "RTN","SDM XTRCT",5,0 )
  10612    ; The fut ure appoin tments may  be extrac ted starte d from the  current,  or given f uture day.
  10613   "RTN","SDM XTRCT",6,0 )
  10614    Q
  10615   "RTN","SDM XTRCT",7,0 )
  10616    ;
  10617   "RTN","SDM XTRCT",8,0 )
  10618   FUTAP    ; EXTRACTS T HE FUTURE  APPOINTMEN TS FOR THE  ACTIVE CL INICS
  10619   "RTN","SDM XTRCT",9,0 )
  10620    ; DT - Cu rrent date  in VistA  format
  10621   "RTN","SDM XTRCT",10, 0)
  10622    ; Y  - Th e start da te in Vist A format
  10623   "RTN","SDM XTRCT",11, 0)
  10624    N Y,SDT,S DT1,CLINIC ,DFN,MASSA PT,ISMASS, CLCOUNT,SD ATA,U,DT,P ATCOUNT,TC OUNT,CLINA RY,FIRST,D IR,ACTION
  10625   "RTN","SDM XTRCT",12, 0)
  10626    S (Y,SDT, SDT1,CLINI C,DFN,MASS APT,ISMASS ,CLCOUNT,S DATA,U,DT, PATCOUNT,T COUNT,CLIN ARY,FIRST, DIR,ACTION )=""
  10627   "RTN","SDM XTRCT",13, 0)
  10628    W #
  10629   "RTN","SDM XTRCT",14, 0)
  10630    ; Get the  start dat e for the  conversion
  10631   "RTN","SDM XTRCT",15, 0)
  10632    S Y="",TC OUNT=0,U=" ^"
  10633   "RTN","SDM XTRCT",16, 0)
  10634    D DT^DICR W   ;Today
  10635   "RTN","SDM XTRCT",17, 0)
  10636    W !,"This  utility t riggers fu ture activ e appointm ents to th e",!
  10637   "RTN","SDM XTRCT",18, 0)
  10638    W "SD_SIU _OUT HL7 a ppointment  interface ",!!!
  10639   "RTN","SDM XTRCT",19, 0)
  10640    K DIR
  10641   "RTN","SDM XTRCT",20, 0)
  10642    S DIR(0)= "D^"_DT,DI R("A")="En ter a star t date"
  10643   "RTN","SDM XTRCT",21, 0)
  10644    D ^DIR
  10645   "RTN","SDM XTRCT",22, 0)
  10646    I Y="^" Q
  10647   "RTN","SDM XTRCT",23, 0)
  10648    S SDT=Y-. 1
  10649   "RTN","SDM XTRCT",24, 0)
  10650    ; Get Act ion
  10651   "RTN","SDM XTRCT",25, 0)
  10652    K DIR
  10653   "RTN","SDM XTRCT",26, 0)
  10654    S DIR(0)= "SB^1:SEND  ONLY APPO INTMENTS F OR CLINICS  WITH THE  MASS FLAG; 2:SEND ALL  APPOINTME NTS IN THE  SYSTEM;3: CHOOSE CLI NICS TO TR IGGER APPO INTMENT FO R"
  10655   "RTN","SDM XTRCT",27, 0)
  10656    S DIR("A" )="Select  a trigger  action: 1  - Send MAS S appts, 2  - Send al l appts ,  3 - select  individua l clinics"
  10657   "RTN","SDM XTRCT",28, 0)
  10658    D ^DIR
  10659   "RTN","SDM XTRCT",29, 0)
  10660    S ACTION= $G(Y)
  10661   "RTN","SDM XTRCT",30, 0)
  10662    I '$$INST RING^SDMXC ORE(ACTION ,"1,2,3"," ,") W !,"N O ACTION W ILL BE TAK EN" Q
  10663   "RTN","SDM XTRCT",31, 0)
  10664    ; SEND AL L
  10665   "RTN","SDM XTRCT",32, 0)
  10666    I ACTION= 1 D LOOP(. TCOUNT,SDT ,1)
  10667   "RTN","SDM XTRCT",33, 0)
  10668    I ACTION= 2 D LOOP(. TCOUNT,SDT )
  10669   "RTN","SDM XTRCT",34, 0)
  10670    I ACTION= 3 D MANUAL (.TCOUNT,S DT)
  10671   "RTN","SDM XTRCT",35, 0)
  10672    ;
  10673   "RTN","SDM XTRCT",36, 0)
  10674    ; Final o utput
  10675   "RTN","SDM XTRCT",37, 0)
  10676    W !,"TOTA L APPOINTM ENTS TRIGG ERED: "_TC OUNT
  10677   "RTN","SDM XTRCT",38, 0)
  10678    Q
  10679   "RTN","SDM XTRCT",39, 0)
  10680   MANUAL(TCO UNT,SDT) ;
  10681   "RTN","SDM XTRCT",40, 0)
  10682    N CLCOUNT ,FIRST,STO P,CLINIC,C LINARY,SDT 1,DFN,THRE ADS,LINK,C OUNT,DIC,Y
  10683   "RTN","SDM XTRCT",41, 0)
  10684    W !
  10685   "RTN","SDM XTRCT",42, 0)
  10686    S DIC="^S C(",DIC(0) ="AEMZQ",D IC("A")="S ELECT CLIN IC: ",DIC( "S")="I $P (^(0),U,3) =""C"",'$G (^(""OOS"" ))"
  10687   "RTN","SDM XTRCT",43, 0)
  10688    S CLCOUNT =0,STOP=0, FIRST=1,LI NK="SD SIU  OUT"
  10689   "RTN","SDM XTRCT",44, 0)
  10690    F  D  Q:S TOP
  10691   "RTN","SDM XTRCT",45, 0)
  10692    . D ^DIC
  10693   "RTN","SDM XTRCT",46, 0)
  10694    . I Y=-1  S STOP=1 Q
  10695   "RTN","SDM XTRCT",47, 0)
  10696    . S CLINI C=$P(Y,U,1 )
  10697   "RTN","SDM XTRCT",48, 0)
  10698    . I $G(CL INARY(CLIN IC))'="" Q
  10699   "RTN","SDM XTRCT",49, 0)
  10700    . S CLINA RY(CLINIC) =1
  10701   "RTN","SDM XTRCT",50, 0)
  10702    . S CLCOU NT=CLCOUNT +1
  10703   "RTN","SDM XTRCT",51, 0)
  10704    . I FIRST =1 S DIC(" A")="AND C LINIC: ",F IRST=""
  10705   "RTN","SDM XTRCT",52, 0)
  10706    ;
  10707   "RTN","SDM XTRCT",53, 0)
  10708    I CLCOUNT =0 Q
  10709   "RTN","SDM XTRCT",54, 0)
  10710    S THREADS =$$GET^XPA R("SYS","S DMX CONV T HREADS")
  10711   "RTN","SDM XTRCT",55, 0)
  10712    ; Process  the list
  10713   "RTN","SDM XTRCT",56, 0)
  10714    S CLINIC= ""
  10715   "RTN","SDM XTRCT",57, 0)
  10716    F  S CLIN IC=$O(CLIN ARY(CLINIC )) Q:CLINI C=""  D
  10717   "RTN","SDM XTRCT",58, 0)
  10718    . ;
  10719   "RTN","SDM XTRCT",59, 0)
  10720    . ; Loop  over all a ppointment  DATE/TIME  on this c linic.
  10721   "RTN","SDM XTRCT",60, 0)
  10722    . S SDT1= SDT
  10723   "RTN","SDM XTRCT",61, 0)
  10724    . F  S SD T1=$O(^SC( CLINIC,"S" ,SDT1)) Q: SDT1=""  D
  10725   "RTN","SDM XTRCT",62, 0)
  10726    . . ;
  10727   "RTN","SDM XTRCT",63, 0)
  10728    . . ; Loo p over all  appointme nts at thi s time
  10729   "RTN","SDM XTRCT",64, 0)
  10730    . . S CLC OUNT=0
  10731   "RTN","SDM XTRCT",65, 0)
  10732    . . F  S  CLCOUNT=$O (^SC(CLINI C,"S",SDT1 ,1,CLCOUNT )) Q:CLCOU NT=""  D
  10733   "RTN","SDM XTRCT",66, 0)
  10734    . . . ; s et app if  multi thre ading
  10735   "RTN","SDM XTRCT",67, 0)
  10736    . . . I $ G(THREADS)  D
  10737   "RTN","SDM XTRCT",68, 0)
  10738    . . . . S  COUNT=TCO UNT#THREAD S+1
  10739   "RTN","SDM XTRCT",69, 0)
  10740    . . . . S  LINK="SD  SIU O"_COU NT
  10741   "RTN","SDM XTRCT",70, 0)
  10742    . . . . ;
  10743   "RTN","SDM XTRCT",71, 0)
  10744    . . . ; G ET PATIENT  COUNTER
  10745   "RTN","SDM XTRCT",72, 0)
  10746    . . . S D FN=$P($G(^ SC(CLINIC, "S",SDT1,1 ,CLCOUNT,0 )),"^",1)
  10747   "RTN","SDM XTRCT",73, 0)
  10748    . . . I D FN="" Q
  10749   "RTN","SDM XTRCT",74, 0)
  10750    . . . ;
  10751   "RTN","SDM XTRCT",75, 0)
  10752    . . . ; T RIGGER APP OINTMENT
  10753   "RTN","SDM XTRCT",76, 0)
  10754    . . . S S DATA=CLCOU NT_U_DFN_U _SDT1_U_CL INIC
  10755   "RTN","SDM XTRCT",77, 0)
  10756    . . . D B UILDHLO^SD MXSCHT(SDA TA,"S12",L INK)
  10757   "RTN","SDM XTRCT",78, 0)
  10758    . . . S T COUNT=TCOU NT+1
  10759   "RTN","SDM XTRCT",79, 0)
  10760    Q
  10761   "RTN","SDM XTRCT",80, 0)
  10762    ;
  10763   "RTN","SDM XTRCT",81, 0)
  10764   LOOP(TCOUN T,SDT,MASS APT) ;All  appointmen t loop
  10765   "RTN","SDM XTRCT",82, 0)
  10766    N CLINIC, ISMASS,SDT 1,CLCOUNT, DFN,SDATA, THREADS,LI NK,COUNT
  10767   "RTN","SDM XTRCT",83, 0)
  10768    S CLINIC= "",LINK="S D SIU OUT"
  10769   "RTN","SDM XTRCT",84, 0)
  10770    S THREADS =$$GET^XPA R("SYS","S DMX CONV T HREADS")
  10771   "RTN","SDM XTRCT",85, 0)
  10772    ; Loop th rough all  clinics
  10773   "RTN","SDM XTRCT",86, 0)
  10774    F  S CLIN IC=$O(^SC( CLINIC)) Q :CLINIC=""   D
  10775   "RTN","SDM XTRCT",87, 0)
  10776    . ;
  10777   "RTN","SDM XTRCT",88, 0)
  10778    . ; Check  if Clinic  is for MA SS
  10779   "RTN","SDM XTRCT",89, 0)
  10780    . S ISMAS S=""
  10781   "RTN","SDM XTRCT",90, 0)
  10782    . I $G(MA SSAPT)=1 S  ISMASS=$$ ISMASS(CLI NIC)
  10783   "RTN","SDM XTRCT",91, 0)
  10784    . I ISMAS S=0 Q   ;S et to not  send CLINI Cs not sch eduled in  MASS
  10785   "RTN","SDM XTRCT",92, 0)
  10786    . ;
  10787   "RTN","SDM XTRCT",93, 0)
  10788    . ; Loop  over all a ppointment  DATE/TIME  on this c linic.
  10789   "RTN","SDM XTRCT",94, 0)
  10790    . S SDT1= SDT
  10791   "RTN","SDM XTRCT",95, 0)
  10792    . F  S SD T1=$O(^SC( CLINIC,"S" ,SDT1)) Q: SDT1=""  D
  10793   "RTN","SDM XTRCT",96, 0)
  10794    . . ;
  10795   "RTN","SDM XTRCT",97, 0)
  10796    . . ; Loo p over all  appointme nts at thi s time
  10797   "RTN","SDM XTRCT",98, 0)
  10798    . . S CLC OUNT=0
  10799   "RTN","SDM XTRCT",99, 0)
  10800    . . F  S  CLCOUNT=$O (^SC(CLINI C,"S",SDT1 ,1,CLCOUNT )) Q:CLCOU NT=""  D
  10801   "RTN","SDM XTRCT",100 ,0)
  10802    . . . ; s et app if  multi thre ading
  10803   "RTN","SDM XTRCT",101 ,0)
  10804    . . . I $ G(THREADS)  D
  10805   "RTN","SDM XTRCT",102 ,0)
  10806    . . . . S  COUNT=TCO UNT#THREAD S+1
  10807   "RTN","SDM XTRCT",103 ,0)
  10808    . . . . S  LINK="SD  SIU O"_COU NT
  10809   "RTN","SDM XTRCT",104 ,0)
  10810    . . . ;
  10811   "RTN","SDM XTRCT",105 ,0)
  10812    . . . ; G ET PATIENT  COUNTER
  10813   "RTN","SDM XTRCT",106 ,0)
  10814    . . . S D FN=$P($G(^ SC(CLINIC, "S",SDT1,1 ,CLCOUNT,0 )),"^",1)
  10815   "RTN","SDM XTRCT",107 ,0)
  10816    . . . I D FN="" Q
  10817   "RTN","SDM XTRCT",108 ,0)
  10818    . . . ;
  10819   "RTN","SDM XTRCT",109 ,0)
  10820    . . . ; T RIGGER APP OINTMENT
  10821   "RTN","SDM XTRCT",110 ,0)
  10822    . . . S S DATA=CLCOU NT_U_DFN_U _SDT1_U_CL INIC
  10823   "RTN","SDM XTRCT",111 ,0)
  10824    . . . D B UILDHLO^SD MXSCHT(SDA TA,"S12",L INK)
  10825   "RTN","SDM XTRCT",112 ,0)
  10826    . . . S T COUNT=TCOU NT+1
  10827   "RTN","SDM XTRCT",113 ,0)
  10828    Q
  10829   "RTN","SDM XTRCT",114 ,0)
  10830   ISMASS(CLI NIC) ;Get  MASS clini c flag
  10831   "RTN","SDM XTRCT",115 ,0)
  10832    N RET
  10833   "RTN","SDM XTRCT",116 ,0)
  10834    S RET=$$G ETFLAG^SDM XFLAG(CLIN IC)
  10835   "RTN","SDM XTRCT",117 ,0)
  10836    Q RET
  10837   "RTN","SDM XUCAN")
  10838   0^39^B6936 679
  10839   "RTN","SDM XUCAN",1,0 )
  10840   SDMXUCAN ; MASS/DAP -  Uncancel  appointmen t API;8/17 /17 ;2018- 05-07 16:3 6:18;8.3;9 XoaEg2tXfA eDOJi9HBPN rGuIhUN4g3 pXAVpbPWqt 1g=
  10841   "RTN","SDM XUCAN",2,0 )
  10842    ;;5.3;Sch eduling;** 676**;AUGU ST 22,2017 ;Build 99
  10843   "RTN","SDM XUCAN",3,0 )
  10844    ;;Per VA  directive  6402, this  routine s hould not  be modifie d.
  10845   "RTN","SDM XUCAN",4,0 )
  10846    ;    ICR#  Supported  Reference s
  10847   "RTN","SDM XUCAN",5,0 )
  10848    ;  10103   $$NOW^XLF DT
  10849   "RTN","SDM XUCAN",6,0 )
  10850    ;  2053   FILE^DIE
  10851   "RTN","SDM XUCAN",7,0 )
  10852    ;  10006   ^DIC
  10853   "RTN","SDM XUCAN",8,0 )
  10854    ;  10009   FILE^DICN
  10855   "RTN","SDM XUCAN",9,0 )
  10856    ;  10018   ^DIE
  10857   "RTN","SDM XUCAN",10, 0)
  10858    ;  10035   ^DPT
  10859   "RTN","SDM XUCAN",11, 0)
  10860    ;  10040   ^SC
  10861   "RTN","SDM XUCAN",12, 0)
  10862    ;  ###     ^OR
  10863   "RTN","SDM XUCAN",13, 0)
  10864    ;
  10865   "RTN","SDM XUCAN",14, 0)
  10866    Q
  10867   "RTN","SDM XUCAN",15, 0)
  10868   UNCANCEL(P ATIEN,CLIN IEN,APPTDT ,USER) ;EN TRY POINT  TO UNCANCE L A PREVOI USLY EXIST ING APPOIN TMENT
  10869   "RTN","SDM XUCAN",16, 0)
  10870    ;                WRA PPER FOR T HE FILING  TAG. DOES  LIGHT VALI DATION/GET TING
  10871   "RTN","SDM XUCAN",17, 0)
  10872    ; PASSED  IN PARAMET ERS
  10873   "RTN","SDM XUCAN",18, 0)
  10874    ;   REQUI RED FOR FU NCTIONALIT Y:
  10875   "RTN","SDM XUCAN",19, 0)
  10876    ;       P ATIEN (I,R EQ) - PATI ENT ID
  10877   "RTN","SDM XUCAN",20, 0)
  10878    ;       C LINIEN (I, REQ) - CLI NIC ID
  10879   "RTN","SDM XUCAN",21, 0)
  10880    ;       A PPTDT (I,R EQ) - APPO INTMENT DA TE+TIME
  10881   "RTN","SDM XUCAN",22, 0)
  10882    ;   REQUI RED BY WOR KFLOW:
  10883   "RTN","SDM XUCAN",23, 0)
  10884    ;       U SER (I,REQ ) - DATA E NTRY CLERK
  10885   "RTN","SDM XUCAN",24, 0)
  10886    ;
  10887   "RTN","SDM XUCAN",25, 0)
  10888    N MASSFDA ,MASSIENS, MASSMSG,OU TENC,SCEFD A,SCEIEN,A PPTIEN
  10889   "RTN","SDM XUCAN",26, 0)
  10890    S (MASSFD A,MASSIENS ,MASSMSG,O UTENC,SCEF DA,SCEIEN, APPTIEN)=" "
  10891   "RTN","SDM XUCAN",27, 0)
  10892    S PATIEN= $G(PATIEN) ,CLINIEN=$ G(CLINIEN) ,APPTDT=$G (APPTDT),U SER=$G(USE R)
  10893   "RTN","SDM XUCAN",28, 0)
  10894    I (PATIEN ="")!(CLIN IEN="")!(A PPTDT="")! (USER="")  Q "MISSING  REQUIRED  PARAMETERS "
  10895   "RTN","SDM XUCAN",29, 0)
  10896    I '$D(^DP T(PATIEN," S",APPTDT, 0)) Q "APP OINTMENT D OESN'T EXI ST"
  10897   "RTN","SDM XUCAN",30, 0)
  10898    ; FILE 2. 98
  10899   "RTN","SDM XUCAN",31, 0)
  10900    S MASSIEN S=APPTDT_" ,"_PATIEN_ ","    ;
  10901   "RTN","SDM XUCAN",32, 0)
  10902    S MASSFDA (2.98,MASS IENS,".01" )=CLINIEN  ;CLINIEN
  10903   "RTN","SDM XUCAN",33, 0)
  10904    S MASSFDA (2.98,MASS IENS,"3")= "@" ;STATU S
  10905   "RTN","SDM XUCAN",34, 0)
  10906    S MASSFDA (2.98,MASS IENS,"14") ="@" ;NO-S HOW/CANCEL LED BY
  10907   "RTN","SDM XUCAN",35, 0)
  10908    S MASSFDA (2.98,MASS IENS,"15") ="@" ;NO-S HOW/CANCEL  DATE/TIME
  10909   "RTN","SDM XUCAN",36, 0)
  10910    S MASSFDA (2.98,MASS IENS,"16") ="@" ;CANC ELLATION R EASON
  10911   "RTN","SDM XUCAN",37, 0)
  10912    S MASSFDA (2.98,MASS IENS,"17") ="@" ;CANC ELLATION R EMARKS
  10913   "RTN","SDM XUCAN",38, 0)
  10914    S MASSFDA (2.98,MASS IENS,"18") ="@" ;APPT . CANCELLE D
  10915   "RTN","SDM XUCAN",39, 0)
  10916    S MASSFDA (2.98,MASS IENS,"19") =USER ;DAT A ENTRY CL ERK
  10917   "RTN","SDM XUCAN",40, 0)
  10918    D FILE^DI E("","MASS FDA","MASS MSG")
  10919   "RTN","SDM XUCAN",41, 0)
  10920    ;
  10921   "RTN","SDM XUCAN",42, 0)
  10922    ; Remove  all check  in/out dat a in the " C" node
  10923   "RTN","SDM XUCAN",43, 0)
  10924    S APPTIEN =$$FIND^SD AM2(PATIEN ,APPTDT,CL INIEN)
  10925   "RTN","SDM XUCAN",44, 0)
  10926    i APPTIEN '="" d
  10927   "RTN","SDM XUCAN",45, 0)
  10928    . I $G(^S C(CLINIEN, "S",APPTDT ,1,APPTIEN ,"C"))=""  q
  10929   "RTN","SDM XUCAN",46, 0)
  10930    . K MASSI ENS,MASSFD A
  10931   "RTN","SDM XUCAN",47, 0)
  10932    . S MASSI ENS=APPTIE N_","_APPT DT_","_CLI NIEN_","
  10933   "RTN","SDM XUCAN",48, 0)
  10934    . S MASSF DA(44.003, MASSIENS,3 02)="@"
  10935   "RTN","SDM XUCAN",49, 0)
  10936    . S MASSF DA(44.003, MASSIENS,3 03)="@"
  10937   "RTN","SDM XUCAN",50, 0)
  10938    . S MASSF DA(44.003, MASSIENS,3 04)="@"
  10939   "RTN","SDM XUCAN",51, 0)
  10940    . S MASSF DA(44.003, MASSIENS,3 05)="@"
  10941   "RTN","SDM XUCAN",52, 0)
  10942    . S MASSF DA(44.003, MASSIENS,3 06)="@"
  10943   "RTN","SDM XUCAN",53, 0)
  10944    . S MASSF DA(44.003, MASSIENS,3 09)="@"
  10945   "RTN","SDM XUCAN",54, 0)
  10946    . D FILE^ DIE("","MA SSFDA","")
  10947   "RTN","SDM XUCAN",55, 0)
  10948    . ;Remove  the C nod e which no  longer ha s any data :
  10949   "RTN","SDM XUCAN",56, 0)
  10950    . K ^SC(C LINIEN,"S" ,APPTDT,1, APPTIEN,"C ")
  10951   "RTN","SDM XUCAN",57, 0)
  10952    ;
  10953   "RTN","SDM XUCAN",58, 0)
  10954    ;
  10955   "RTN","SDM XUCAN",59, 0)
  10956    S OUTENC= $P($G(^DPT (PATIEN,"S ",APPTDT,0 )),"^",20)
  10957   "RTN","SDM XUCAN",60, 0)
  10958    I (OUTENC '=""),$D(^ SCE(OUTENC )) D
  10959   "RTN","SDM XUCAN",61, 0)
  10960    . S SCEIE N=OUTENC_" ,"
  10961   "RTN","SDM XUCAN",62, 0)
  10962    . S SCEFD A(409.68,S CEIEN,".12 ")=14 ;Act ion Requir ed
  10963   "RTN","SDM XUCAN",63, 0)
  10964    . D FILE^ DIE("","SC EFDA","")
  10965   "RTN","SDM XUCAN",64, 0)
  10966    Q 1
  10967   "RTN","SDM XUCAN",65, 0)
  10968    ;
  10969   "RTN","SDM XUCAN",66, 0)
  10970    Q  ;;#eor #
  10971   "RTN","SDN EXT")
  10972   0^18^B2240 2085
  10973   "RTN","SDN EXT",1,0)
  10974   SDNEXT ;AL B/TMP - FI ND NEXT AV AILABLE AP POINTMENT  FOR A CLIN IC ; 18 AP R 86
  10975   "RTN","SDN EXT",2,0)
  10976    ;;5.3;Sch eduling;** 41,45,165, 549,676**; AUG 13, 19 93;Build 9 9
  10977   "RTN","SDN EXT",3,0)
  10978    ;
  10979   "RTN","SDN EXT",4,0)
  10980    S IOP=$S( $D(ION):IO N,1:"HOME" ) D ^%ZIS  K IOP
  10981   "RTN","SDN EXT",5,0)
  10982   1 S SDNEXT ="",SDCT=0  G RD^SDMU LT
  10983   "RTN","SDN EXT",6,0)
  10984   DT S FND=0 ,%DT(0)=-S DMAX,%DT=" AEF",%DT(" A")="  STA RT SEARCH  FOR NEXT A VAILABLE F ROM WHAT D ATE: " D ^ %DT K %DT  G:"^"[X 1: $S('$D(SDN EXT):1,'SD NEXT:1,1:0 ),END^SDMU LT0 G:Y<0  DT S SDSTR TDT=+Y
  10985   "RTN","SDN EXT",7,0)
  10986   LIM W !,"   ENTER LAT EST DATE T O CHECK FO R 1ST AVAI LABLE SLOT : " S Y=SD MAX D DT^D IQ R "// " ,X:DTIME G :X["^"!'($ T) END^SDM ULT0 I X'] "" G OVR^S DMULT0
  10987   "RTN","SDN EXT",8,0)
  10988    I X?.E1"? " W !,"  T he latest  date for f uture book ings for " ,$P(SDC(1) ,"^",2),"  is: " S Y= SDMAX D DT S^SDUTL W  Y,!,"  If  you enter  a date her e, it must  be less t han this d ate to fur ther limit  the",!,"   search" G  LIM
  10989   "RTN","SDN EXT",9,0)
  10990    S %DT="EF ",%DT(0)=- SDMAX D ^% DT K %DT G :Y<0!(Y<SD STRTDT) LI M S:Y>0 SD MAX=+Y
  10991   "RTN","SDN EXT",10,0)
  10992    G OVR^SDM ULT0
  10993   "RTN","SDN EXT",11,0)
  10994    ;
  10995   "RTN","SDN EXT",12,0)
  10996   NEW ;entry  point to  be use for  next avai lable appt . 3/29/96
  10997   "RTN","SDN EXT",13,0)
  10998    K VAUTT,V AUTC,SCUP
  10999   "RTN","SDN EXT",14,0)
  11000    N SCOKNUL L
  11001   "RTN","SDN EXT",15,0)
  11002    S SCOKNUL L=1
  11003   "RTN","SDN EXT",16,0)
  11004    S IOP=$S( $D(ION):IO N,1:"HOME" ) D ^%ZIS  K IOP
  11005   "RTN","SDN EXT",17,0)
  11006    S SDNEXT= "",SDCT=0
  11007   "RTN","SDN EXT",18,0)
  11008    S VAUTNA= "" ;don't  allow all  to be sele cted
  11009   "RTN","SDN EXT",19,0)
  11010    S VAUTCA= "" ;allow  any clinic  to be sel ected
  11011   "RTN","SDN EXT",20,0)
  11012    S VAUTD=1  ;all divi sions
  11013   "RTN","SDN EXT",21,0)
  11014    D CLINIC^ SDNEXT1 ;p rompt for  clinics (n one,one,ma ny)   ; SD *5.3*676
  11015   "RTN","SDN EXT",22,0)
  11016    ;;D CLINI C^SCRPU1 ; prompt for  clinics ( none,one,m any)
  11017   "RTN","SDN EXT",23,0)
  11018    Q:$D(SCUP )  ; "^" S ELECTED
  11019   "RTN","SDN EXT",24,0)
  11020    D PRMTT^S CRPU1 ;pro mpt for te am (none,o ne,many)
  11021   "RTN","SDN EXT",25,0)
  11022    Q:('$D(VA UTT))&('$D (VAUTC))
  11023   "RTN","SDN EXT",26,0)
  11024    Q:$D(SCUP )  ; "^" S ELECTED
  11025   "RTN","SDN EXT",27,0)
  11026    S APPTL=$ $LENGTH()
  11027   "RTN","SDN EXT",28,0)
  11028    Q:APPTL<0
  11029   "RTN","SDN EXT",29,0)
  11030    S FIRST=" First date  to check  for 1st av ailable ap pointments : "
  11031   "RTN","SDN EXT",30,0)
  11032    S SECOND= "Latest da te to chec k for avai lable appo intments:  "
  11033   "RTN","SDN EXT",31,0)
  11034    S RANG=$$ DTRANG^SCR PU2(FIRST, SECOND)
  11035   "RTN","SDN EXT",32,0)
  11036    I RANG=-1  D CLEAN,E XIT Q
  11037   "RTN","SDN EXT",33,0)
  11038    I $D(VAUT T) D GETCL N(.VAUTT,. VAUTC)
  11039   "RTN","SDN EXT",34,0)
  11040    ;all clin ics select ed & posit ion assoc  clinics in  VAUTC(ien )=clinic n ame
  11041   "RTN","SDN EXT",35,0)
  11042    D DRIVE(. VAUTC,APPT L,RANG)
  11043   "RTN","SDN EXT",36,0)
  11044    D CLEAN,E XIT
  11045   "RTN","SDN EXT",37,0)
  11046    Q
  11047   "RTN","SDN EXT",38,0)
  11048   EXIT ;
  11049   "RTN","SDN EXT",39,0)
  11050    K VAUTD,V AUTNA,VAUT T,VAUTC,FI RST,SECOND ,RANG,APPT L,SCPCMM,S DNEXT,SDCT
  11051   "RTN","SDN EXT",40,0)
  11052    K VAUTCA, SCUP
  11053   "RTN","SDN EXT",41,0)
  11054    Q
  11055   "RTN","SDN EXT",42,0)
  11056    ;
  11057   "RTN","SDN EXT",43,0)
  11058   LENGTH() ;
  11059   "RTN","SDN EXT",44,0)
  11060    ;prompt f or appoint ment lengt h
  11061   "RTN","SDN EXT",45,0)
  11062    N LEN
  11063   "RTN","SDN EXT",46,0)
  11064   ST S DIR(0 )="N"
  11065   "RTN","SDN EXT",47,0)
  11066    S DIR("A" )="Appoint ment Lengt h Needed "
  11067   "RTN","SDN EXT",48,0)
  11068    D ^DIR
  11069   "RTN","SDN EXT",49,0)
  11070    I Y=""!(X ="^")!(X=" ") S LEN=- 1 G EX
  11071   "RTN","SDN EXT",50,0)
  11072    S LEN=X
  11073   "RTN","SDN EXT",51,0)
  11074   EX K DIR,Y ,X
  11075   "RTN","SDN EXT",52,0)
  11076    Q LEN
  11077   "RTN","SDN EXT",53,0)
  11078    ;
  11079   "RTN","SDN EXT",54,0)
  11080   GETCLN(TEA M,CLINIC)  ;add assoc . clinics  for teams  to clinic  array
  11081   "RTN","SDN EXT",55,0)
  11082    ;TEAM - t eam array
  11083   "RTN","SDN EXT",56,0)
  11084    ;CLINIC -  clinic ar ray
  11085   "RTN","SDN EXT",57,0)
  11086    ;
  11087   "RTN","SDN EXT",58,0)
  11088    N TM,LIST ,ERR,OKAY
  11089   "RTN","SDN EXT",59,0)
  11090    S TM=0,LI ST="TPLIST ",ERR="ERR 1"
  11091   "RTN","SDN EXT",60,0)
  11092    F  S TM=$ O(TEAM(TM) ) Q:TM=""! (TM'?.N)   D
  11093   "RTN","SDN EXT",61,0)
  11094    .K @LIST, @ERR
  11095   "RTN","SDN EXT",62,0)
  11096    .S OKAY=$ $TPTM^SCAP MC24(TM,"" ,"","",LIS T,ERR)
  11097   "RTN","SDN EXT",63,0)
  11098    .;@LIST c ontains al l position s for team  TM
  11099   "RTN","SDN EXT",64,0)
  11100    .I $G(@LI ST@(0))>0  D ADDCL(.C LINIC,LIST )
  11101   "RTN","SDN EXT",65,0)
  11102    Q
  11103   "RTN","SDN EXT",66,0)
  11104    ;
  11105   "RTN","SDN EXT",67,0)
  11106   ADDCL(CLIN IC,PTLIST)  ;add team 's associa ted clinic s to clini c list
  11107   "RTN","SDN EXT",68,0)
  11108    ;CLINIC -  array of  selected c linics
  11109   "RTN","SDN EXT",69,0)
  11110    ;PTLIST -  array of  all positi ons for a  selected t eam
  11111   "RTN","SDN EXT",70,0)
  11112    N CNAME,C IEN,TPNODE ,TPIEN,NOD E,EN
  11113   "RTN","SDN EXT",71,0)
  11114    S EN=0
  11115   "RTN","SDN EXT",72,0)
  11116    F  S EN=$ O(@PTLIST@ (EN)) Q:EN =""!(EN'?. N)  D
  11117   "RTN","SDN EXT",73,0)
  11118    .S NODE=$ G(@PTLIST@ (EN))
  11119   "RTN","SDN EXT",74,0)
  11120    .S TPIEN= +$P(NODE," ^") ;team  position i en
  11121   "RTN","SDN EXT",75,0)
  11122    .S TPNODE =$G(^SCTM( 404.57,TPI EN,0))
  11123   "RTN","SDN EXT",76,0)
  11124    .Q:TPNODE =""
  11125   "RTN","SDN EXT",77,0)
  11126    .Q:'$D(^S CTM(404.57 ,TPIEN,5,0 ))  ;no as sociated c linics
  11127   "RTN","SDN EXT",78,0)
  11128    .S SDA=0   ;SD/549 c hange logi c to pull  from new m ultiple fi eld
  11129   "RTN","SDN EXT",79,0)
  11130    .F  S SDA =$O(^SCTM( 404.57,TPI EN,5,SDA))  Q:'SDA  D
  11131   "RTN","SDN EXT",80,0)
  11132    ..Q:'$D(^ SCTM(404.5 7,TPIEN,5, SDA,0))
  11133   "RTN","SDN EXT",81,0)
  11134    ..S CIEN= +$G(^SCTM( 404.57,TPI EN,5,SDA,0 ))
  11135   "RTN","SDN EXT",82,0)
  11136    ..Q:CIEN= 0  ;no ass ociated cl inic
  11137   "RTN","SDN EXT",83,0)
  11138    ..S CNAME =$P($G(^SC (CIEN,0)), "^")  ;cli nic name
  11139   "RTN","SDN EXT",84,0)
  11140    ..S CLINI C(CIEN)=CN AME
  11141   "RTN","SDN EXT",85,0)
  11142    K SDA
  11143   "RTN","SDN EXT",86,0)
  11144    Q
  11145   "RTN","SDN EXT",87,0)
  11146    ;
  11147   "RTN","SDN EXT",88,0)
  11148   DRIVE(CLIN ICA,LEN,BE GEND) ;dri ver
  11149   "RTN","SDN EXT",89,0)
  11150    ;CLINICA  - clinic a rray
  11151   "RTN","SDN EXT",90,0)
  11152    ;LEN - ap pt. length  wanted
  11153   "RTN","SDN EXT",91,0)
  11154    ;BEGEND -  begin dat e ^ end da te
  11155   "RTN","SDN EXT",92,0)
  11156    ;
  11157   "RTN","SDN EXT",93,0)
  11158    N CIEN,CO UNT,CONT,F ND
  11159   "RTN","SDN EXT",94,0)
  11160    S SDNEXT= "",SDCT=1
  11161   "RTN","SDN EXT",95,0)
  11162    S CIEN=0, STOP=0,COU NT=1
  11163   "RTN","SDN EXT",96,0)
  11164    F  S CIEN =$O(CLINIC A(CIEN)) Q :CIEN=""!( CIEN'?.N)! (STOP)  D
  11165   "RTN","SDN EXT",97,0)
  11166    .S SDNEXT =""
  11167   "RTN","SDN EXT",98,0)
  11168    .S SDSTRT DT=$P(BEGE ND,"^")
  11169   "RTN","SDN EXT",99,0)
  11170    .S SDMAX= $P(BEGEND, "^",2)
  11171   "RTN","SDN EXT",100,0 )
  11172    .S SDC(CO UNT)=CIEN, SDC1(CIEN) =$G(CLINIC A(CIEN))_" ^"_LEN
  11173   "RTN","SDN EXT",101,0 )
  11174    .S SDCT=C OUNT,SC=CI EN,FND=0
  11175   "RTN","SDN EXT",102,0 )
  11176    .D OVR^SD MULT0 S CO NT=$$CONMA (CIEN,$S($ O(CLINICA( CIEN)):0,1 :1))
  11177   "RTN","SDN EXT",103,0 )
  11178    .K SDC(CO UNT),SDC1( CIEN)
  11179   "RTN","SDN EXT",104,0 )
  11180    .;S CONT= $$CONMA(CI EN)
  11181   "RTN","SDN EXT",105,0 )
  11182    .Q:STOP
  11183   "RTN","SDN EXT",106,0 )
  11184    I $G(CONT )="M" D CL EAN S:$$ON E(.CLINICA ) SDCLN=$O (CLINICA(0 )) G ^SDM
  11185   "RTN","SDN EXT",107,0 )
  11186    Q
  11187   "RTN","SDN EXT",108,0 )
  11188   CLEAN ;
  11189   "RTN","SDN EXT",109,0 )
  11190    D END^SDM ULT0
  11191   "RTN","SDN EXT",110,0 )
  11192    K SDSTRTD T,SDNEXT,S DMAX,SDC,S DCT,SDC1,S DL,STOP,SD APP,SDPCMM ,SDCLN,FND
  11193   "RTN","SDN EXT",111,0 )
  11194    K SCPCC,S DPCM1,SC
  11195   "RTN","SDN EXT",112,0 )
  11196    Q
  11197   "RTN","SDN EXT",113,0 )
  11198    ;
  11199   "RTN","SDN EXT",114,0 )
  11200   ONE(CLNA)  ;one clini c selected ? 1 or 0
  11201   "RTN","SDN EXT",115,0 )
  11202    N CNT,FIR ST,RET,STP
  11203   "RTN","SDN EXT",116,0 )
  11204    S (CNT,ST P)=0,RET=1
  11205   "RTN","SDN EXT",117,0 )
  11206    F  S CNT= $O(CLNA(CN T)) Q:CNT= ""!(STP)   D
  11207   "RTN","SDN EXT",118,0 )
  11208    .I $D(FIR ST) S STOP =1,RET=0
  11209   "RTN","SDN EXT",119,0 )
  11210    .I '$D(FI RST) S FIR ST=1
  11211   "RTN","SDN EXT",120,0 )
  11212    Q RET
  11213   "RTN","SDN EXT",121,0 )
  11214    ;
  11215   "RTN","SDN EXT",122,0 )
  11216   CONMA(CIEN ,CONT) ;co ntinue to  view, exit  or make a ppointment
  11217   "RTN","SDN EXT",123,0 )
  11218    ;
  11219   "RTN","SDN EXT",124,0 )
  11220   PRT ;
  11221   "RTN","SDN EXT",125,0 )
  11222    S CONT=$G (CONT)
  11223   "RTN","SDN EXT",126,0 )
  11224    I $G(SDPC MM(CIEN))' >0&('CONT)  Q -1
  11225   "RTN","SDN EXT",127,0 )
  11226    W !,"'^'  TO EXIT"_$ S('CONT:",  'C' TO CO NTINUE",1: "")_" OR ' M' TO GOTO  MAKE APPO INTMENT: " _$S(CONT:" ^",1:"CONT INUE")_"// " R X:DTIM E
  11227   "RTN","SDN EXT",128,0 )
  11228    I '$T!(X= "^") S STO P=1,X=-1 G  EX2
  11229   "RTN","SDN EXT",129,0 )
  11230    I (X'="^" )&(X'="C") &(X'="M")& (X'="") G  PRT
  11231   "RTN","SDN EXT",130,0 )
  11232    I CONT&(X ="C") G PR T
  11233   "RTN","SDN EXT",131,0 )
  11234    I X="M" S  STOP=1
  11235   "RTN","SDN EXT",132,0 )
  11236    I X="" S  X="C"
  11237   "RTN","SDN EXT",133,0 )
  11238   EX2 Q X
  11239   "RTN","SDN EXT1")
  11240   0^19^B2589 4699
  11241   "RTN","SDN EXT1",1,0)
  11242   SDNEXT1 ;A LB/JEO - C LINIC PROM PTS FOR Ne xt Availab le Appoint ment ;11/1 4/17
  11243   "RTN","SDN EXT1",2,0)
  11244    ;;5.3;Sch eduling;** 676**;NOV  14, 2017;B uild 99
  11245   "RTN","SDN EXT1",3,0)
  11246    ;;VA DIRE CTIVE 6402 , this rou tine shoul d not be m odified.
  11247   "RTN","SDN EXT1",4,0)
  11248    ;; Copied  from SCRP U1
  11249   "RTN","SDN EXT1",5,0)
  11250    ;
  11251   "RTN","SDN EXT1",6,0)
  11252   INST ;Prom pt for VAU TCinstitut ion
  11253   "RTN","SDN EXT1",7,0)
  11254    S VAUTVB= "VAUTD",DI C="^DIC(4, ",DIC("S") ="I $D(^SC TM(404.51, ""AINST"", +Y))"
  11255   "RTN","SDN EXT1",8,0)
  11256    S VAUTNI= 2,VAUTSTR= "Division"
  11257   "RTN","SDN EXT1",9,0)
  11258    G FIRST^V AUTOMA
  11259   "RTN","SDN EXT1",10,0 )
  11260    ;
  11261   "RTN","SDN EXT1",11,0 )
  11262   PRMTT ;Pro mpt for te am.  Set V AUTTN to a llow not a ssigned to  a team as  a selecti on
  11263   "RTN","SDN EXT1",12,0 )
  11264    I '$D(VAU TD) G ERR
  11265   "RTN","SDN EXT1",13,0 )
  11266    S VAUTVB= "VAUTT",DI C="^SCTM(4 04.51,",VA UTNI=2,VAU TSTR="Team ",DIC("B") =""
  11267   "RTN","SDN EXT1",14,0 )
  11268    S DIC("S" )="I VAUTD =1!($D(VAU TD(+$P(^(0 ),U,7))))"
  11269   "RTN","SDN EXT1",15,0 )
  11270    G FIRST
  11271   "RTN","SDN EXT1",16,0 )
  11272    ;
  11273   "RTN","SDN EXT1",17,0 )
  11274   CLINIC ;Pr ompt for C linic
  11275   "RTN","SDN EXT1",18,0 )
  11276    I '$D(VAU TT)&'$D(VA UTCA) G ER R
  11277   "RTN","SDN EXT1",19,0 )
  11278    S VAUTVB= "VAUTC",VA UTSTR="Cli nic",VAUTN I=2,DIC="^ SC("
  11279   "RTN","SDN EXT1",20,0 )
  11280    ;Set scre en to only  allow cli nics and c linics tha t are asso ciated to  the teams  selected
  11281   "RTN","SDN EXT1",21,0 )
  11282    I '$D(VAU TCA) S DIC ("S")="I $ $CLSC^SDNE XT1()"
  11283   "RTN","SDN EXT1",22,0 )
  11284    ;VAUTCA a llows for  selection  of any cli nic in the  selected
  11285   "RTN","SDN EXT1",23,0 )
  11286    I $D(VAUT CA) S DIC( "S")="I $$ CLSC2^SDNE XT1()"
  11287   "RTN","SDN EXT1",24,0 )
  11288    G FIRST
  11289   "RTN","SDN EXT1",25,0 )
  11290    ;
  11291   "RTN","SDN EXT1",26,0 )
  11292   USER ;Prom pt for Use r Class
  11293   "RTN","SDN EXT1",27,0 )
  11294    I '$D(VAU TT) G ERR
  11295   "RTN","SDN EXT1",28,0 )
  11296    I $P($G(^ SD(404.91, 1,"PCMM")) ,"^")'=1 Q   ;user cl ass turned  off
  11297   "RTN","SDN EXT1",29,0 )
  11298    S VAUTVB= "VAUTUC",D IC="^USR(8 930,",VAUT STR="User  Class",VAU TNI=2
  11299   "RTN","SDN EXT1",30,0 )
  11300    S DIC("S" )="I $$USR CL^SDNEXT1 "
  11301   "RTN","SDN EXT1",31,0 )
  11302    G FIRST
  11303   "RTN","SDN EXT1",32,0 )
  11304    ;
  11305   "RTN","SDN EXT1",33,0 )
  11306   USRCL() ;S creen for  user class  - must be  related t o teams se lected
  11307   "RTN","SDN EXT1",34,0 )
  11308    N STOP,EN T,NODE,TIE N
  11309   "RTN","SDN EXT1",35,0 )
  11310    ;I '+$P(^ (0),U,3) Q  0
  11311   "RTN","SDN EXT1",36,0 )
  11312    ;check fo r active/e xiting use r class
  11313   "RTN","SDN EXT1",37,0 )
  11314    S ENT=0,S TOP=0
  11315   "RTN","SDN EXT1",38,0 )
  11316    F  S ENT= $O(^SCTM(4 04.57,"AUS R",+Y,ENT) ) Q:ENT="" !(STOP)  D
  11317   "RTN","SDN EXT1",39,0 )
  11318    .S NODE=$ G(^SCTM(40 4.57,ENT,0 ))
  11319   "RTN","SDN EXT1",40,0 )
  11320    .I NODE=" " S STOP=0  Q
  11321   "RTN","SDN EXT1",41,0 )
  11322    .S TIEN=+ $P(NODE,"^ ",2) ;team  ien
  11323   "RTN","SDN EXT1",42,0 )
  11324    .I $D(VAU TT(TIEN))! (VAUTT=1)  S STOP=1 Q
  11325   "RTN","SDN EXT1",43,0 )
  11326    .I VAUTT= ""&(TIEN=" ") S STOP= 1 Q  ;no t eam select ed, no tea m assigned
  11327   "RTN","SDN EXT1",44,0 )
  11328    .I VAUTT' =1&('$D(VA UTT(TIEN)) ) S STOP=0
  11329   "RTN","SDN EXT1",45,0 )
  11330    Q STOP
  11331   "RTN","SDN EXT1",46,0 )
  11332    ;
  11333   "RTN","SDN EXT1",47,0 )
  11334   ROLE ;Prom pt for Rol e
  11335   "RTN","SDN EXT1",48,0 )
  11336    I '$D(VAU TT) G ERR
  11337   "RTN","SDN EXT1",49,0 )
  11338    S VAUTVB= "VAUTR",DI C="^SD(403 .46,",VAUT STR="Role" ,VAUTNI=2
  11339   "RTN","SDN EXT1",50,0 )
  11340    S DIC("S" )="I $$RL^ SCRPU1()"
  11341   "RTN","SDN EXT1",51,0 )
  11342    G FIRST
  11343   "RTN","SDN EXT1",52,0 )
  11344    ;
  11345   "RTN","SDN EXT1",53,0 )
  11346   RL() ;Scre en for Rol e - screen  on team
  11347   "RTN","SDN EXT1",54,0 )
  11348    N EN,STOP ,ACT,TEAM
  11349   "RTN","SDN EXT1",55,0 )
  11350    S EN="",S TOP=0
  11351   "RTN","SDN EXT1",56,0 )
  11352    I $D(^SCT M(404.57," AC",+Y)) D
  11353   "RTN","SDN EXT1",57,0 )
  11354    .F  S EN= $O(^SCTM(4 04.57,"AC" ,+Y,EN)) Q :EN=""!(ST OP)  D
  11355   "RTN","SDN EXT1",58,0 )
  11356    ..S ACT=+ $$ACTTP^SC MCTPU(EN)  ;currently  active?
  11357   "RTN","SDN EXT1",59,0 )
  11358    ..I 'ACT! ('$D(^SCTM (404.57,EN ,0))) Q
  11359   "RTN","SDN EXT1",60,0 )
  11360    ..S TEAM= $P(^SCTM(4 04.57,EN,0 ),"^",2)
  11361   "RTN","SDN EXT1",61,0 )
  11362    ..I $D(VA UTT(TEAM)) !(VAUTT=1)  S STOP=1
  11363   "RTN","SDN EXT1",62,0 )
  11364    ..I VAUTT =""&(TEAM= "") S STOP =1
  11365   "RTN","SDN EXT1",63,0 )
  11366    Q STOP
  11367   "RTN","SDN EXT1",64,0 )
  11368    ;
  11369   "RTN","SDN EXT1",65,0 )
  11370   PRACT ; Pr ompt for O ne (set VA UTPO) or O ne,Many,Al l,None Pra ctitioner( s)
  11371   "RTN","SDN EXT1",66,0 )
  11372    I '$D(VAU TT) G ERR
  11373   "RTN","SDN EXT1",67,0 )
  11374    S VAUTVB= "VAUTP",VA UTSTR="Pra ctitioner" ,VAUTNI=2, DIC="^VA(2 00,"
  11375   "RTN","SDN EXT1",68,0 )
  11376    S DIC("S" )="I $$PRA CS^SCRPU1( )"
  11377   "RTN","SDN EXT1",69,0 )
  11378    G FIRST
  11379   "RTN","SDN EXT1",70,0 )
  11380    ;
  11381   "RTN","SDN EXT1",71,0 )
  11382   PRACS() ;P ractitione r screen -  off of te am selecti on
  11383   "RTN","SDN EXT1",72,0 )
  11384    N EN,STOP ,NODE,TEAM
  11385   "RTN","SDN EXT1",73,0 )
  11386    S EN="",S TOP=0
  11387   "RTN","SDN EXT1",74,0 )
  11388    I '$D(^SC TM(404.52, "C",+Y)) Q  0
  11389   "RTN","SDN EXT1",75,0 )
  11390    ;Position  Assignmen t History  file
  11391   "RTN","SDN EXT1",76,0 )
  11392    F  S EN=$ O(^SCTM(40 4.52,"C",+ Y,EN)) Q:E N=""!(STOP )  D
  11393   "RTN","SDN EXT1",77,0 )
  11394    .I '$D(^S CTM(404.52 ,EN)) Q
  11395   "RTN","SDN EXT1",78,0 )
  11396    .S NODE=$ G(^SCTM(40 4.52,EN,0) )
  11397   "RTN","SDN EXT1",79,0 )
  11398    .S TEAM=+ $P($G(^SCT M(404.57,$ P(NODE,"^" ),0)),"^", 2)
  11399   "RTN","SDN EXT1",80,0 )
  11400    .I $P(NOD E,"^",4),$ D(VAUTT(TE AM)) S STO P=1
  11401   "RTN","SDN EXT1",81,0 )
  11402    .I VAUTT= 1 S STOP=1
  11403   "RTN","SDN EXT1",82,0 )
  11404    Q STOP
  11405   "RTN","SDN EXT1",83,0 )
  11406    ;
  11407   "RTN","SDN EXT1",84,0 )
  11408   FIRST ;
  11409   "RTN","SDN EXT1",85,0 )
  11410    S DIC(0)= "EQMNZ",DI C("A")="Se lect "_VAU TSTR_": "  K @VAUTVB
  11411   "RTN","SDN EXT1",86,0 )
  11412    S (@VAUTV B,Y)=0
  11413   "RTN","SDN EXT1",87,0 )
  11414   REDO W !,D IC("A") R  X:DTIME G  ERR:(X="^" )!'$T D:X[ "?"!(X=""& ('$G(SCOKN ULL))) HEL P^SCRPU3
  11415   "RTN","SDN EXT1",88,0 )
  11416    G:$G(SCOK NULL)&(X=" ") QUIT
  11417   "RTN","SDN EXT1",89,0 )
  11418    I X="A"!( X="ALL")&' $D(VAUTNA)  S @VAUTVB =1 G QUIT
  11419   "RTN","SDN EXT1",90,0 )
  11420    ;VAUTNA d oesn't all ow all to  be selecte d
  11421   "RTN","SDN EXT1",91,0 )
  11422    ;VAUTTN a llows 'Not  assigned  to a team'  as a sele ction
  11423   "RTN","SDN EXT1",92,0 )
  11424    I X="N"!( X="NOT")!( X="NONE")  I $D(VAUTT N)!($D(VAU TPP)) S @V AUTVB="" G  QUIT
  11425   "RTN","SDN EXT1",93,0 )
  11426    ;VAUTPP a llows 'Not  assigned  to a pract itioner' a s a select ion
  11427   "RTN","SDN EXT1",94,0 )
  11428    S DIC("A" )="Select  another "_ VAUTSTR_":  " D ^DIC  G:Y'>0 FIR ST D SET
  11429   "RTN","SDN EXT1",95,0 )
  11430    I '$D(VAU TPO) F VAI =1:0:19 W  !,DIC("A")  R X:DTIME  G ERR:(X= "")!(X="^" )!'$T K Y  D HELP^SCR PU3:X["?"  S:$E(X)="- " VAUTX=X, X=$E(VAUTX ,2,999) D  ^DIC I Y>0  D SET G:V AX REDO S: 'VAERR VAI =VAI+1
  11431   "RTN","SDN EXT1",96,0 )
  11432    ;VAUTPO -  only one  practition er allowed  to be sel ected
  11433   "RTN","SDN EXT1",97,0 )
  11434    G QUIT
  11435   "RTN","SDN EXT1",98,0 )
  11436   SET S VAX= 0 I $D(VAU TX) S J=$S (VAUTNI=2: +Y,1:$P(Y( 0),"^")) K  VAUTX S V AERR=$S($D (@VAUTVB@( J)):0,1:1)  W $S('VAE RR:"...rem oved from  list...",1 :"...not o n list...c an't remov e") Q:VAER R  S VAI=V AI-1 K @VA UTVB@(J) S :$O(@VAUTV B@(0))']""  VAX=1 Q
  11437   "RTN","SDN EXT1",99,0 )
  11438    S VAERR=0  I $S($D(@ VAUTVB@($P (Y(0),U))) :1,$D(@VAU TVB@(+Y)): 1,1:0) W ! ?3,*7,"You  have alre ady select ed that ", VAUTSTR,".   Try agai n." S VAER R=1
  11439   "RTN","SDN EXT1",100, 0)
  11440    Q:$$MSG^S DMXFLAG(+Y )
  11441   "RTN","SDN EXT1",101, 0)
  11442    S @VAUTVB @(+Y)=$P(Y (0),U)
  11443   "RTN","SDN EXT1",102, 0)
  11444    Q
  11445   "RTN","SDN EXT1",103, 0)
  11446    ;
  11447   "RTN","SDN EXT1",104, 0)
  11448   ERR S Y=-1  I $O(@VAU TVB@(0))=" " K @VAUTV B I X="^"  S SCUP=""
  11449   "RTN","SDN EXT1",105, 0)
  11450   QUIT S:'$D (Y) Y=1
  11451   "RTN","SDN EXT1",106, 0)
  11452    I $D(@VAU TVB),VAUTS TR="Team", @VAUTVB=1  D:'$G(DGQU IET) EN^DD IOL("All T eams selec ted, this  report may  take some  time...", "","!,?10" )
  11453   "RTN","SDN EXT1",107, 0)
  11454    K DIC,J,V AERR,VAI,V AJ,VAJ1,VA X,VAUTNI,V AUTSTR,VAU TVB,X
  11455   "RTN","SDN EXT1",108, 0)
  11456    Q
  11457   "RTN","SDN EXT1",109, 0)
  11458    ;
  11459   "RTN","SDN EXT1",110, 0)
  11460   CLSC() ;sc reen on cl inic selec tion, must  be relate d to team  prompt
  11461   "RTN","SDN EXT1",111, 0)
  11462    I $P(^SC( Y,0),U,3)' ="C" Q 0
  11463   "RTN","SDN EXT1",112, 0)
  11464    N TRUE,EN ,TEAM
  11465   "RTN","SDN EXT1",113, 0)
  11466    S TRUE=0, EN=""
  11467   "RTN","SDN EXT1",114, 0)
  11468    F  S EN=$ O(^SCTM(40 4.57,"E",+ Y,EN)) Q:E N=""!(TRUE )  D
  11469   "RTN","SDN EXT1",115, 0)
  11470    .S TEAM=+ $P($G(^SCT M(404.57,E N,0)),"^", 2)
  11471   "RTN","SDN EXT1",116, 0)
  11472    .I $D(VAU TT(TEAM))! (VAUTT=1)  S TRUE=1
  11473   "RTN","SDN EXT1",117, 0)
  11474    I VAUTT=" " S TRUE=1
  11475   "RTN","SDN EXT1",118, 0)
  11476    Q TRUE
  11477   "RTN","SDN EXT1",119, 0)
  11478    ;
  11479   "RTN","SDN EXT1",120, 0)
  11480   CLSC2() ;s creen on c linic sele ction, mus t be a cli nic
  11481   "RTN","SDN EXT1",121, 0)
  11482    I $P(^SC( Y,0),U,3)' ="C" Q 0
  11483   "RTN","SDN EXT1",122, 0)
  11484    Q 1
  11485   "RTN","SDN EXT1",123, 0)
  11486    ;
  11487   "RTN","SDN EXT1",124, 0)
  11488   CLSC2OLD()  ;screen o n clinic s election,  must be re lated to d ivision pr ompt
  11489   "RTN","SDN EXT1",125, 0)
  11490    I $P(^SC( Y,0),U,3)' ="C" Q 0
  11491   "RTN","SDN EXT1",126, 0)
  11492    N TRUE,EN ,INST,TDIV
  11493   "RTN","SDN EXT1",127, 0)
  11494    S TRUE=0, EN=""
  11495   "RTN","SDN EXT1",128, 0)
  11496    S TDIV=+$ P(^SC(Y,0) ,U,15) ;cl inic's div ision.
  11497   "RTN","SDN EXT1",129, 0)
  11498    Q:TDIV=0  0
  11499   "RTN","SDN EXT1",130, 0)
  11500    S INST=+$ P(^DG(40.8 ,TDIV,0),U ,7)
  11501   "RTN","SDN EXT1",131, 0)
  11502    I '$D(VAU TD(INST))& (VAUTD'="" ) S TRUE=0
  11503   "RTN","SDN EXT1",132, 0)
  11504    I $D(VAUT D(INST)) S  TRUE=1
  11505   "RTN","SDN EXT1",133, 0)
  11506    I VAUTD=1  S TRUE=1
  11507   "RTN","SDN EXT1",134, 0)
  11508    Q TRUE
  11509   "VER")
  11510   8.0^22.2
  11511   "^DD",44,4 4,22902,0)
  11512   MASS CLINI C FLAG^RS^ 0:NO;1:YES ;^MX;1^Q
  11513   "^DD",44,4 4,22902,3)
  11514   Enter YES  to make th is Clinic  available  for appoin tments in  MASS, NO -  in VistA.
  11515   "^DD",44,4 4,22902,21 ,0)
  11516   ^.001^3^3^ 3170928^^
  11517   "^DD",44,4 4,22902,21 ,1,0)
  11518   This field  should co ntain a YE S only if  the clinic  makes app ointments  in 
  11519   "^DD",44,4 4,22902,21 ,2,0)
  11520   Medical Ap pointment  Scheduling  Solution  (MASS), or  contain N O
  11521   "^DD",44,4 4,22902,21 ,3,0)
  11522   to make ap pointments  in VistA.
  11523   "^DD",44,4 4,22902,"D T")
  11524   3170928
  11525   **END**
  11526   **END**