32. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 4/4/2019 2:58:33 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.

32.1 Files compared

# Location File Last Modified
1 C:\AraxisMergeCompare\Pri_un\VHIE_VDIF\VistA XU_8_672B.KID Tue Apr 2 18:49:35 2019 UTC
2 C:\AraxisMergeCompare\Pri_re\eHealth Exchange Enhancements Phase 2-redacted\VHIE_VDIF\VistA XU_8_672B.KID Tue Apr 2 20:31:56 2019 UTC

32.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 7 15128
Changed 6 12
Inserted 0 0
Removed 0 0

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

32.4 Active regular expressions

No regular expressions were active.

32.5 Comparison detail

  1   KIDS Distr ibution sa ved on Apr  03, 2018@ 12:41:31
  2   XU*8.0*672
  3   **KIDS**:X U*8.0*672^
  4  
  5   **INSTALL  NAME**
  6   XU*8.0*672
  7   "BLD",1583 ,0)
  8   XU*8.0*672 ^KERNEL^0^ 3180403^y
  9   "BLD",1583 ,1,0)
  10   ^^1^1^3180 403^
  11   "BLD",1583 ,1,1,0)
  12   Please see  the descr iption on  Forum
  13   "BLD",1583 ,4,0)
  14   ^9.64PA^19 ^3
  15   "BLD",1583 ,4,9.4,0)
  16   9.4
  17   "BLD",1583 ,4,9.4,2,0 )
  18   ^9.641^9.4 ^1
  19   "BLD",1583 ,4,9.4,2,9 .4,0)
  20   PACKAGE  ( File-top l evel)
  21   "BLD",1583 ,4,9.4,2,9 .4,1,0)
  22   ^9.6411^.0 1^1
  23   "BLD",1583 ,4,9.4,2,9 .4,1,.01,0 )
  24   NAME
  25   "BLD",1583 ,4,9.4,222 )
  26   y^n^p^^^^n ^^n
  27   "BLD",1583 ,4,9.4,224 )
  28  
  29   "BLD",1583 ,4,9.6,0)
  30   9.6
  31   "BLD",1583 ,4,9.6,222 )
  32   y^n^f^^^^n
  33   "BLD",1583 ,4,19,0)
  34   19
  35   "BLD",1583 ,4,19,2,0)
  36   ^9.641^19^ 1
  37   "BLD",1583 ,4,19,2,19 ,0)
  38   OPTION  (F ile-top le vel)
  39   "BLD",1583 ,4,19,2,19 ,1,0)
  40   ^9.6411^82 ^1
  41   "BLD",1583 ,4,19,2,19 ,1,82,0)
  42   DIQ(0)
  43   "BLD",1583 ,4,19,222)
  44   y^n^p^^^^n ^^n
  45   "BLD",1583 ,4,19,224)
  46  
  47   "BLD",1583 ,4,"APDD", 9.4,9.4)
  48  
  49   "BLD",1583 ,4,"APDD", 9.4,9.4,.0 1)
  50  
  51   "BLD",1583 ,4,"APDD", 19,19)
  52  
  53   "BLD",1583 ,4,"APDD", 19,19,82)
  54  
  55   "BLD",1583 ,4,"B",9.4 ,9.4)
  56  
  57   "BLD",1583 ,4,"B",9.6 ,9.6)
  58  
  59   "BLD",1583 ,4,"B",19, 19)
  60  
  61   "BLD",1583 ,6.3)
  62   7
  63   "BLD",1583 ,"ABPKG")
  64   n
  65   "BLD",1583 ,"INIT")
  66   XU8P672
  67   "BLD",1583 ,"KRN",0)
  68   ^9.67PA^90 02226^22
  69   "BLD",1583 ,"KRN",.4, 0)
  70   .4
  71   "BLD",1583 ,"KRN",.40 1,0)
  72   .401
  73   "BLD",1583 ,"KRN",.40 2,0)
  74   .402
  75   "BLD",1583 ,"KRN",.40 3,0)
  76   .403
  77   "BLD",1583 ,"KRN",.40 3,"NM",0)
  78   ^9.68A^1^1
  79   "BLD",1583 ,"KRN",.40 3,"NM",1,0 )
  80   XPD EDIT B UILD    FI LE #9.6^9. 6^0
  81   "BLD",1583 ,"KRN",.40 3,"NM","B" ,"XPD EDIT  BUILD     FILE #9.6" ,1)
  82  
  83   "BLD",1583 ,"KRN",.5, 0)
  84   .5
  85   "BLD",1583 ,"KRN",.84 ,0)
  86   .84
  87   "BLD",1583 ,"KRN",3.6 ,0)
  88   3.6
  89   "BLD",1583 ,"KRN",3.8 ,0)
  90   3.8
  91   "BLD",1583 ,"KRN",9.2 ,0)
  92   9.2
  93   "BLD",1583 ,"KRN",9.8 ,0)
  94   9.8
  95   "BLD",1583 ,"KRN",9.8 ,"NM",0)
  96   ^9.68A^16^ 16
  97   "BLD",1583 ,"KRN",9.8 ,"NM",1,0)
  98   XPDIGP^^0^ B16340784
  99   "BLD",1583 ,"KRN",9.8 ,"NM",2,0)
  100   XPDMENU^^0 ^B5326422
  101   "BLD",1583 ,"KRN",9.8 ,"NM",3,0)
  102   XPDIA3^^0^ B12998832
  103   "BLD",1583 ,"KRN",9.8 ,"NM",4,0)
  104   XPDIJ^^0^B 25041581
  105   "BLD",1583 ,"KRN",9.8 ,"NM",5,0)
  106   XPDIST^^0^ B18736775
  107   "BLD",1583 ,"KRN",9.8 ,"NM",6,0)
  108   XPDIP^^0^B 36894605
  109   "BLD",1583 ,"KRN",9.8 ,"NM",7,0)
  110   XPDTC^^0^B 46881298
  111   "BLD",1583 ,"KRN",9.8 ,"NM",8,0)
  112   XPDE^^0^B4 9625956
  113   "BLD",1583 ,"KRN",9.8 ,"NM",9,0)
  114   XPDTA2^^0^ B18380713
  115   "BLD",1583 ,"KRN",9.8 ,"NM",10,0 )
  116   XPDET^^0^B 36528246
  117   "BLD",1583 ,"KRN",9.8 ,"NM",11,0 )
  118   XPDIA0^^0^ B31500090
  119   "BLD",1583 ,"KRN",9.8 ,"NM",12,0 )
  120   XPDT^^0^B6 4186009
  121   "BLD",1583 ,"KRN",9.8 ,"NM",13,0 )
  122   XPDUTL^^0^ B24086795
  123   "BLD",1583 ,"KRN",9.8 ,"NM",14,0 )
  124   XPDIL^^0^B 21561860
  125   "BLD",1583 ,"KRN",9.8 ,"NM",15,0 )
  126   XPDIA1^^0^ B73300100
  127   "BLD",1583 ,"KRN",9.8 ,"NM",16,0 )
  128   XPDIA^^0^B 57775447
  129   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDE",8)
  130  
  131   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDET",10 )
  132  
  133   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIA",16 )
  134  
  135   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIA0",1 1)
  136  
  137   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIA1",1 5)
  138  
  139   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIA3",3 )
  140  
  141   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIGP",1 )
  142  
  143   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIJ",4)
  144  
  145   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIL",14 )
  146  
  147   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIP",6)
  148  
  149   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDIST",5 )
  150  
  151   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDMENU", 2)
  152  
  153   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDT",12)
  154  
  155   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDTA2",9 )
  156  
  157   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDTC",7)
  158  
  159   "BLD",1583 ,"KRN",9.8 ,"NM","B", "XPDUTL",1 3)
  160  
  161   "BLD",1583 ,"KRN",19, 0)
  162   19
  163   "BLD",1583 ,"KRN",19. 1,0)
  164   19.1
  165   "BLD",1583 ,"KRN",101 ,0)
  166   101
  167   "BLD",1583 ,"KRN",409 .61,0)
  168   409.61
  169   "BLD",1583 ,"KRN",771 ,0)
  170   771
  171   "BLD",1583 ,"KRN",779 .2,0)
  172   779.2
  173   "BLD",1583 ,"KRN",870 ,0)
  174   870
  175   "BLD",1583 ,"KRN",898 9.51,0)
  176   8989.51
  177   "BLD",1583 ,"KRN",898 9.52,0)
  178   8989.52
  179   "BLD",1583 ,"KRN",899 3,0)
  180   8993
  181   "BLD",1583 ,"KRN",899 4,0)
  182   8994
  183   "BLD",1583 ,"KRN",900 2226,0)
  184   9002226
  185   "BLD",1583 ,"KRN","B" ,.4,.4)
  186  
  187   "BLD",1583 ,"KRN","B" ,.401,.401 )
  188  
  189   "BLD",1583 ,"KRN","B" ,.402,.402 )
  190  
  191   "BLD",1583 ,"KRN","B" ,.403,.403 )
  192  
  193   "BLD",1583 ,"KRN","B" ,.5,.5)
  194  
  195   "BLD",1583 ,"KRN","B" ,.84,.84)
  196  
  197   "BLD",1583 ,"KRN","B" ,3.6,3.6)
  198  
  199   "BLD",1583 ,"KRN","B" ,3.8,3.8)
  200  
  201   "BLD",1583 ,"KRN","B" ,9.2,9.2)
  202  
  203   "BLD",1583 ,"KRN","B" ,9.8,9.8)
  204  
  205   "BLD",1583 ,"KRN","B" ,19,19)
  206  
  207   "BLD",1583 ,"KRN","B" ,19.1,19.1 )
  208  
  209   "BLD",1583 ,"KRN","B" ,101,101)
  210  
  211   "BLD",1583 ,"KRN","B" ,409.61,40 9.61)
  212  
  213   "BLD",1583 ,"KRN","B" ,771,771)
  214  
  215   "BLD",1583 ,"KRN","B" ,779.2,779 .2)
  216  
  217   "BLD",1583 ,"KRN","B" ,870,870)
  218  
  219   "BLD",1583 ,"KRN","B" ,8989.51,8 989.51)
  220  
  221   "BLD",1583 ,"KRN","B" ,8989.52,8 989.52)
  222  
  223   "BLD",1583 ,"KRN","B" ,8993,8993 )
  224  
  225   "BLD",1583 ,"KRN","B" ,8994,8994 )
  226  
  227   "BLD",1583 ,"KRN","B" ,9002226,9 002226)
  228  
  229   "BLD",1583 ,"QDEF")
  230   ^^^^NO^^^^ NO^^NO
  231   "BLD",1583 ,"QUES",0)
  232   ^9.62^^
  233   "BLD",1583 ,"REQB",0)
  234   ^9.611^^0
  235   "FIA",9.4)
  236   PACKAGE
  237   "FIA",9.4, 0)
  238   ^DIC(9.4,
  239   "FIA",9.4, 0,0)
  240   9.4I
  241   "FIA",9.4, 0,1)
  242   y^n^p^^^^n ^^n
  243   "FIA",9.4, 0,10)
  244  
  245   "FIA",9.4, 0,11)
  246  
  247   "FIA",9.4, 0,"RLRO")
  248  
  249   "FIA",9.4, 0,"VR")
  250   8.0^XU
  251   "FIA",9.4, 9.4)
  252   1
  253   "FIA",9.4, 9.4,.01)
  254  
  255   "FIA",9.6)
  256   BUILD
  257   "FIA",9.6, 0)
  258   ^XPD(9.6,
  259   "FIA",9.6, 0,0)
  260   9.6I
  261   "FIA",9.6, 0,1)
  262   y^n^f^^^^n
  263   "FIA",9.6, 0,10)
  264  
  265   "FIA",9.6, 0,11)
  266  
  267   "FIA",9.6, 0,"RLRO")
  268  
  269   "FIA",9.6, 0,"VR")
  270   8.0^XU
  271   "FIA",9.6, 9.6)
  272   0
  273   "FIA",9.6, 9.61)
  274   0
  275   "FIA",9.6, 9.611)
  276   0
  277   "FIA",9.6, 9.62)
  278   0
  279   "FIA",9.6, 9.623)
  280   0
  281   "FIA",9.6, 9.626)
  282   0
  283   "FIA",9.6, 9.63)
  284   0
  285   "FIA",9.6, 9.64)
  286   0
  287   "FIA",9.6, 9.641)
  288   0
  289   "FIA",9.6, 9.6411)
  290   0
  291   "FIA",9.6, 9.65)
  292   0
  293   "FIA",9.6, 9.66)
  294   0
  295   "FIA",9.6, 9.661)
  296   0
  297   "FIA",9.6, 9.67)
  298   0
  299   "FIA",9.6, 9.68)
  300   0
  301   "FIA",19)
  302   OPTION
  303   "FIA",19,0 )
  304   ^DIC(19,
  305   "FIA",19,0 ,0)
  306   19I
  307   "FIA",19,0 ,1)
  308   y^n^p^^^^n ^^n
  309   "FIA",19,0 ,10)
  310  
  311   "FIA",19,0 ,11)
  312  
  313   "FIA",19,0 ,"RLRO")
  314  
  315   "FIA",19,0 ,"VR")
  316   8.0^XU
  317   "FIA",19,1 9)
  318   1
  319   "FIA",19,1 9,82)
  320  
  321   "INIT")
  322   XU8P672
  323   "IX",9.6,9 .64,"AD",0 )
  324   9.64^AD^De lete field s if data  no longer  comes with  file.^MU^ ^F^^I^9.64 ^^^^^A
  325   "IX",9.6,9 .64,"AD",. 1,0)
  326   ^^2^2^3030 522^^
  327   "IX",9.6,9 .64,"AD",. 1,1,0)
  328   If DATA CO MES WITH F ILE (#222. 7) is chan ged from Y ES (to NO  or null),  then
  329   "IX",9.6,9 .64,"AD",. 1,2,0)
  330   make sure  that any f ields asso ciated wit h data com ing with t he file ar e null.
  331   "IX",9.6,9 .64,"AD",1 )
  332   D ADXREF^X PDKRN
  333   "IX",9.6,9 .64,"AD",1 .4)
  334   S X=(X1(1) ="y")
  335   "IX",9.6,9 .64,"AD",2 )
  336   Q
  337   "IX",9.6,9 .64,"AD",1 1.1,0)
  338   ^.114IA^1^ 1
  339   "IX",9.6,9 .64,"AD",1 1.1,1,0)
  340   1^F^9.64^2 22.7^^^
  341   "KRN",.403 ,1,-1)
  342   0^1
  343   "KRN",.403 ,1,0)
  344   XPD EDIT B UILD^#^^^2 931104^^^9 .6^0^0^1
  345   "KRN",.403 ,1,40,0)
  346   ^.4031I^17 ^15
  347   "KRN",.403 ,1,40,1,0)
  348   1^^1,1^4^1 7
  349   "KRN",.403 ,1,40,1,1)
  350   Page 1
  351   "KRN",.403 ,1,40,1,40 ,0)
  352   ^.4032PI^2 ^2
  353   "KRN",.403 ,1,40,1,40 ,1,0)
  354   XPD EDIT B UILD HDR^1 ^1,1^d
  355   "KRN",.403 ,1,40,1,40 ,2,0)
  356   XPD EDIT B UILD1^2^1, 1^e
  357   "KRN",.403 ,1,40,2,0)
  358   2^^1,1^14^ 4
  359   "KRN",.403 ,1,40,2,1)
  360   Page 2
  361   "KRN",.403 ,1,40,2,12 )
  362  
  363   "KRN",.403 ,1,40,2,40 ,0)
  364   ^.4032PI^1 3^3
  365   "KRN",.403 ,1,40,2,40 ,1,0)
  366   XPD EDIT B UILD HDR^1 ^1,1^d
  367   "KRN",.403 ,1,40,2,40 ,3,0)
  368   XPD EDIT B UILD2^2^1, 1^e
  369   "KRN",.403 ,1,40,2,40 ,13,0)
  370   XPD EDIT B UILD30^3^5 ,1^e
  371   "KRN",.403 ,1,40,2,40 ,13,2)
  372   12^^f^1
  373   "KRN",.403 ,1,40,3,0)
  374   3^^5,1^^^1 ^17,79
  375   "KRN",.403 ,1,40,3,1)
  376   Kernel Fil e^1,3,2
  377   "KRN",.403 ,1,40,3,40 ,0)
  378   ^.4032PI^9 ^2
  379   "KRN",.403 ,1,40,3,40 ,4,0)
  380   XPD EDIT B UILD3^1^3, 2^e
  381   "KRN",.403 ,1,40,3,40 ,4,2)
  382   9^^n
  383   "KRN",.403 ,1,40,3,40 ,9,0)
  384   XPD EDIT B UILD31^2^1 ,2^d
  385   "KRN",.403 ,1,40,4,0)
  386   4^^1,1^2^1
  387   "KRN",.403 ,1,40,4,1)
  388   File^
  389   "KRN",.403 ,1,40,4,40 ,0)
  390   ^.4032PI^1 5^3
  391   "KRN",.403 ,1,40,4,40 ,1,0)
  392   XPD EDIT B UILD HDR^1 ^1,1^d
  393   "KRN",.403 ,1,40,4,40 ,14,0)
  394   XPD EDIT B UILD40^2^5 ,1^e
  395   "KRN",.403 ,1,40,4,40 ,14,2)
  396   12^^n
  397   "KRN",.403 ,1,40,4,40 ,15,0)
  398   XPD EDIT B UILD41^3^1 ,1^d
  399   "KRN",.403 ,1,40,7,0)
  400   7^^5,1^^^1 ^17,78
  401   "KRN",.403 ,1,40,7,1)
  402   Entries^
  403   "KRN",.403 ,1,40,7,40 ,0)
  404   ^.4032PI^5 ^1
  405   "KRN",.403 ,1,40,7,40 ,5,0)
  406   XPD EDIT B UILD4^2^1, 1^e
  407   "KRN",.403 ,1,40,8,0)
  408   8^^5,2^^^1 ^15,78
  409   "KRN",.403 ,1,40,8,1)
  410   Package fi le
  411   "KRN",.403 ,1,40,8,11 )
  412  
  413   "KRN",.403 ,1,40,8,40 ,0)
  414   ^.4032PI^2 3^2
  415   "KRN",.403 ,1,40,8,40 ,10,0)
  416   XPD EDIT B UILD8^3^8, 2^e
  417   "KRN",.403 ,1,40,8,40 ,23,0)
  418   XPD EDIT B UILD60^4^1 ,2^d
  419   "KRN",.403 ,1,40,9,0)
  420   9^^4,3^^^1 ^16,77
  421   "KRN",.403 ,1,40,9,1)
  422   Page 9
  423   "KRN",.403 ,1,40,9,12 )
  424  
  425   "KRN",.403 ,1,40,9,40 ,0)
  426   ^.4032PI^2 4^2
  427   "KRN",.403 ,1,40,9,40 ,11,0)
  428   XPD EDIT B UILD9^1^1, 2^e
  429   "KRN",.403 ,1,40,9,40 ,24,0)
  430   XPD EDIT B UILD9A^2^8 ,2^e
  431   "KRN",.403 ,1,40,9,40 ,24,2)
  432   4
  433   "KRN",.403 ,1,40,10,0 )
  434   10^^5,4^^^ 1^9,76
  435   "KRN",.403 ,1,40,10,1 )
  436   A/B namesp ace^
  437   "KRN",.403 ,1,40,10,1 1)
  438  
  439   "KRN",.403 ,1,40,10,1 2)
  440  
  441   "KRN",.403 ,1,40,10,4 0,0)
  442   ^.4032PI^2 5^2
  443   "KRN",.403 ,1,40,10,4 0,12,0)
  444   XPD EDIT B UILD10^1^1 ,3^e
  445   "KRN",.403 ,1,40,10,4 0,25,0)
  446   XPD EDIT B UILD10A^2^ 2,2^e
  447   "KRN",.403 ,1,40,10,4 0,25,2)
  448   2
  449   "KRN",.403 ,1,40,11,0 )
  450   11^^6,2^^^ 1^16,77
  451   "KRN",.403 ,1,40,11,1 )
  452   Sub DD
  453   "KRN",.403 ,1,40,11,4 0,0)
  454   ^.4032PI^1 8^2
  455   "KRN",.403 ,1,40,11,4 0,16,0)
  456   XPD EDIT B UILD42^1^2 ,3^e
  457   "KRN",.403 ,1,40,11,4 0,16,2)
  458   6^!IEN^n^^
  459   "KRN",.403 ,1,40,11,4 0,18,0)
  460   XPD EDIT B UILD44^2^1 ,3^d
  461   "KRN",.403 ,1,40,12,0 )
  462   12^^7,3^^^ 1^15,76
  463   "KRN",.403 ,1,40,12,1 )
  464   Sub Field
  465   "KRN",.403 ,1,40,12,4 0,0)
  466   ^.4032PI^1 9^2
  467   "KRN",.403 ,1,40,12,4 0,17,0)
  468   XPD EDIT B UILD43^1^2 ,3^e
  469   "KRN",.403 ,1,40,12,4 0,17,2)
  470   6^!IEN^n
  471   "KRN",.403 ,1,40,12,4 0,19,0)
  472   XPD EDIT B UILD45^2^1 ,2^d
  473   "KRN",.403 ,1,40,13,0 )
  474   13^^6,2^^^ 1^16,77
  475   "KRN",.403 ,1,40,13,1 )
  476   Page 13
  477   "KRN",.403 ,1,40,13,4 0,0)
  478   ^.4032PI^2 0^1
  479   "KRN",.403 ,1,40,13,4 0,20,0)
  480   XPD EDIT B UILD46^1^1 ,1^e
  481   "KRN",.403 ,1,40,14,0 )
  482   14^^1,1^17 ^2
  483   "KRN",.403 ,1,40,14,1 )
  484   Page 14
  485   "KRN",.403 ,1,40,14,4 0,0)
  486   ^.4032PI^6 5^4
  487   "KRN",.403 ,1,40,14,4 0,1,0)
  488   XPD EDIT B UILD HDR^1 ^1,1^d
  489   "KRN",.403 ,1,40,14,4 0,21,0)
  490   XPD EDIT B UILD11^4^1 ,1^e
  491   "KRN",.403 ,1,40,14,4 0,22,0)
  492   XPD EDIT B UILD12^2^5 ,1^e
  493   "KRN",.403 ,1,40,14,4 0,22,2)
  494   4^^n
  495   "KRN",.403 ,1,40,14,4 0,65,0)
  496   XPD EDIT B UILD52^3^1 0,1^e
  497   "KRN",.403 ,1,40,14,4 0,65,2)
  498   4
  499   "KRN",.403 ,1,40,15,0 )
  500   15^^2,1^^^ 1^17,79
  501   "KRN",.403 ,1,40,15,1 )
  502   Install qu estions
  503   "KRN",.403 ,1,40,15,4 0,0)
  504   ^.4032PI^8 ^1
  505   "KRN",.403 ,1,40,15,4 0,8,0)
  506   XPD EDIT B UILD7^1^1, 1^e
  507   "KRN",.403 ,1,40,16,0 )
  508   16^XPD EDI T BUILD HD R^1,1
  509   "KRN",.403 ,1,40,16,1 )
  510   Page 16
  511   "KRN",.403 ,1,40,17,0 )
  512   17^^1,1^1^ 14
  513   "KRN",.403 ,1,40,17,1 )
  514   Page 17
  515   "KRN",.403 ,1,40,17,1 5,0)
  516   ^^1^1^3070 620^
  517   "KRN",.403 ,1,40,17,1 5,1,0)
  518   This is th e page to  edit the K IDS instal l QUESTION S default  values.
  519   "KRN",.403 ,1,40,17,4 0,0)
  520   ^.4032IP^2 18^2
  521   "KRN",.403 ,1,40,17,4 0,1,0)
  522   XPD EDIT B UILD HDR^1 ^1,1^e
  523   "KRN",.403 ,1,40,17,4 0,218,0)
  524   XPD EDIT B UILD5D^2^1 ,1^e
  525   "KRN",.404 ,1,0)
  526   XPD EDIT B UILD HDR^9 .6
  527   "KRN",.404 ,1,40,0)
  528   ^.4044I^5^ 5
  529   "KRN",.404 ,1,40,1,0)
  530   1^Edit a B uild^1^
  531   "KRN",.404 ,1,40,1,2)
  532   ^^1,28^
  533   "KRN",.404 ,1,40,2,0)
  534   7^Name^3^
  535   "KRN",.404 ,1,40,2,1)
  536   .01
  537   "KRN",.404 ,1,40,2,2)
  538   2,7^30^2,1
  539   "KRN",.404 ,1,40,2,4)
  540   ^^^1
  541   "KRN",.404 ,1,40,3,0)
  542   3^PAGE   O F 5^1^
  543   "KRN",.404 ,1,40,3,2)
  544   ^^1,66
  545   "KRN",.404 ,1,40,4,0)
  546   4^!M^1^
  547   "KRN",.404 ,1,40,4,.1 )
  548   S $P(Y,"-" ,80)=""
  549   "KRN",.404 ,1,40,4,2)
  550   ^^3,1^
  551   "KRN",.404 ,1,40,5,0)
  552   8^TYPE^3
  553   "KRN",.404 ,1,40,5,1)
  554   2
  555   "KRN",.404 ,1,40,5,2)
  556   2,51^14^2, 45
  557   "KRN",.404 ,1,40,5,4)
  558   ^^^1
  559   "KRN",.404 ,2,0)
  560   XPD EDIT B UILD1^9.6
  561   "KRN",.404 ,2,12)
  562  
  563   "KRN",.404 ,2,40,0)
  564   ^.4044I^19 ^13
  565   "KRN",.404 ,2,40,1,0)
  566   2^Name^3^
  567   "KRN",.404 ,2,40,1,1)
  568   .01
  569   "KRN",.404 ,2,40,1,2)
  570   5,29^50^5, 23
  571   "KRN",.404 ,2,40,5,0)
  572   5^Environm ent Check  Routine^3^
  573   "KRN",.404 ,2,40,5,1)
  574   913
  575   "KRN",.404 ,2,40,5,2)
  576   11,29^8^11 ,2
  577   "KRN",.404 ,2,40,6,0)
  578   7^Post-Ins tall Routi ne^3^
  579   "KRN",.404 ,2,40,6,1)
  580   914
  581   "KRN",.404 ,2,40,6,2)
  582   15,29^17^1 5,7
  583   "KRN",.404 ,2,40,7,0)
  584   6^Pre-Inst all Routin e^3^
  585   "KRN",.404 ,2,40,7,1)
  586   916
  587   "KRN",.404 ,2,40,7,2)
  588   13,29^17^1 3,8
  589   "KRN",.404 ,2,40,11,0 )
  590   4^Descript ion^3^
  591   "KRN",.404 ,2,40,11,1 )
  592   3
  593   "KRN",.404 ,2,40,11,2 )
  594   9,29^1^9,1 6
  595   "KRN",.404 ,2,40,12,0 )
  596   1^1^1^
  597   "KRN",.404 ,2,40,12,2 )
  598   ^^1,71^
  599   "KRN",.404 ,2,40,13,0 )
  600   3^Date Dis tributed^3
  601   "KRN",.404 ,2,40,13,1 )
  602   .02
  603   "KRN",.404 ,2,40,13,2 )
  604   7,29^11^7, 11
  605   "KRN",.404 ,2,40,14,0 )
  606   8^Pre-Tran sportation  Routine^3
  607   "KRN",.404 ,2,40,14,1 )
  608   900
  609   "KRN",.404 ,2,40,14,2 )
  610   17,29^17^1 7,1
  611   "KRN",.404 ,2,40,15,0 )
  612   11^Delete  Routine^1
  613   "KRN",.404 ,2,40,15,2 )
  614   ^^9,57
  615   "KRN",.404 ,2,40,16,0 )
  616   12^after i nstall^1
  617   "KRN",.404 ,2,40,16,2 )
  618   ^^10,58
  619   "KRN",.404 ,2,40,17,0 )
  620   13^Y/N^3
  621   "KRN",.404 ,2,40,17,1 )
  622   913.1
  623   "KRN",.404 ,2,40,17,2 )
  624   11,64^1^11 ,59
  625   "KRN",.404 ,2,40,17,1 1)
  626   N % S %(1) ="Be VERY  careful se tting this  to yes" D  HLP^DDSUT L(.%)
  627   "KRN",.404 ,2,40,18,0 )
  628   14^Y/N^3
  629   "KRN",.404 ,2,40,18,1 )
  630   916.1
  631   "KRN",.404 ,2,40,18,2 )
  632   13,64^1^13 ,59
  633   "KRN",.404 ,2,40,18,1 1)
  634   N % S %(1) ="Be VERY  careful se tting this  to yes" D  HLP^DDSUT L(.%)
  635   "KRN",.404 ,2,40,19,0 )
  636   15^Y/N^3
  637   "KRN",.404 ,2,40,19,1 )
  638   914.1
  639   "KRN",.404 ,2,40,19,2 )
  640   15,64^1^15 ,59
  641   "KRN",.404 ,2,40,19,1 1)
  642   N % S %(1) ="Be VERY  careful se tting this  to yes" D  HLP^DDSUT L(.%)
  643   "KRN",.404 ,3,0)
  644   XPD EDIT B UILD2^9.6
  645   "KRN",.404 ,3,12)
  646  
  647   "KRN",.404 ,3,40,0)
  648   ^.4044I^2^ 2
  649   "KRN",.404 ,3,40,1,0)
  650   99^3^1^
  651   "KRN",.404 ,3,40,1,2)
  652   ^^1,71^
  653   "KRN",.404 ,3,40,2,0)
  654   2^Build Co mponents^1 ^
  655   "KRN",.404 ,3,40,2,2)
  656   ^^4,28^1
  657   "KRN",.404 ,4,0)
  658   XPD EDIT B UILD3^9.68
  659   "KRN",.404 ,4,40,0)
  660   ^.4044I^2^ 2
  661   "KRN",.404 ,4,40,1,0)
  662   1^^3^
  663   "KRN",.404 ,4,40,1,1)
  664   .01
  665   "KRN",.404 ,4,40,1,2)
  666   1,2^45
  667   "KRN",.404 ,4,40,2,0)
  668   2^^3
  669   "KRN",.404 ,4,40,2,1)
  670   .03
  671   "KRN",.404 ,4,40,2,2)
  672   1,50^26
  673   "KRN",.404 ,4,40,2,3)
  674   SEND TO SI TE
  675   "KRN",.404 ,4,40,2,4)
  676   1
  677   "KRN",.404 ,5,0)
  678   XPD EDIT B UILD4^9.64
  679   "KRN",.404 ,5,40,0)
  680   ^.4044I^18 ^7
  681   "KRN",.404 ,5,40,1,0)
  682   1^ DD Expo rt Options  ^1^
  683   "KRN",.404 ,5,40,1,2)
  684   ^^1,27^1
  685   "KRN",.404 ,5,40,2,0)
  686   2^File^3^
  687   "KRN",.404 ,5,40,2,1)
  688   .01
  689   "KRN",.404 ,5,40,2,2)
  690   3,30^45^3, 24
  691   "KRN",.404 ,5,40,7,0)
  692   7^Data Com es With Fi le...^3^
  693   "KRN",.404 ,5,40,7,1)
  694   222.7
  695   "KRN",.404 ,5,40,7,2)
  696   12,33^3^12 ,8
  697   "KRN",.404 ,5,40,7,3)
  698   NO
  699   "KRN",.404 ,5,40,7,10 )
  700   S:X="y" DD SSTACK=13
  701   "KRN",.404 ,5,40,7,13 )
  702   D:X="y" PU T^DDSVAL(D IE,.DA,222 .3,"f","", "I")
  703   "KRN",.404 ,5,40,13,0 )
  704   6^Screen t o Determin e DD Updat e^3
  705   "KRN",.404 ,5,40,13,1 )
  706   223
  707   "KRN",.404 ,5,40,13,2 )
  708   10,2^76^9, 2^1
  709   "KRN",.404 ,5,40,14,0 )
  710   5^Send Sec urity Code ^3
  711   "KRN",.404 ,5,40,14,1 )
  712   222.2
  713   "KRN",.404 ,5,40,14,2 )
  714   7,62^3^7,4 2
  715   "KRN",.404 ,5,40,14,3 )
  716   YES
  717   "KRN",.404 ,5,40,16,0 )
  718   4^Update t he Data Di ctionary^3
  719   "KRN",.404 ,5,40,16,1 )
  720   222.1
  721   "KRN",.404 ,5,40,16,2 )
  722   7,30^3^7,2
  723   "KRN",.404 ,5,40,16,3 )
  724   YES
  725   "KRN",.404 ,5,40,18,0 )
  726   3^Send Ful l or Parti al DD...^3
  727   "KRN",.404 ,5,40,18,1 )
  728   222.3
  729   "KRN",.404 ,5,40,18,2 )
  730   5,33^7^5,5
  731   "KRN",.404 ,5,40,18,3 )
  732   FULL
  733   "KRN",.404 ,5,40,18,1 0)
  734   S:X="p" DD SSTACK=11
  735   "KRN",.404 ,5,40,18,1 3)
  736   D:X="p" PA R964^XPDET
  737   "KRN",.404 ,8,0)
  738   XPD EDIT B UILD7^9.62
  739   "KRN",.404 ,8,40,0)
  740   ^.4044I^10 ^10
  741   "KRN",.404 ,8,40,1,0)
  742   2^Name^3^
  743   "KRN",.404 ,8,40,1,1)
  744   .01
  745   "KRN",.404 ,8,40,1,2)
  746   2,12^30^2, 6
  747   "KRN",.404 ,8,40,2,0)
  748   3^DIR(0)^3 ^
  749   "KRN",.404 ,8,40,2,1)
  750   1
  751   "KRN",.404 ,8,40,2,2)
  752   4,12^65^4, 4
  753   "KRN",.404 ,8,40,3,0)
  754   4^DIR(A)^3 ^
  755   "KRN",.404 ,8,40,3,1)
  756   2
  757   "KRN",.404 ,8,40,3,2)
  758   6,12^65^6, 4
  759   "KRN",.404 ,8,40,4,0)
  760   5^DIR(A,#) ^3^
  761   "KRN",.404 ,8,40,4,1)
  762   3
  763   "KRN",.404 ,8,40,4,2)
  764   7,12^1^7,2
  765   "KRN",.404 ,8,40,5,0)
  766   6^DIR(B)^3 ^
  767   "KRN",.404 ,8,40,5,1)
  768   4
  769   "KRN",.404 ,8,40,5,2)
  770   9,12^65^9, 4
  771   "KRN",.404 ,8,40,6,0)
  772   7^DIR(?)^3 ^
  773   "KRN",.404 ,8,40,6,1)
  774   5
  775   "KRN",.404 ,8,40,6,2)
  776   11,12^65^1 1,4
  777   "KRN",.404 ,8,40,7,0)
  778   8^DIR(?,#) ^3^
  779   "KRN",.404 ,8,40,7,1)
  780   6
  781   "KRN",.404 ,8,40,7,2)
  782   12,12^1^12 ,2
  783   "KRN",.404 ,8,40,8,0)
  784   9^DIR(??)^ 3^
  785   "KRN",.404 ,8,40,8,1)
  786   7
  787   "KRN",.404 ,8,40,8,2)
  788   13,12^64^1 3,3
  789   "KRN",.404 ,8,40,9,0)
  790   10^M Code^ 3
  791   "KRN",.404 ,8,40,9,1)
  792   10
  793   "KRN",.404 ,8,40,9,2)
  794   15,12^65^1 5,4
  795   "KRN",.404 ,8,40,10,0 )
  796   1^ Install  Questions  ^1^
  797   "KRN",.404 ,8,40,10,2 )
  798   ^^1,27^1
  799   "KRN",.404 ,9,0)
  800   XPD EDIT B UILD31^9.6 7
  801   "KRN",.404 ,9,40,0)
  802   ^.4044I^1^ 1
  803   "KRN",.404 ,9,40,1,0)
  804   1^!M^1^
  805   "KRN",.404 ,9,40,1,.1 )
  806   S Y=" "_$P ($G(^DIC(D 1,0)),U)_"  "
  807   "KRN",.404 ,9,40,1,2)
  808   ^^1,27^
  809   "KRN",.404 ,10,0)
  810   XPD EDIT B UILD8^9.6
  811   "KRN",.404 ,10,11)
  812  
  813   "KRN",.404 ,10,40,0)
  814   ^.4044I^1^ 1
  815   "KRN",.404 ,10,40,1,0 )
  816   1^Alpha/Be ta Testing ...^3
  817   "KRN",.404 ,10,40,1,1 )
  818   20
  819   "KRN",.404 ,10,40,1,2 )
  820   2,31^3^2,8
  821   "KRN",.404 ,10,40,1,3 )
  822   NO
  823   "KRN",.404 ,10,40,1,1 0)
  824   S:X="y" DD SSTACK="9"
  825   "KRN",.404 ,11,0)
  826   XPD EDIT B UILD9^9.6
  827   "KRN",.404 ,11,40,0)
  828   ^.4044I^5^ 4
  829   "KRN",.404 ,11,40,1,0 )
  830   2^Installa tion Messa ge^3
  831   "KRN",.404 ,11,40,1,1 )
  832   21
  833   "KRN",.404 ,11,40,1,2 )
  834   3,30^3^3,8
  835   "KRN",.404 ,11,40,1,3 )
  836   NO
  837   "KRN",.404 ,11,40,2,0 )
  838   3^Address  for Usage  Reporting^ 3
  839   "KRN",.404 ,11,40,2,1 )
  840   22
  841   "KRN",.404 ,11,40,2,2 )
  842   5,30^44^5, 1
  843   "KRN",.404 ,11,40,4,0 )
  844   1^ Alpha/B eta Testin g ^1^
  845   "KRN",.404 ,11,40,4,2 )
  846   ^^1,26^1
  847   "KRN",.404 ,11,40,5,0 )
  848   4^Package  Namespace  or Prefix: ^1
  849   "KRN",.404 ,11,40,5,2 )
  850   ^^7,1
  851   "KRN",.404 ,12,0)
  852   XPD EDIT B UILD10^9.6 6
  853   "KRN",.404 ,12,40,0)
  854   ^.4044I^1^ 1
  855   "KRN",.404 ,12,40,1,0 )
  856   1^ Exclude  Namespace  or Prefix  ^1
  857   "KRN",.404 ,12,40,1,2 )
  858   ^^1,20^1
  859   "KRN",.404 ,13,0)
  860   XPD EDIT B UILD30^9.6 7
  861   "KRN",.404 ,13,40,0)
  862   ^.4044I^2^ 2
  863   "KRN",.404 ,13,40,1,0 )
  864   1^^3
  865   "KRN",.404 ,13,40,1,1 )
  866   .01
  867   "KRN",.404 ,13,40,1,2 )
  868   2,1^24
  869   "KRN",.404 ,13,40,1,4 )
  870   ^^^2
  871   "KRN",.404 ,13,40,1,1 0)
  872   S DDSSTACK =3
  873   "KRN",.404 ,13,40,2,0 )
  874   2^^4
  875   "KRN",.404 ,13,40,2,2 )
  876   2,27^5
  877   "KRN",.404 ,13,40,2,4 )
  878   ^^1
  879   "KRN",.404 ,13,40,2,3 0)
  880   S Y="("_+$ P($G(^XPD( 9.6,DA(1), "KRN",DA," NM",0)),U, 4)_")"
  881   "KRN",.404 ,14,0)
  882   XPD EDIT B UILD40^9.6 4
  883   "KRN",.404 ,14,40,0)
  884   ^.4044I^1^ 1
  885   "KRN",.404 ,14,40,1,0 )
  886   1^^3
  887   "KRN",.404 ,14,40,1,1 )
  888   .01
  889   "KRN",.404 ,14,40,1,2 )
  890   2,7^45
  891   "KRN",.404 ,14,40,1,1 0)
  892   S DDSSTACK =7
  893   "KRN",.404 ,15,0)
  894   XPD EDIT B UILD41^9.6
  895   "KRN",.404 ,15,40,0)
  896   ^.4044I^3^ 2
  897   "KRN",.404 ,15,40,1,0 )
  898   1^2^1^
  899   "KRN",.404 ,15,40,1,2 )
  900   ^^1,71^
  901   "KRN",.404 ,15,40,3,0 )
  902   2^File Lis t  (Name o r Number)^ 1
  903   "KRN",.404 ,15,40,3,2 )
  904   ^^4,28
  905   "KRN",.404 ,16,0)
  906   XPD EDIT B UILD42^9.6 41
  907   "KRN",.404 ,16,40,0)
  908   ^.4044I^1^ 1
  909   "KRN",.404 ,16,40,1,0 )
  910   1^^3
  911   "KRN",.404 ,16,40,1,1 )
  912   .01
  913   "KRN",.404 ,16,40,1,2 )
  914   1,1^45
  915   "KRN",.404 ,16,40,1,1 0)
  916   S DDSSTACK =12
  917   "KRN",.404 ,17,0)
  918   XPD EDIT B UILD43^9.6 411
  919   "KRN",.404 ,17,40,0)
  920   ^.4044I^1^ 1
  921   "KRN",.404 ,17,40,1,0 )
  922   1^^3
  923   "KRN",.404 ,17,40,1,1 )
  924   .01
  925   "KRN",.404 ,17,40,1,2 )
  926   1,1^45
  927   "KRN",.404 ,18,0)
  928   XPD EDIT B UILD44^9.6 4
  929   "KRN",.404 ,18,40,0)
  930   ^.4044I^1^ 1
  931   "KRN",.404 ,18,40,1,0 )
  932   1^ Data Di ctionary N umber ^1^
  933   "KRN",.404 ,18,40,1,2 )
  934   ^^1,24^1
  935   "KRN",.404 ,19,0)
  936   XPD EDIT B UILD45^9.6 41
  937   "KRN",.404 ,19,40,0)
  938   ^.4044I^1^ 1
  939   "KRN",.404 ,19,40,1,0 )
  940   1^ Field N umber ^1^
  941   "KRN",.404 ,19,40,1,2 )
  942   ^^1,24^1
  943   "KRN",.404 ,20,0)
  944   XPD EDIT B UILD46^9.6 4
  945   "KRN",.404 ,20,40,0)
  946   ^.4044I^7^ 6
  947   "KRN",.404 ,20,40,1,0 )
  948   1^ Data Ex port Optio ns ^1^
  949   "KRN",.404 ,20,40,1,2 )
  950   ^^1,29^1
  951   "KRN",.404 ,20,40,2,0 )
  952   2^Site's D ata^3
  953   "KRN",.404 ,20,40,2,1 )
  954   222.8
  955   "KRN",.404 ,20,40,2,2 )
  956   3,21^15^3, 8
  957   "KRN",.404 ,20,40,2,3 )
  958   OVERWRITE
  959   "KRN",.404 ,20,40,3,0 )
  960   5^Data Lis t^3
  961   "KRN",.404 ,20,40,3,1 )
  962   222.6
  963   "KRN",.404 ,20,40,3,2 )
  964   7,21^30^7, 10
  965   "KRN",.404 ,20,40,4,0 )
  966   3^Resolve  Pointers^3
  967   "KRN",.404 ,20,40,4,1 )
  968   222.5
  969   "KRN",.404 ,20,40,4,2 )
  970   5,21^3^5,3
  971   "KRN",.404 ,20,40,4,3 )
  972   NO
  973   "KRN",.404 ,20,40,5,0 )
  974   4^May User  Override  Data Updat e^3
  975   "KRN",.404 ,20,40,5,1 )
  976   222.9
  977   "KRN",.404 ,20,40,5,2 )
  978   5,68^3^5,3 7
  979   "KRN",.404 ,20,40,5,3 )
  980   NO
  981   "KRN",.404 ,20,40,7,0 )
  982   6^Screen t o Select D ata^3
  983   "KRN",.404 ,20,40,7,1 )
  984   224
  985   "KRN",.404 ,20,40,7,2 )
  986   10,3^72^9, 3^1
  987   "KRN",.404 ,21,0)
  988   XPD EDIT B UILD11^9.6
  989   "KRN",.404 ,21,40,0)
  990   ^.4044I^5^ 5
  991   "KRN",.404 ,21,40,1,0 )
  992   1^4^1^
  993   "KRN",.404 ,21,40,1,2 )
  994   ^^1,71^
  995   "KRN",.404 ,21,40,2,0 )
  996   7^Package  File Link. ..^3
  997   "KRN",.404 ,21,40,2,1 )
  998   1
  999   "KRN",.404 ,21,40,2,2 )
  1000   15,27^30^1 5,5
  1001   "KRN",.404 ,21,40,2,1 0)
  1002   S:X]"" DDS STACK=8
  1003   "KRN",.404 ,21,40,3,0 )
  1004   8^Track Pa ckage Nati onally^3
  1005   "KRN",.404 ,21,40,3,1 )
  1006   5
  1007   "KRN",.404 ,21,40,3,2 )
  1008   17,27^3^17 ,1
  1009   "KRN",.404 ,21,40,3,3 )
  1010   NO
  1011   "KRN",.404 ,21,40,3,1 1)
  1012   S:$$GET^DD SVAL(DIE,. DA,1)="" D DSBR="^^CO M"
  1013   "KRN",.404 ,21,40,4,0 )
  1014   2^Install  Questions^ 1^
  1015   "KRN",.404 ,21,40,4,2 )
  1016   ^^4,28^1
  1017   "KRN",.404 ,21,40,5,0 )
  1018   5^Required  Builds^1
  1019   "KRN",.404 ,21,40,5,2 )
  1020   ^^9,28
  1021   "KRN",.404 ,22,0)
  1022   XPD EDIT B UILD12^9.6 2
  1023   "KRN",.404 ,22,40,0)
  1024   ^.4044I^1^ 1
  1025   "KRN",.404 ,22,40,1,0 )
  1026   1^^3
  1027   "KRN",.404 ,22,40,1,1 )
  1028   .01
  1029   "KRN",.404 ,22,40,1,2 )
  1030   1,3^30
  1031   "KRN",.404 ,22,40,1,1 0)
  1032   S DDSSTACK =15
  1033   "KRN",.404 ,23,0)
  1034   XPD EDIT B UILD60^9.6
  1035   "KRN",.404 ,23,40,0)
  1036   ^.4044I^3^ 3
  1037   "KRN",.404 ,23,40,1,0 )
  1038   1^ Edit PA CKAGE File  ^1^
  1039   "KRN",.404 ,23,40,1,2 )
  1040   ^^1,26^1
  1041   "KRN",.404 ,23,40,2,0 )
  1042   2^Name^3
  1043   "KRN",.404 ,23,40,2,1 )
  1044   .01
  1045   "KRN",.404 ,23,40,2,2 )
  1046   2,8^30^2,2
  1047   "KRN",.404 ,23,40,3,0 )
  1048   3^!M^1^
  1049   "KRN",.404 ,23,40,3,. 1)
  1050   S $P(Y,"-" ,76)=""
  1051   "KRN",.404 ,23,40,3,2 )
  1052   ^^3,1^
  1053   "KRN",.404 ,24,0)
  1054   XPD EDIT B UILD9A^9.6 6
  1055   "KRN",.404 ,24,40,0)
  1056   ^.4044I^1^ 1
  1057   "KRN",.404 ,24,40,1,0 )
  1058   1^^3
  1059   "KRN",.404 ,24,40,1,1 )
  1060   .01
  1061   "KRN",.404 ,24,40,1,2 )
  1062   2,2^4
  1063   "KRN",.404 ,24,40,1,1 0)
  1064   S DDSSTACK =10
  1065   "KRN",.404 ,25,0)
  1066   XPD EDIT B UILD10A^9. 661
  1067   "KRN",.404 ,25,40,0)
  1068   ^.4044I^1^ 1
  1069   "KRN",.404 ,25,40,1,0 )
  1070   1^^3
  1071   "KRN",.404 ,25,40,1,1 )
  1072   .01
  1073   "KRN",.404 ,25,40,1,2 )
  1074   1,2^4
  1075   "KRN",.404 ,65,0)
  1076   XPD EDIT B UILD52^9.6 11
  1077   "KRN",.404 ,65,40,0)
  1078   ^.4044I^2^ 2
  1079   "KRN",.404 ,65,40,1,0 )
  1080   2^^3
  1081   "KRN",.404 ,65,40,1,1 )
  1082   .01
  1083   "KRN",.404 ,65,40,1,2 )
  1084   1,3^40
  1085   "KRN",.404 ,65,40,2,0 )
  1086   3^^3
  1087   "KRN",.404 ,65,40,2,1 )
  1088   1
  1089   "KRN",.404 ,65,40,2,2 )
  1090   1,49^30
  1091   "KRN",.404 ,65,40,2,4 )
  1092   1
  1093   "KRN",.404 ,218,0)
  1094   XPD EDIT B UILD5D^9.6
  1095   "KRN",.404 ,218,40,0)
  1096   ^.4044I^5^ 5
  1097   "KRN",.404 ,218,40,1, 0)
  1098   1^Rebuild  Menu Tree  Upon Compl etion^3^^X PO1
  1099   "KRN",.404 ,218,40,1, 1)
  1100   51.09
  1101   "KRN",.404 ,218,40,1, 2)
  1102   6,36^3^6,1
  1103   "KRN",.404 ,218,40,2, 0)
  1104   2^Want KID S to INHIB IT LOGONs^ 3^^XPI1
  1105   "KRN",.404 ,218,40,2, 1)
  1106   51.05
  1107   "KRN",.404 ,218,40,2, 2)
  1108   8,36^3^8,7
  1109   "KRN",.404 ,218,40,3, 0)
  1110   3^Want to  DISABLE Sc heduled Op tions^3^^X PZ1
  1111   "KRN",.404 ,218,40,3, 1)
  1112   51.11
  1113   "KRN",.404 ,218,40,3, 2)
  1114   10,36^3^10 ,1
  1115   "KRN",.404 ,218,40,4, 0)
  1116   4^Change t he 'NO' de faults the  sites wil l see when  KIDS asks  these que stions!^1
  1117   "KRN",.404 ,218,40,4, 2)
  1118   ^^4,3
  1119   "KRN",.404 ,218,40,5, 0)
  1120   5^5^1
  1121   "KRN",.404 ,218,40,5, 2)
  1122   ^^1,71
  1123   "MBREQ")
  1124   0
  1125   "ORD",8,.4 03)
  1126   .403;8;;;E DEOUT^DIFR OMSO(.403, DA,"",XPDA );FPRE^DIF ROMSI(.403 ,"",XPDA); EPRE^DIFRO MSI(.403,D A,$E("N",$ G(XPDNEW)) ,XPDA,"",O LDA);;EPOS T^DIFROMSI (.403,DA," ",XPDA);DE L^DIFROMSK (.403,"",% )
  1127   "ORD",8,.4 03,0)
  1128   FORM
  1129   "PKG",3,-1 )
  1130   1^1
  1131   "PKG",3,0)
  1132   KERNEL^XU^ SIGN-ON, S ECURITY, M ENU DRIVER , DEVICES,  TASKMAN^
  1133   "PKG",3,22 ,0)
  1134   ^9.49I^1^1
  1135   "PKG",3,22 ,1,0)
  1136   8.0^309070 6^3090706^ 6
  1137   "PKG",3,22 ,1,"PAH",1 ,0)
  1138   672^318040 3^6
  1139   "PKG",3,22 ,1,"PAH",1 ,1,0)
  1140   ^^1^1^3180 403
  1141   "PKG",3,22 ,1,"PAH",1 ,1,1,0)
  1142   Please see  the descr iption on  Forum
  1143   "QUES","XP F1",0)
  1144   Y
  1145   "QUES","XP F1","??")
  1146   ^D REP^XPD H
  1147   "QUES","XP F1","A")
  1148   Shall I wr ite over y our |FLAG|  File
  1149   "QUES","XP F1","B")
  1150   YES
  1151   "QUES","XP F1","M")
  1152   D XPF1^XPD IQ
  1153   "QUES","XP F2",0)
  1154   Y
  1155   "QUES","XP F2","??")
  1156   ^D DTA^XPD H
  1157   "QUES","XP F2","A")
  1158   Want my da ta |FLAG|  yours
  1159   "QUES","XP F2","B")
  1160   YES
  1161   "QUES","XP F2","M")
  1162   D XPF2^XPD IQ
  1163   "QUES","XP I1",0)
  1164   YO
  1165   "QUES","XP I1","??")
  1166   ^D INHIBIT ^XPDH
  1167   "QUES","XP I1","A")
  1168   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  1169   "QUES","XP I1","B")
  1170   NO
  1171   "QUES","XP I1","M")
  1172   D XPI1^XPD IQ
  1173   "QUES","XP M1",0)
  1174   PO^VA(200, :EM
  1175   "QUES","XP M1","??")
  1176   ^D MG^XPDH
  1177   "QUES","XP M1","A")
  1178   Enter the  Coordinato r for Mail  Group '|F LAG|'
  1179   "QUES","XP M1","B")
  1180  
  1181   "QUES","XP M1","M")
  1182   D XPM1^XPD IQ
  1183   "QUES","XP O1",0)
  1184   Y
  1185   "QUES","XP O1","??")
  1186   ^D MENU^XP DH
  1187   "QUES","XP O1","A")
  1188   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  1189   "QUES","XP O1","B")
  1190   NO
  1191   "QUES","XP O1","M")
  1192   D XPO1^XPD IQ
  1193   "QUES","XP Z1",0)
  1194   Y
  1195   "QUES","XP Z1","??")
  1196   ^D OPT^XPD H
  1197   "QUES","XP Z1","A")
  1198   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  1199   "QUES","XP Z1","B")
  1200   NO
  1201   "QUES","XP Z1","M")
  1202   D XPZ1^XPD IQ
  1203   "QUES","XP Z2",0)
  1204   Y
  1205   "QUES","XP Z2","??")
  1206   ^D RTN^XPD H
  1207   "QUES","XP Z2","A")
  1208   Want to MO VE routine s to other  CPUs
  1209   "QUES","XP Z2","B")
  1210   NO
  1211   "QUES","XP Z2","M")
  1212   D XPZ2^XPD IQ
  1213   "RTN")
  1214   17
  1215   "RTN","XPD E")
  1216   0^8^B49625 956
  1217   "RTN","XPD E",1,0)
  1218   XPDE ;SFIS C/RSD - Pa ckage Edit  ;06/24/20 08
  1219   "RTN","XPD E",2,0)
  1220    ;;8.0;KER NEL;**2,15 ,21,44,51, 68,131,182 ,201,229,3 02,399,507 ,539,603,6 72**;Jul 1 0, 1995;Bu ild 7
  1221   "RTN","XPD E",3,0)
  1222    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  1223   "RTN","XPD E",4,0)
  1224    Q
  1225   "RTN","XPD E",5,0)
  1226    ;these ta gs are cal led from o ptions.
  1227   "RTN","XPD E",6,0)
  1228   EDIT ;edit  Build fil e package
  1229   "RTN","XPD E",7,0)
  1230    N DA,DIR, DDSFILE,DR ,Y,Z
  1231   "RTN","XPD E",8,0)
  1232    Q:'$$DIC( "AEMQLZ"," ",1)  S DA =+Y
  1233   "RTN","XPD E",9,0)
  1234    I $P(Y,U, 3) D NEW(D A)
  1235   "RTN","XPD E",10,0)
  1236    S Z=$P(^X PD(9.6,DA, 0),U,3)+1, DR="["_$P( "XPD EDIT  BUILD^XPD  EDIT MP^XP D EDIT GP" ,U,Z)_"]", DDSFILE="^ XPD(9.6,"
  1237   "RTN","XPD E",11,0)
  1238    D ^DDS Q: '$G(DA)
  1239   "RTN","XPD E",12,0)
  1240    ;if full  DD, kill m ultiple fo r partial  DD
  1241   "RTN","XPD E",13,0)
  1242    S Y=0 F   S Y=$O(^XP D(9.6,DA,4 ,Y)) Q:'Y   S Z=$G(^( Y,222)) D
  1243   "RTN","XPD E",14,0)
  1244    .K:$P(Z,U ,3)="f" ^X PD(9.6,DA, 4,Y,2),^XP D(9.6,DA,4 ,"APDD",Y)
  1245   "RTN","XPD E",15,0)
  1246    D QUIT(DA )
  1247   "RTN","XPD E",16,0)
  1248    Q
  1249   "RTN","XPD E",17,0)
  1250   COPY ;copy  a Build f ile packag e
  1251   "RTN","XPD E",18,0)
  1252    N DA,DIK, DIR,FR,FR0 ,TO,TO0,X, Y,Z W !
  1253   "RTN","XPD E",19,0)
  1254    Q:'$$DIC( "QEAMZ","C opy FROM w hat Packag e: ")
  1255   "RTN","XPD E",20,0)
  1256    S FR=+Y,F R0=Y(0),Z= "QEAMZL",Z ("S")="I Y '="_FR
  1257   "RTN","XPD E",21,0)
  1258    I '$$DIC( .Z,"Copy T O what Pac kage: ") D  QUIT(FR)  Q
  1259   "RTN","XPD E",22,0)
  1260    S TO=Y,TO 0=Y(0)
  1261   "RTN","XPD E",23,0)
  1262    ;if this  is not new , then it  will be pu rged befor e copy.
  1263   "RTN","XPD E",24,0)
  1264    I '$P(TO, U,3) W !,$ P(TO0,U),"  package w ill be PUR GED before  the copy. "
  1265   "RTN","XPD E",25,0)
  1266    W ! S DIR (0)="Y",DI R("A")="OK  to contin ue",DIR("B ")="YES" D  ^DIR
  1267   "RTN","XPD E",26,0)
  1268    S DIK="^X PD(9.6,",D A=+TO
  1269   "RTN","XPD E",27,0)
  1270    I 'Y!$D(D IRUT) D  W  ! Q
  1271   "RTN","XPD E",28,0)
  1272    .;they di dn't want  to continu e, kill if  it was a  new packag e.
  1273   "RTN","XPD E",29,0)
  1274    .I $P(TO, U,3) D ^DI K W $P(TO0 ,U)," bein g deleted! "
  1275   "RTN","XPD E",30,0)
  1276    .;unlock  both packa ges
  1277   "RTN","XPD E",31,0)
  1278    .D QUIT(F R),QUIT(TO )
  1279   "RTN","XPD E",32,0)
  1280    D WAIT^DI CD
  1281   "RTN","XPD E",33,0)
  1282    ;if not n ew, kill o ld data
  1283   "RTN","XPD E",34,0)
  1284    K:'$P(TO, U,3) ^XPD( 9.6,DA)
  1285   "RTN","XPD E",35,0)
  1286    M ^XPD(9. 6,DA)=^XPD (9.6,FR) S  $P(^(DA,0 ),U)=$P(TO 0,U)
  1287   "RTN","XPD E",36,0)
  1288    D NEW(+TO )
  1289   "RTN","XPD E",37,0)
  1290    ;if new N ational Pa ckage name , then kil l x-ref
  1291   "RTN","XPD E",38,0)
  1292    I $P(TO0, U,2)]"",$P (FR0,U,2)' =$P(TO0,U, 2) K ^XPD( 9.6,"C",$E ($P(TO0,U, 2),1,30),D A) S DIK(1 )=1 D EN1^ DIK
  1293   "RTN","XPD E",39,0)
  1294    D QUIT(FR ),QUIT(TO)
  1295   "RTN","XPD E",40,0)
  1296    W "...Don e.",!
  1297   "RTN","XPD E",41,0)
  1298    Q
  1299   "RTN","XPD E",42,0)
  1300   BUILD ;bui ld package  from a na mespace
  1301   "RTN","XPD E",43,0)
  1302    N DIR,DIR UT,XPDA,XP DI,XPDF,XP DN,XPDX,XP DXL,X,X1,Y ,Y1 W !
  1303   "RTN","XPD E",44,0)
  1304    Q:'$$DIC( "QEAML")
  1305   "RTN","XPD E",45,0)
  1306    S XPDA=+Y  W !
  1307   "RTN","XPD E",46,0)
  1308    I $P(^XPD (9.6,XPDA, 0),U,3) W  !,"The Bui ld Type mu st be SING LE PACKAGE !!",! Q
  1309   "RTN","XPD E",47,0)
  1310    ;if not a  new packa ge
  1311   "RTN","XPD E",48,0)
  1312    I '$P(Y,U ,3) D  I $ D(DIRUT) D  QUIT(XPDA ) Q
  1313   "RTN","XPD E",49,0)
  1314    .S DIR(0) ="Y",DIR(" A")="Packa ge already  exists, W ant to PUR GE the exi sting data ",DIR("B") ="NO",DIR( "?")="YES  will delet e all the  KERNEL FIL E informat ion for th is package  in the BU ILD file."
  1315   "RTN","XPD E",50,0)
  1316    .D ^DIR K  DIR Q:'Y
  1317   "RTN","XPD E",51,0)
  1318    .S Y=0 F   S Y=$O(^X PD(9.6,XPD A,"KRN",Y) ) Q:'Y  K  ^(Y,"NM")
  1319   "RTN","XPD E",52,0)
  1320    E  D NEW( XPDA)
  1321   "RTN","XPD E",53,0)
  1322    ;XPDN(0=e xcluded na mes or 1=i nclude nam es, namesp ace)=""
  1323   "RTN","XPD E",54,0)
  1324    W ! S DIR (0)="FO^1: 15^K:X'?.1 ""-""1U.15 UNP X",DIR ("A")="Nam espace",DI R("?")="En ter 1 to 1 5 characte rs, precee d with ""- "" to excl ude namesp ace"
  1325   "RTN","XPD E",55,0)
  1326    F  D ^DIR  Q:$D(DIRU T)  S X=$E (Y,$L(Y))= "*",%=$E(Y )="-",XPDN ('%,$E(Y,% +1,$L(Y)-X ))=""
  1327   "RTN","XPD E",56,0)
  1328    I '$D(XPD N)!$D(DTOU T)!$D(DUOU T) D QUIT( XPDA) Q
  1329   "RTN","XPD E",57,0)
  1330    W !!,"NAM ESPACE  IN CLUDE",?35 ,"EXCLUDE" ,!,?11,"-- -----",?35 ,"-------"
  1331   "RTN","XPD E",58,0)
  1332    S (X,Y)=" ",(X1,Y1)= 1
  1333   "RTN","XPD E",59,0)
  1334    F  D  W ! ?11,X,?35, Y Q:'X1&'Y 1
  1335   "RTN","XPD E",60,0)
  1336    .S:X1 X=$ O(XPDN(1,X )),X1=X]""  S:Y1 Y=$O (XPDN(0,Y) ),Y1=Y]""
  1337   "RTN","XPD E",61,0)
  1338    S DIR(0)= "Y",DIR("A ")="OK to  continue", DIR("B")=" YES" D ^DI R
  1339   "RTN","XPD E",62,0)
  1340    I 'Y!$D(D IRUT) D QU IT(XPDA) Q
  1341   "RTN","XPD E",63,0)
  1342    D WAIT^DI CD S XPDX= "",XPDI("I EN")=0
  1343   "RTN","XPD E",64,0)
  1344    F  S XPDX =$O(XPDN(1 ,XPDX)),XP DXL=$L(XPD X),XPDF=0  Q:XPDX=""   D
  1345   "RTN","XPD E",65,0)
  1346    .F  S XPD F=$O(^XPD( 9.6,XPDA," KRN",XPDF) ) Q:'XPDF   D
  1347   "RTN","XPD E",66,0)
  1348    ..N XPD,X PDIC,XPDJ, XPCNT W ". "
  1349   "RTN","XPD E",67,0)
  1350    ..;XPDIC  is used in  $$SCR1^XP DET
  1351   "RTN","XPD E",68,0)
  1352    ..S XPDIC ="^XPD(9.6 ,"_XPDA_", ""KRN"","_ XPDF_",""N M"",",XPCN T=0
  1353   "RTN","XPD E",69,0)
  1354    ..D LIST^ DIC(XPDF," ","","","* ",.XPDI,XP DX,"","I $ E(^(0),1,X PDXL)=XPDX ,$$SCR1^XP DET(Y)")
  1355   "RTN","XPD E",70,0)
  1356    ..F XPDJ= 1:1 S X=$G (^TMP("DIL IST",$J,1, XPDJ)) Q:X =""  D
  1357   "RTN","XPD E",71,0)
  1358    ...S:XPDF <.404 %=^T MP("DILIST ",$J,2,XPD J)_",",X=$ $TX^XPDET( X,$$GET1^D IQ(XPDF,%, $$TF^XPDET (XPDF),"I" ))
  1359   "RTN","XPD E",72,0)
  1360    ...S Y="+ "_XPDJ_"," _XPDF_","_ XPDA_",",X PD(9.68,Y, .01)=X,XPD (9.68,Y,.0 3)=0
  1361   "RTN","XPD E",73,0)
  1362    ...;Keep  XPD from g etting too  big.
  1363   "RTN","XPD E",74,0)
  1364    ...S XPCN T=XPCNT+1  I XPCNT>10 0 D UPDATE ^DIE("","X PD") S XPC NT=0 K XPD
  1365   "RTN","XPD E",75,0)
  1366    ..Q:'$D(X PD)  D UPD ATE^DIE("" ,"XPD")
  1367   "RTN","XPD E",76,0)
  1368    D QUIT(XP DA)
  1369   "RTN","XPD E",77,0)
  1370    W "...Don e.",!
  1371   "RTN","XPD E",78,0)
  1372    Q
  1373   "RTN","XPD E",79,0)
  1374   VER ;verif y a Build  file packa ge
  1375   "RTN","XPD E",80,0)
  1376    N XPDA,Y
  1377   "RTN","XPD E",81,0)
  1378    Q:'$$DIC( "AEMQZ")   S XPDA=+Y
  1379   "RTN","XPD E",82,0)
  1380    D EN^XPDV
  1381   "RTN","XPD E",83,0)
  1382    Q
  1383   "RTN","XPD E",84,0)
  1384   DIC(DIC,A, XPDL) ;DIC  lookup to  Build fil e, 9.6
  1385   "RTN","XPD E",85,0)
  1386    N DLAYGO
  1387   "RTN","XPD E",86,0)
  1388    S DIC(0)= $G(DIC),DI C="^XPD(9. 6," S:$G(A )]"" DIC(" A")=A
  1389   "RTN","XPD E",87,0)
  1390    S:DIC(0)[ "L" DLAYGO =9.6,DIC(" DR")="1;2/ /SINGLE PA CKAGE;5//Y ES"
  1391   "RTN","XPD E",88,0)
  1392    D ^DIC Q: Y<0 0
  1393   "RTN","XPD E",89,0)
  1394    I '$G(XPD L) L +^XPD (9.6,+Y):0  E  W !,"B eing acces sed by ano ther user"  Q 0
  1395   "RTN","XPD E",90,0)
  1396    Q +Y
  1397   "RTN","XPD E",91,0)
  1398    ;
  1399   "RTN","XPD E",92,0)
  1400   NEW(DA) ;c reate Kern el Files m ultiple fo r package  DA
  1401   "RTN","XPD E",93,0)
  1402    N I,J,X,X PDNEWF,XPD ,XPDI
  1403   "RTN","XPD E",94,0)
  1404    S:'$D(^XP D(9.6,DA," KRN",0)) ^ XPD(9.6,DA ,"KRN",0)= U_$P(^DD(9 .6,7,0),U, 2)
  1405   "RTN","XPD E",95,0)
  1406    S I=0
  1407   "RTN","XPD E",96,0)
  1408    F J=1:1 S  X=+$P($T( FILES+J)," ;;",2) Q:' X  S:$D(^D D(X))&'$D( ^XPD(9.6,D A,"KRN",X) ) I=I+1,(X PDI(I),XPD (9.67,"+"_ I_","_DA_" ,",.01))=X
  1409   "RTN","XPD E",97,0)
  1410    Q:'$D(XPD )
  1411   "RTN","XPD E",98,0)
  1412    ;XPDNEWF  is a flag  in INPUT t ransform o f BUILD CO MPONENT mu ltiple
  1413   "RTN","XPD E",99,0)
  1414    S XPDNEWF =1
  1415   "RTN","XPD E",100,0)
  1416    D UPDATE^ DIE("","XP D","XPDI")
  1417   "RTN","XPD E",101,0)
  1418    Q
  1419   "RTN","XPD E",102,0)
  1420   QUIT(Y) ;u nlock Y
  1421   "RTN","XPD E",103,0)
  1422    L -^XPD(9 .6,Y)
  1423   "RTN","XPD E",104,0)
  1424    Q
  1425   "RTN","XPD E",105,0)
  1426    ;
  1427   "RTN","XPD E",106,0)
  1428    ;;file;in stall orde r;x-ref;fi le build;e ntry build ;file pre; entry pre; file post; entry post ;delete
  1429   "RTN","XPD E",107,0)
  1430    ;You must  put in co de to dele te anythin g
  1431   "RTN","XPD E",108,0)
  1432   FILES ;ker nel files  for field  7 in file  9.6
  1433   "RTN","XPD E",109,0)
  1434    ;;9.8;;1; RTNF^XPDTA ;RTNE^XPDT A
  1435   "RTN","XPD E",110,0)
  1436    ;;9.2;1;; ;HELP^XPDT A1;HLPF1^X PDIA1;HLPE 1^XPDIA1;H LPF2^XPDIA 1;;HLPDEL^ XPDIA1
  1437   "RTN","XPD E",111,0)
  1438    ;;3.6;2;1 ;;BUL^XPDT A1;;BULE1^ XPDIA1;;;B ULDEL^XPDI A1
  1439   "RTN","XPD E",112,0)
  1440    ;;19.1;3; ;;KEY^XPDT A1;KEYF1^X PDIA1;KEYE 1^XPDIA1;K EYF2^XPDIA 1;;KEYDEL^ XPDIA1
  1441   "RTN","XPD E",113,0)
  1442    ;;.5;4;;; EDEOUT^DIF ROMSO(.5,D A,"",XPDA) ;FPRE^DIFR OMSI(.5,"" ,XPDA);EPR E^DIFROMSI (.5,DA,"", XPDA,"",OL DA);;EPOST ^DIFROMSI( .5,DA,"",X PDA)
  1443   "RTN","XPD E",114,0)
  1444    ;;.4;5;;; EDEOUT^DIF ROMSO(.4,D A,"",XPDA) ;FPRE^DIFR OMSI(.4,"" ,XPDA);EPR E^DIFROMSI (.4,DA,$E( "N",$G(XPD NEW)),XPDA ,"",OLDA); ;EPOST^DIF ROMSI(.4,D A,"",XPDA) ;DEL^DIFRO MSK(.4,"", %)
  1445   "RTN","XPD E",115,0)
  1446    ;;.401;6; ;;EDEOUT^D IFROMSO(.4 01,DA,"",X PDA);FPRE^ DIFROMSI(. 401,"",XPD A);EPRE^DI FROMSI(.40 1,DA,$E("N ",$G(XPDNE W)),XPDA," ",OLDA);;E POST^DIFRO MSI(.401,D A,"",XPDA) ;DEL^DIFRO MSK(.401," ",%)
  1447   "RTN","XPD E",116,0)
  1448    ;;.402;7; ;;EDEOUT^D IFROMSO(.4 02,DA,"",X PDA);FPRE^ DIFROMSI(. 402,"",XPD A);EPRE^DI FROMSI(.40 2,DA,$E("N ",$G(XPDNE W)),XPDA," ",OLDA);;E POST^DIFRO MSI(.402,D A,"",XPDA) ;DEL^DIFRO MSK(.402," ",%)
  1449   "RTN","XPD E",117,0)
  1450    ;;.403;8; ;;EDEOUT^D IFROMSO(.4 03,DA,"",X PDA);FPRE^ DIFROMSI(. 403,"",XPD A);EPRE^DI FROMSI(.40 3,DA,$E("N ",$G(XPDNE W)),XPDA," ",OLDA);;E POST^DIFRO MSI(.403,D A,"",XPDA) ;DEL^DIFRO MSK(.403," ",%)
  1451   "RTN","XPD E",118,0)
  1452    ;;.84;9;; ;EDEOUT^DI FROMSO(.84 ,DA,"",XPD A);FPRE^DI FROMSI(.84 ,"",XPDA); EPRE^DIFRO MSI(.84,DA ,$E("N",$G (XPDNEW)), XPDA,"",OL DA);;EPOST ^DIFROMSI( .84,DA,"", XPDA);DEL^ DIFROMSK(. 84,"",%)
  1453   "RTN","XPD E",119,0)
  1454    ;;3.8;11; ;;MAILG^XP DTA1;MAILG F1^XPDIA1; MAILGE1^XP DIA1;MAILG F2^XPDIA1; ;MAILGDEL^ XPDIA1(%)
  1455   "RTN","XPD E",120,0)
  1456    ;;870;13; 1;;HLLL^XP DTA1;;HLLL E^XPDIA1;; ;HLLLDEL^X PDIA1(%)
  1457   "RTN","XPD E",121,0)
  1458    ;;771;14; ;;HLAP^XPD TA1;HLAPF1 ^XPDIA1;HL APE1^XPDIA 1;HLAPF2^X PDIA1;;HLA PDEL^XPDIA 1(%)
  1459   "RTN","XPD E",122,0)
  1460    ;;101;15; ;;PRO^XPDT A;PROF1^XP DIA;PROE1^ XPDIA;PROF 2^XPDIA;;P RODEL^XPDI A
  1461   "RTN","XPD E",123,0)
  1462    ;;8994;16 ;1;;;;RPCE 1^XPDIA1;; ;RPCDEL^XP DIA1
  1463   "RTN","XPD E",124,0)
  1464    ;;409.61; 17;1;;;;LM E1^XPDIA1; ;;LMDEL^XP DIA1
  1465   "RTN","XPD E",125,0)
  1466    ;;19;18;; ;OPT^XPDTA ;OPTF1^XPD IA;OPTE1^X PDIA;OPTF2 ^XPDIA;;OP TDEL^XPDIA
  1467   "RTN","XPD E",126,0)
  1468    ;;8994.2; 19;1;;;;CR C32PE^XPDI A1;;;CRC32 DEL^XPDIA1
  1469   "RTN","XPD E",127,0)
  1470    ;;8989.51 ;20;;;PAR1 E1^XPDTA2; PAR1F1^XPD IA3;PAR1E1 ^XPDIA3;PA R1F2^XPDIA 3;;PAR1DEL ^XPDIA3(%)
  1471   "RTN","XPD E",128,0)
  1472    ;;8989.52 ;21;1;;PAR 2E1^XPDTA2 ;PAR2F1^XP DIA3;PAR2E 1^XPDIA3;P AR2F2^XPDI A3;;PAR2DE L^XPDIA3(% )
  1473   "RTN","XPD E",129,0)
  1474    ;;779.2;2 2;1;;HLOAP ^XPDTA1;;H LOE^XPDIA1 ;;;
  1475   "RTN","XPD E",130,0)
  1476    ;;8993;23 ;1;;XULM^X PDTA2;;XUL M^XPDIA3;; ;
  1477   "RTN","XPD E",131,0)
  1478    ;;9002226 ;24;1;;BLD ^XPDIHS;BL D1^XPDIHS; BLD^XPDIHS ;BLD1^XPDI HS;;BLD^XP DIHS
  1479   "RTN","XPD E",132,0)
  1480    ;;1.62;25 ;;;;;POLFE 1^XPDIA0;; ;POLFDEL^X PDIA0(%)
  1481   "RTN","XPD E",133,0)
  1482    ;;1.6;26; ;;POL^XPDT A2;POLF1^X PDIA0;POLE 1^XPDIA0;P OLF2^XPDIA 0;POLE2^XP DIA0;POLDE L^XPDIA0(% )
  1483   "RTN","XPD E",134,0)
  1484    ;;1.61;27 ;1;;POLE^X PDTA2;;POL EE1^XPDIA0 ;;;POLEDEL ^XPDIA0(%)
  1485   "RTN","XPD E",135,0)
  1486    ;;1.5;28; 1;;ENT^XPD TA2;ENTF1^ XPDIA0;ENT E1^XPDIA0; ENTF2^XPDI A0;;ENTDEL ^XPDIA0(%)
  1487   "RTN","XPD ET")
  1488   0^10^B3652 8246
  1489   "RTN","XPD ET",1,0)
  1490   XPDET ;SFI SC/RSD - I nput tranf orms & hel p for file  9.6 & 9.7  ;10/19/20 02
  1491   "RTN","XPD ET",2,0)
  1492    ;;8.0;KER NEL;**15,3 9,41,44,51 ,58,66,137 ,229,393,5 39,603,672 **;Jul 10,  1995;Buil d 7
  1493   "RTN","XPD ET",3,0)
  1494    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  1495   "RTN","XPD ET",4,0)
  1496    Q
  1497   "RTN","XPD ET",5,0)
  1498   INPUTB(X)  ;input tra nfrom for  NAME in BU ILD file
  1499   "RTN","XPD ET",6,0)
  1500    ;X=user i nput
  1501   "RTN","XPD ET",7,0)
  1502    ;name mus t be uniqu e
  1503   "RTN","XPD ET",8,0)
  1504    I $L(X)>5 0!($L(X)<3 )!$D(^XPD( 9.6,"B",X) ) K X Q
  1505   "RTN","XPD ET",9,0)
  1506    I X["*" K :$P(X,"*", 2,3)'?1.2N 1"."1.2N.1 (1"V",1"T" ).2N1"*"1. 6N X Q
  1507   "RTN","XPD ET",10,0)
  1508    S %=$L(X, " ") I %<2  K X Q
  1509   "RTN","XPD ET",11,0)
  1510    S %=$P(X, " ",%) K:% '?1.2N1"." 1.2N.1(1"V ",1"T",1"B ").2N X
  1511   "RTN","XPD ET",12,0)
  1512    Q
  1513   "RTN","XPD ET",13,0)
  1514   INPUTE(X)  ;input tra nsform for  ENTRIES i n KERNEL F ILES multi ple
  1515   "RTN","XPD ET",14,0)
  1516    ;X=user i nput
  1517   "RTN","XPD ET",15,0)
  1518    N D,DD,DI C,DICR,DIX ,DIY,DS,DO ,XPDLK,Y
  1519   "RTN","XPD ET",16,0)
  1520    S XPDLK=$ $GR(D1)
  1521   "RTN","XPD ET",17,0)
  1522    I XPDLK=" "!X["*" K  X Q
  1523   "RTN","XPD ET",18,0)
  1524    S DIC(0)= "QEMZ",DIC =XPDLK
  1525   "RTN","XPD ET",19,0)
  1526    S:D1=9.8  DIC("S")=" I $T(^@$P( ^(0),U))]" """"
  1527   "RTN","XPD ET",20,0)
  1528    D ^DIC K: Y<0 X Q:'$ D(X)
  1529   "RTN","XPD ET",21,0)
  1530    S X=Y(0,0 )
  1531   "RTN","XPD ET",22,0)
  1532    ;check th at this do esn't exis t already
  1533   "RTN","XPD ET",23,0)
  1534    I $D(^XPD (9.6,D0,"K RN",D1,"NM ","B",X))  K X Q
  1535   "RTN","XPD ET",24,0)
  1536    ;if fm fi le, change  X to cont ain file #  of templa te
  1537   "RTN","XPD ET",25,0)
  1538    I D1<.404  S X=$$TX( X,$P(Y(0), U,$S(D1=.4 03:8,1:4)) )
  1539   "RTN","XPD ET",26,0)
  1540    ;POLICY F UNCTION fi le #1.62,  entries be low 1000 b elong to F ileMan
  1541   "RTN","XPD ET",27,0)
  1542    I D1=1.62  K:Y<1000  X
  1543   "RTN","XPD ET",28,0)
  1544    Q
  1545   "RTN","XPD ET",29,0)
  1546   GLOBALE(X)  ;input tr ansform fo r GLOBAL m ultiple .0 1 field in  file 9.6
  1547   "RTN","XPD ET",30,0)
  1548    I $L(X)>3 0!($L(X)<2 ) K X Q
  1549   "RTN","XPD ET",31,0)
  1550    I X["(",X '[")" K X  Q
  1551   "RTN","XPD ET",32,0)
  1552    ;change '  back to "  for subsc ripts, the y were cha nged in th e Pre-Look up node of  the DD, 7 .5. This w as done to  trick FM,  which doe sn't allow  " in .01  fields
  1553   "RTN","XPD ET",33,0)
  1554    S X=$TR(X ,"'","""")
  1555   "RTN","XPD ET",34,0)
  1556    I '$D(@(" ^"_X)) K X
  1557   "RTN","XPD ET",35,0)
  1558    Q
  1559   "RTN","XPD ET",36,0)
  1560   INPUTMB(X)  ;input tr ansform fo r field 10  and 11 in  file 9.6
  1561   "RTN","XPD ET",37,0)
  1562    ;X=user i nput
  1563   "RTN","XPD ET",38,0)
  1564    N D,DD,DI C,DICR,DIX ,DIY,DS,DO ,Y
  1565   "RTN","XPD ET",39,0)
  1566    ;can't se lect a glo bal or mul ti package  or itself  (D0)
  1567   "RTN","XPD ET",40,0)
  1568    S DIC(0)= "QEMZ",DIC ="^XPD(9.6 ,",DIC("S" )="I '$P(^ (0),U,3),Y '="_D0
  1569   "RTN","XPD ET",41,0)
  1570    D ^DIC K: Y<0 X Q:'$ D(X)
  1571   "RTN","XPD ET",42,0)
  1572    S X=Y(0,0 )
  1573   "RTN","XPD ET",43,0)
  1574    Q
  1575   "RTN","XPD ET",44,0)
  1576   LOOKE(X) ; special lo okup for E NTRIES in  KERNEL FIL ES multipl e
  1577   "RTN","XPD ET",45,0)
  1578    Q:X'?1.E1 "*"
  1579   "RTN","XPD ET",46,0)
  1580    N %,XPD,X PDI,XPDIC, XPDF,XPDLK ,XPDX,Y
  1581   "RTN","XPD ET",47,0)
  1582    S XPDLK=$ $GR(D1),XP DIC=DIC,XP DF=D1
  1583   "RTN","XPD ET",48,0)
  1584    I XPDLK=" " K X Q
  1585   "RTN","XPD ET",49,0)
  1586    G:$E(X)=" -" DEL
  1587   "RTN","XPD ET",50,0)
  1588    S XPDX=$P (X,"*"),XP DI("IEN")= 0
  1589   "RTN","XPD ET",51,0)
  1590    D LIST^DI C(D1,"","@ ;.01",""," *",.XPDI,X PDX,"","I  $$SCR^XPDE T(Y)")
  1591   "RTN","XPD ET",52,0)
  1592    I '$G(^TM P("DILIST" ,$J,0)) K  X Q
  1593   "RTN","XPD ET",53,0)
  1594    K ^TMP("X PDX",$J)
  1595   "RTN","XPD ET",54,0)
  1596    ;loop thr u list fro m lister a nd file us ing UPDATE ^DIE
  1597   "RTN","XPD ET",55,0)
  1598    F XPDI=1: 1 S X=$G(^ TMP("DILIS T",$J,"ID" ,XPDI,.01) ) Q:X=""   D
  1599   "RTN","XPD ET",56,0)
  1600    .;FM temp late will  have file  # associat ed with th e template  name
  1601   "RTN","XPD ET",57,0)
  1602    .S:D1<.40 4 %=^TMP(" DILIST",$J ,2,XPDI)_" ,",X=$$TX( X,$$GET1^D IQ(D1,%,$$ TF(D1),"I" ))
  1603   "RTN","XPD ET",58,0)
  1604    .;Lock Te mplate, #8 993, need  to remove  leading "^ " if there
  1605   "RTN","XPD ET",59,0)
  1606    .S:D1=899 3&($E(X)=" ^") X=$P(X ,"^",2)
  1607   "RTN","XPD ET",60,0)
  1608    .S Y="+"_ XPDI_","_D 1_","_D0_" ,",^TMP("X PDX",$J,9. 68,Y,.01)= X,^(.03)=0
  1609   "RTN","XPD ET",61,0)
  1610    I $D(^TMP ("XPDX",$J )) D UPDAT E^DIE(""," ^TMP(""XPD X"",$J)"," ^TMP(""XPD "",$J)")
  1611   "RTN","XPD ET",62,0)
  1612    ;if in Sc reenman th en call ML OAD to upd ate screen
  1613   "RTN","XPD ET",63,0)
  1614    I $D(DDS) ,$D(^TMP(" XPD",$J))  D MLOAD^DD SUTL("^TMP (""XPD"",$ J)")
  1615   "RTN","XPD ET",64,0)
  1616    S X=""
  1617   "RTN","XPD ET",65,0)
  1618    K ^TMP("X PDX",$J),^ TMP("XPD", $J)
  1619   "RTN","XPD ET",66,0)
  1620    Q
  1621   "RTN","XPD ET",67,0)
  1622   DEL ;delet e using wi ld card
  1623   "RTN","XPD ET",68,0)
  1624    I X'?1"-" 1.E1"*" K  X Q
  1625   "RTN","XPD ET",69,0)
  1626    S X=$E(X, 2,$L(X)-1) ,XPDX=X S: $L(X) XPDI ("IEN")=0
  1627   "RTN","XPD ET",70,0)
  1628    D LIST^DI C(9.68,"," _D1_","_D0 _",","","" ,"*",.XPDI ,XPDX)
  1629   "RTN","XPD ET",71,0)
  1630    I '$G(^TM P("DILIST" ,$J,0)) K  X Q
  1631   "RTN","XPD ET",72,0)
  1632    N DIK,DA, D2
  1633   "RTN","XPD ET",73,0)
  1634    S DIK=XPD IC,DA(1)=D 1,DA(2)=D0
  1635   "RTN","XPD ET",74,0)
  1636    F XPDI=1: 1 S (DA,D2 )=$G(^TMP( "DILIST",$ J,2,XPDI))  Q:'DA  D
  1637   "RTN","XPD ET",75,0)
  1638    .D ^DIK
  1639   "RTN","XPD ET",76,0)
  1640    I $D(DDS)  D MDEL^DD SUTL("^TMP (""DILIST" ",$J,2)")
  1641   "RTN","XPD ET",77,0)
  1642    S X=""
  1643   "RTN","XPD ET",78,0)
  1644    K ^TMP("D ILIST",$J)
  1645   "RTN","XPD ET",79,0)
  1646    Q
  1647   "RTN","XPD ET",80,0)
  1648   HELP ;exec utable hel p of ENTRI ES in KERN EL FILE mu ltiple
  1649   "RTN","XPD ET",81,0)
  1650    N D,DIC,D IE,DIX,DIY ,DO,DZ,DS, X,Y
  1651   "RTN","XPD ET",82,0)
  1652    ;file 9.8  is routin e file, ch eck that r outine exi sts
  1653   "RTN","XPD ET",83,0)
  1654    S DIC=$$G R(D1),DIC( 0)="M",X=" ??" Q:DIC= ""  S:D1=9 .8 DIC("S" )="I $T(^@ $P(^(0),U) )]"""""
  1655   "RTN","XPD ET",84,0)
  1656    D ^DIC Q
  1657   "RTN","XPD ET",85,0)
  1658    ;
  1659   "RTN","XPD ET",86,0)
  1660   HELPO ;exe cutable he lp of INST ALL ORDER  in KERNEL  FILES mult iple
  1661   "RTN","XPD ET",87,0)
  1662    N Y
  1663   "RTN","XPD ET",88,0)
  1664    W !,"Numb ers in use :  ORDER      FILE#"  S Y=0
  1665   "RTN","XPD ET",89,0)
  1666    F  S Y=$O (^XPD(9.6, D0,"KRN"," AC",Y)) Q: 'Y  W !,?1 8,$J(Y,2), ?28,$O(^(Y ,0))
  1667   "RTN","XPD ET",90,0)
  1668    W ! Q
  1669   "RTN","XPD ET",91,0)
  1670    ;
  1671   "RTN","XPD ET",92,0)
  1672   HELPMB ;ex ecutable h elp of fie lds 10 & 1 1 in file  9.6
  1673   "RTN","XPD ET",93,0)
  1674    N D,DIC,D IE,DIX,DIY ,DO,DZ,DS, X,Y
  1675   "RTN","XPD ET",94,0)
  1676    S DIC="^X PD(9.6,",D IC(0)="M", X="??",DIC ("S")="I ' $P(^(0),U, 3),Y'="_D0
  1677   "RTN","XPD ET",95,0)
  1678    D ^DIC Q
  1679   "RTN","XPD ET",96,0)
  1680    ;
  1681   "RTN","XPD ET",97,0)
  1682   SCRA(Y) ;s creen of A CTION fiel d in ENTRI ES multipl e in KERNE L FILES mu ltiple, Y= action
  1683   "RTN","XPD ET",98,0)
  1684    ;Y=0 - se nd, 1 - de lete, 2 -  link, 3 -  merge, 4 -  attach, 5  - disable
  1685   "RTN","XPD ET",99,0)
  1686    ;all entr ies can se nd to site
  1687   "RTN","XPD ET",100,0)
  1688    ;D0=Build  ien, D1=F ile #, D2= record #
  1689   "RTN","XPD ET",101,0)
  1690    Q:'Y 1
  1691   "RTN","XPD ET",102,0)
  1692    ;.5=funct ion file,  can't dele te, all ot hers can
  1693   "RTN","XPD ET",103,0)
  1694    I Y=1 Q ( D1'=.5)
  1695   "RTN","XPD ET",104,0)
  1696    ;then res t of code  check if i t is a Opt ion, Proto cal, and P olicy and  can have M ENU ITEMS
  1697   "RTN","XPD ET",105,0)
  1698    Q:D1'=19& (D1'=101)& (D1'=1.6)  0
  1699   "RTN","XPD ET",106,0)
  1700    ;only Opt ions and P rotocol ca n disable,  Policy ca n't
  1701   "RTN","XPD ET",107,0)
  1702    I Y=5 Q ( D1'=1.6)
  1703   "RTN","XPD ET",108,0)
  1704    N FGR,X,X PDF,XPDT,X PDY,XPDZ
  1705   "RTN","XPD ET",109,0)
  1706    ;get X=na me, FGR=gl obal refer ence, XPDF =file #
  1707   "RTN","XPD ET",110,0)
  1708    S XPDY=Y, XPDF=D1,X= $P(^XPD(9. 6,D0,"KRN" ,D1,"NM",D 2,0),U),FG R=$$FILE^X PDV(D1)
  1709   "RTN","XPD ET",111,0)
  1710    Q:X="" 0
  1711   "RTN","XPD ET",112,0)
  1712    ;X=ien of  protocol,  option, o r policy
  1713   "RTN","XPD ET",113,0)
  1714    S X=+$O(@ FGR@("B",X ,0)) Q:'X  0
  1715   "RTN","XPD ET",114,0)
  1716    ;get type
  1717   "RTN","XPD ET",115,0)
  1718    S XPDT=$S (XPDF=1.6: $P($G(@FGR @(X,0)),U, 2),1:$P($G (@FGR@(X,0 )),U,4))
  1719   "RTN","XPD ET",116,0)
  1720    ;Policy;  Type=Rule  only send  & delete
  1721   "RTN","XPD ET",117,0)
  1722    I XPDF=1. 6,XPDT="R"  Q (XPDY<2 )
  1723   "RTN","XPD ET",118,0)
  1724    ;Policy;  Type=Set o r Policy,  if Members  then okay , else all ow only se nd & delet e
  1725   "RTN","XPD ET",119,0)
  1726    I XPDF=1. 6,XPDT'="R " Q:$O(@FG R@(X,10,0) ) 1 Q (XPD Y<2)
  1727   "RTN","XPD ET",120,0)
  1728    ;all Opti ons and Pr otocols, e xcept Even t Drivers,  can be at tached
  1729   "RTN","XPD ET",121,0)
  1730    I XPDY=4  Q '(XPDF=1 01&(XPDT=" E"))
  1731   "RTN","XPD ET",122,0)
  1732    ;Protocol  and Type  is Subscri ber can't  do anythin g else
  1733   "RTN","XPD ET",123,0)
  1734    I XPDF=10 1,XPDT="S"  Q 0
  1735   "RTN","XPD ET",124,0)
  1736    ;if it ha s SUBSCRIB ERS, node  775 then o k
  1737   "RTN","XPD ET",125,0)
  1738    I $O(@FGR @(X,775,0) ) Q 1
  1739   "RTN","XPD ET",126,0)
  1740    ;if type  is menu,po tocol,prot ocol menu, limited,ex tended,win dow suite
  1741   "RTN","XPD ET",127,0)
  1742    I "MOQLXZ "[XPDT Q 1
  1743   "RTN","XPD ET",128,0)
  1744    ;if it ha s ITEMs, n ode 10 the n ok
  1745   "RTN","XPD ET",129,0)
  1746    I $O(@FGR @(X,10,0))  Q 1
  1747   "RTN","XPD ET",130,0)
  1748    Q 0
  1749   "RTN","XPD ET",131,0)
  1750    ;
  1751   "RTN","XPD ET",132,0)
  1752    ;only Fil eman templ ates need  to know wh at file th ey are ass ociated wi th.
  1753   "RTN","XPD ET",133,0)
  1754    ;this val ue is also  triggered  to field  .02 in the  DD.
  1755   "RTN","XPD ET",134,0)
  1756   TX(X,Y) ;X =template  name, Y=fi le #
  1757   "RTN","XPD ET",135,0)
  1758    Q X_"     FILE #"_Y
  1759   "RTN","XPD ET",136,0)
  1760    ;
  1761   "RTN","XPD ET",137,0)
  1762   TF(F) ;F=f ile, retur n field of  file# for  templates
  1763   "RTN","XPD ET",138,0)
  1764    Q $S(F>.4 03:"",F<.4 03:4,1:7)
  1765   "RTN","XPD ET",139,0)
  1766    ;
  1767   "RTN","XPD ET",140,0)
  1768   GR(X) Q $G (^DIC(X,0, "GL"))
  1769   "RTN","XPD ET",141,0)
  1770    ;
  1771   "RTN","XPD ET",142,0)
  1772    ;screens  checks tha t X is not  already i n the ENTR IES multip le
  1773   "RTN","XPD ET",143,0)
  1774   SCR(Y) ;sc reen logic  for ENTRI ES multipl e in file  9.6
  1775   "RTN","XPD ET",144,0)
  1776    N %,X,Z
  1777   "RTN","XPD ET",145,0)
  1778    S Z=^(0), X=$P(Z,U)
  1779   "RTN","XPD ET",146,0)
  1780    ;FM files  are less  than .44
  1781   "RTN","XPD ET",147,0)
  1782    I XPDF<.4 4 D  Q:X=" " 0
  1783   "RTN","XPD ET",148,0)
  1784    .S %=$S(X PDF=.403:$ P(Z,U,8),1 :$P(Z,U,4) ),X=X_"     FILE #"_%
  1785   "RTN","XPD ET",149,0)
  1786    .S:XPDF'= .403&($P(Z ,U,8)>2) % =0 S:'% X= ""
  1787   "RTN","XPD ET",150,0)
  1788    ;routine  must exist  and must  be type 'R '
  1789   "RTN","XPD ET",151,0)
  1790    I XPDF=9. 8 Q:$T(^@X )=""!($P(Z ,U,2)'="R" ) 0
  1791   "RTN","XPD ET",152,0)
  1792    Q '$D(@(X PDIC_"""B" ",X)"))
  1793   "RTN","XPD ET",153,0)
  1794    ;
  1795   "RTN","XPD ET",154,0)
  1796    ;screen c hecks that  X is not  in the exc lude list,  XPDN(0)
  1797   "RTN","XPD ET",155,0)
  1798   SCR1(Y) ;s creen logi c for excl ude list
  1799   "RTN","XPD ET",156,0)
  1800    N %,X
  1801   "RTN","XPD ET",157,0)
  1802    ;if name  X is in th e exclude  list, XPDN (0,X), the n fail
  1803   "RTN","XPD ET",158,0)
  1804    S Y(0)=^( 0),X=$P(Y( 0),U) Q:$D (XPDN(0,X) ) 0
  1805   "RTN","XPD ET",159,0)
  1806    ;check if  X is refe red in the  namespace  by check  the subscr ipt
  1807   "RTN","XPD ET",160,0)
  1808    ;before X , if sub e xist and $ P(X,sub)=" " then it  is part of  the
  1809   "RTN","XPD ET",161,0)
  1810    ;namespac e, fail an d return 0
  1811   "RTN","XPD ET",162,0)
  1812    S %=$O(XP DN(0,X),-1 ) I $L(%)  Q:$P(X,%)= "" 0
  1813   "RTN","XPD ET",163,0)
  1814    Q $$SCR(. Y)
  1815   "RTN","XPD ET",164,0)
  1816    ;
  1817   "RTN","XPD ET",165,0)
  1818    ;screen o n PACKAGE  LINK field  in file 9 .6,
  1819   "RTN","XPD ET",166,0)
  1820   PCK(Y) ;ch eck Packag e File nam e, Y=ien i n package  file
  1821   "RTN","XPD ET",167,0)
  1822    N %,Y,Z
  1823   "RTN","XPD ET",168,0)
  1824    S Z=^(0)
  1825   "RTN","XPD ET",169,0)
  1826    ;DA is un def when y ou are add ing a new  Build with out a vers ion number
  1827   "RTN","XPD ET",170,0)
  1828    Q:'$D(^XP D(9.6,+$G( DA),0)) 1
  1829   "RTN","XPD ET",171,0)
  1830    S Y=$L($P (Z,U)),%=$ P(^XPD(9.6 ,DA,0),U), %=$$PKG^XP DUTL(%)
  1831   "RTN","XPD ET",172,0)
  1832    Q $P(Z,U) =$E(%,1,Y) !($P(Z,U,2 )=%)
  1833   "RTN","XPD ET",173,0)
  1834   VOLE(X) ;i nput trans form for V OLUME SET  multiple i n INSTALL  file
  1835   "RTN","XPD ET",174,0)
  1836    ;X=user i nput
  1837   "RTN","XPD ET",175,0)
  1838    N D,DD,DI C,DICR,DIX ,DIY,DO,DS ,XPD,Y,%
  1839   "RTN","XPD ET",176,0)
  1840    ;(0;11)=S IGNON/PROD UCTION
  1841   "RTN","XPD ET",177,0)
  1842    S DIC(0)= "QEMZ",DIC ="^%ZIS(14 .5,",DIC(" S")="I $P( ^(0),U,11) "
  1843   "RTN","XPD ET",178,0)
  1844    D ^DIC K: Y<0 X Q:'$ D(X)
  1845   "RTN","XPD ET",179,0)
  1846    S X=Y(0,0 )
  1847   "RTN","XPD ET",180,0)
  1848    Q
  1849   "RTN","XPD ET",181,0)
  1850   VOLH ;exec utable hel p for VOLU ME SET mul tiple in I NSTALL fil e
  1851   "RTN","XPD ET",182,0)
  1852    N D,DD,DI C,DIE,DIX, DIY,DO,DS, DZ,X,Y,%
  1853   "RTN","XPD ET",183,0)
  1854    S X="??", DIC(0)="QE MZ",DIC="^ %ZIS(14.5, ",DIC("S") ="I $P(^(0 ),U,11)"
  1855   "RTN","XPD ET",184,0)
  1856    D ^DIC
  1857   "RTN","XPD ET",185,0)
  1858    Q
  1859   "RTN","XPD ET",186,0)
  1860   ID97 ;iden tifier for  Install f ile
  1861   "RTN","XPD ET",187,0)
  1862    N XPDET,X PD,XPD0,XP D1,XPD2,XP D9
  1863   "RTN","XPD ET",188,0)
  1864    S XPD0=$G (^(0)),XPD 1=$G(^(1)) ,XPD2=$G(^ (2)),XPD9= $P(XPD0,U, 9),XPD=""  Q:XPD9=""
  1865   "RTN","XPD ET",189,0)
  1866    D
  1867   "RTN","XPD ET",190,0)
  1868    .;Loaded,  get DATE  LOADED
  1869   "RTN","XPD ET",191,0)
  1870    .I 'XPD9  S XPD=$$FM TE^XLFDT($ P(XPD0,U,3 ),2) Q
  1871   "RTN","XPD ET",192,0)
  1872    .Q:XPD9>4
  1873   "RTN","XPD ET",193,0)
  1874    .;Started , get INST ALL START  TIME
  1875   "RTN","XPD ET",194,0)
  1876    .I XPD9=2  S XPD=$$F MTE^XLFDT( $P(XPD1,U) ,2) Q
  1877   "RTN","XPD ET",195,0)
  1878    .;Complet ed or De-I nstalled,  get INSTAL L COMPLETE  TIME
  1879   "RTN","XPD ET",196,0)
  1880    .I XPD9>2  S XPD=$$F MTE^XLFDT( $P(XPD1,U, 3),2) Q
  1881   "RTN","XPD ET",197,0)
  1882    .;Queued,  get QUEUE D TASK NUM BER
  1883   "RTN","XPD ET",198,0)
  1884    .I XPD9=1  S XPD="#" _$P(XPD0,U ,6) Q
  1885   "RTN","XPD ET",199,0)
  1886    ;S XPDET( 1)="   "_$ $EXTERNAL^ DILFD(9.7, .02,"",XPD 9)_"  "_XP D,XPDET(1, "F")="?0"
  1887   "RTN","XPD ET",200,0)
  1888    S XPDET(1 )="  "_XPD ,XPDET(1," F")="?0"
  1889   "RTN","XPD ET",201,0)
  1890    S:XPD2]""  XPDET(2)= "=> "_$E(X PD2,1,70), XPDET(2,"F ")="!?5"
  1891   "RTN","XPD ET",202,0)
  1892    D EN^DDIO L(.XPDET)
  1893   "RTN","XPD ET",203,0)
  1894    Q
  1895   "RTN","XPD ET",204,0)
  1896    ;not bein g used rig ht now,
  1897   "RTN","XPD ET",205,0)
  1898   DEL97(Y) ; delete acc ess to fil e 9.7, 0-c an't delet e, 1-can
  1899   "RTN","XPD ET",206,0)
  1900    N %
  1901   "RTN","XPD ET",207,0)
  1902    S %=$P(^X PD(9.7,Y,0 ),U,9)
  1903   "RTN","XPD ET",208,0)
  1904    Q $S(%=3: 1,%=2:0,$D (^XPD(9.7, "ASP",Y,1, Y)):1,1:0)
  1905   "RTN","XPD ET",209,0)
  1906    ;
  1907   "RTN","XPD ET",210,0)
  1908   PAR964 ;Cl ear other  fields if  file is pa rtial.  Ca lled from  within for m
  1909   "RTN","XPD ET",211,0)
  1910    D PUT^DDS VAL(DIE,.D A,222.7,"n ","","I")  ;Send data  NO
  1911   "RTN","XPD ET",212,0)
  1912    D PUT^DDS VAL(DIE,.D A,222.5,"" ,"","I") ; Resolve po inter
  1913   "RTN","XPD ET",213,0)
  1914    D PUT^DDS VAL(DIE,.D A,222.8,"" ,"","I") ; Sites Data
  1915   "RTN","XPD ET",214,0)
  1916    D PUT^DDS VAL(DIE,.D A,222.9,"n ","","I")  ;User Over ride
  1917   "RTN","XPD ET",215,0)
  1918    D PUT^DDS VAL(DIE,.D A,224,""," ","I") ;Da ta Screen
  1919   "RTN","XPD ET",216,0)
  1920    Q
  1921   "RTN","XPD ET",217,0)
  1922    ;
  1923   "RTN","XPD IA")
  1924   0^16^B5777 5447
  1925   "RTN","XPD IA",1,0)
  1926   XPDIA ;SFI SC/RSD - I nstall Pre /Post Acti ons for Ke rnel Files  ;09/13/20 12
  1927   "RTN","XPD IA",2,0)
  1928    ;;8.0;KER NEL;**10,1 5,21,28,44 ,58,68,131 ,145,603,6 72**;Jul 1 0, 1995;Bu ild 7
  1929   "RTN","XPD IA",3,0)
  1930    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  1931   "RTN","XPD IA",4,0)
  1932    Q
  1933   "RTN","XPD IA",5,0)
  1934   OPTF1 ;opt ions file  pre
  1935   "RTN","XPD IA",6,0)
  1936    K ^TMP($J ,"XPD")
  1937   "RTN","XPD IA",7,0)
  1938    ;add Menu  Text duri ng a new r ecord
  1939   "RTN","XPD IA",8,0)
  1940    S XPDDR(1 )="$P(OLDA (0),U,2)"
  1941   "RTN","XPD IA",9,0)
  1942    Q
  1943   "RTN","XPD IA",10,0)
  1944    ;
  1945   "RTN","XPD IA",11,0)
  1946   OPTE1 ;opt ions entry  pre
  1947   "RTN","XPD IA",12,0)
  1948    N %,I
  1949   "RTN","XPD IA",13,0)
  1950    ;XPDFL= 0 -send,1-de lete,2-lin k,3-merge, 4-attach,5 -disable
  1951   "RTN","XPD IA",14,0)
  1952    ;attach &  disable n ever get h ere
  1953   "RTN","XPD IA",15,0)
  1954    S ^TMP($J ,"XPD",DA) =XPDFL
  1955   "RTN","XPD IA",16,0)
  1956    ;if Menu  linking or  merge sav e menu mul t. and pro cess in FP OS code
  1957   "RTN","XPD IA",17,0)
  1958    I XPDFL>1  M ^TMP($J ,"XPD",DA, 10)=^XTMP( "XPDI",XPD A,"KRN",19 ,OLDA,10)  K ^XTMP("X PDI",XPDA, "KRN",19,O LDA,10)
  1959   "RTN","XPD IA",18,0)
  1960    ;if Menu  link, XPDQ UIT preven ts data me rge
  1961   "RTN","XPD IA",19,0)
  1962    I XPDFL=2  S XPDQUIT =1 Q
  1963   "RTN","XPD IA",20,0)
  1964    ;if this  is new to  the site t hen disabl e and quit
  1965   "RTN","XPD IA",21,0)
  1966    I $G(XPDN EW) D:XPDS ET  Q
  1967   "RTN","XPD IA",22,0)
  1968    .;quit if  option al ready has  out of ord er msg.
  1969   "RTN","XPD IA",23,0)
  1970    .Q:$P(^XT MP("XPDI", XPDA,"KRN" ,19,OLDA,0 ),U,3)]""
  1971   "RTN","XPD IA",24,0)
  1972    .S $P(^XT MP("XPDI", XPDA,"KRN" ,19,OLDA,0 ),U,3)=$P( XPDSET,U,3 )
  1973   "RTN","XPD IA",25,0)
  1974    .D ADD^XQ OO1($P(XPD SET,U,2),1 9,DA)
  1975   "RTN","XPD IA",26,0)
  1976    S I=^XTMP ("XPDI",XP DA,"KRN",1 9,OLDA,0), %=^DIC(19, DA,0)
  1977   "RTN","XPD IA",27,0)
  1978    ;$P(%,U,3 )=out of o rder messa ge, keep s ending ooo  msg
  1979   "RTN","XPD IA",28,0)
  1980    S:$P(I,U, 3)="" $P(I ,U,3)=$P(% ,U,3)
  1981   "RTN","XPD IA",29,0)
  1982    ;if there  is no new  Security  Key, save  the old Ke y
  1983   "RTN","XPD IA",30,0)
  1984    S:$P(I,U, 6)="" $P(I ,U,6)=$P(% ,U,6)
  1985   "RTN","XPD IA",31,0)
  1986    ;if there  is no rev erse key,  save the o ld key and  flag
  1987   "RTN","XPD IA",32,0)
  1988    I $P($G(^ XTMP("XPDI ",XPDA,"KR N",19,OLDA ,3)),U)="" ,$L($P($G( ^DIC(19,DA ,3)),U)) S  $P(I,U,16 )=$P(%,U,1 6),$P(^XTM P("XPDI",X PDA,"KRN", 19,OLDA,3) ,U)=$P(^(3 ),U)
  1989   "RTN","XPD IA",33,0)
  1990    S ^XTMP(" XPDI",XPDA ,"KRN",19, OLDA,0)=I
  1991   "RTN","XPD IA",34,0)
  1992    ;if there  is a new  Descriptio n, kill th e old Desc ription
  1993   "RTN","XPD IA",35,0)
  1994    K:$O(^XTM P("XPDI",X PDA,"KRN", 19,OLDA,1, 0)) ^DIC(1 9,DA,1)
  1995   "RTN","XPD IA",36,0)
  1996    ;kill old  RCPs (RPC )
  1997   "RTN","XPD IA",37,0)
  1998    K ^DIC(19 ,DA,"RPC")
  1999   "RTN","XPD IA",38,0)
  2000    ;kill old  DIC varia bles: fiel ds 30 thru  36
  2001   "RTN","XPD IA",39,0)
  2002    F I=30:1: 36 K ^DIC( 19,DA,I)
  2003   "RTN","XPD IA",40,0)
  2004    ;if Menu  Text, (U;1 ) is diffe rent, kill  C x-ref
  2005   "RTN","XPD IA",41,0)
  2006    S I=$G(^D IC(19,DA," U")) I I]" ",I'=$G(^X TMP("XPDI" ,XPDA,"KRN ",19,OLDA, "U")) K ^D IC(19,"C", I)
  2007   "RTN","XPD IA",42,0)
  2008    S I=0
  2009   "RTN","XPD IA",43,0)
  2010    ;XPDFL=3- merge menu  items, Qu it
  2011   "RTN","XPD IA",44,0)
  2012    ;the new  menu items  have alre ady been s aved into  ^TMP, will  restore i n
  2013   "RTN","XPD IA",45,0)
  2014    ;the file  post acti on as a re link
  2015   "RTN","XPD IA",46,0)
  2016    Q:XPDFL=3
  2017   "RTN","XPD IA",47,0)
  2018    ;we are r eplacing m enu items,  kill the  old.
  2019   "RTN","XPD IA",48,0)
  2020    ;loop thr u and kill  "AD" x-re f., it wil l be reset  with new  options
  2021   "RTN","XPD IA",49,0)
  2022    F  S I=$O (^DIC(19,D A,10,I)) Q :'I  S %=+ $G(^(I,0))  K:% ^DIC( 19,"AD",%, DA,I)
  2023   "RTN","XPD IA",50,0)
  2024    ;kill Men us (10)
  2025   "RTN","XPD IA",51,0)
  2026    K ^DIC(19 ,DA,10)
  2027   "RTN","XPD IA",52,0)
  2028    Q
  2029   "RTN","XPD IA",53,0)
  2030    ;
  2031   "RTN","XPD IA",54,0)
  2032   OPTF2 ;opt ions file  post
  2033   "RTN","XPD IA",55,0)
  2034    N ACT,DA, DIK,I,X,Y, Y0
  2035   "RTN","XPD IA",56,0)
  2036    ;loop thr u all the  new incomm ing option s
  2037   "RTN","XPD IA",57,0)
  2038    S DA=0,DI K=DIC F  S  DA=$O(^TM P($J,"XPD" ,DA)) Q:'D A  S ACT=^ (DA) D
  2039   "RTN","XPD IA",58,0)
  2040    .;if use  as link th en goto OP TFL, just  update men us
  2041   "RTN","XPD IA",59,0)
  2042    .G:ACT=2  OPTFL
  2043   "RTN","XPD IA",60,0)
  2044    .;repoint  Bulletin  (220;1) an d Mail Gro up (220;3)
  2045   "RTN","XPD IA",61,0)
  2046    .S Y0=$G( ^DIC(19,DA ,220)) I Y 0]"" S $P( Y0,U)=$$LK ("^XMB(3.6 )",$P(Y0,U )),$P(Y0,U ,3)=$$LK(" ^XMB(3.8)" ,$P(Y0,U,3 )),^DIC(19 ,DA,220)=Y 0
  2047   "RTN","XPD IA",62,0)
  2048    .;repoint  RPC (RPC; 1)
  2049   "RTN","XPD IA",63,0)
  2050    .S (I,X)= 0 F  S I=$ O(^DIC(19, DA,"RPC",I )) Q:'I  S  Y0=$P($G( ^(I,0)),U)  D
  2051   "RTN","XPD IA",64,0)
  2052    ..S Y=$$L K("^XWB(89 94)",Y0)
  2053   "RTN","XPD IA",65,0)
  2054    ..I 'Y K  ^DIC(19,DA ,"RPC",I)  D BMES^XPD UTL(" RPC  "_Y0_" in  Option "_$ P(^DIC(19, DA,0),U)_"  **NOT FOU ND**") Q
  2055   "RTN","XPD IA",66,0)
  2056    ..S $P(^D IC(19,DA," RPC",I,0), U)=Y,X=I_U _(X+1)
  2057   "RTN","XPD IA",67,0)
  2058    .S:X $P(^ DIC(19,DA, "RPC",0),U ,3,4)=X
  2059   "RTN","XPD IA",68,0)
  2060    .;repoint  Package ( 0;12) and  Help Frame  (0;7)
  2061   "RTN","XPD IA",69,0)
  2062    .S Y0=^DI C(19,DA,0) ,$P(Y0,U,1 2)=$$LK("^ DIC(9.4)", $P(Y0,U,12 )),$P(Y0,U ,7)=$$LK(" ^DIC(9.2)" ,$P(Y0,U,7 )),^DIC(19 ,DA,0)=Y0
  2063   "RTN","XPD IA",70,0)
  2064   OPTFL .;ne ed to loop  through ^ TMP($J,"XP D",DA,10,I ) these ar e menus th at need to  be
  2065   "RTN","XPD IA",71,0)
  2066    .;merged,  they coul d also be  linked men u, but tre at like me rge
  2067   "RTN","XPD IA",72,0)
  2068    .S I=0 F   S I=$O(^T MP($J,"XPD ",DA,10,I) ) Q:'I  S  Y0=$G(^(I, 0)),X=$G(^ (U)) D:X]" " MENU(DA, X,Y0)
  2069   "RTN","XPD IA",73,0)
  2070    .;loop th ru Menu an d repoint  Option (0; 1), text i s on ^(U)  node
  2071   "RTN","XPD IA",74,0)
  2072    .;also ne ed to reco unt all me nus and re set zeroth  node, use  X
  2073   "RTN","XPD IA",75,0)
  2074    .S (I,X)= 0 F  S I=$ O(^DIC(19, DA,10,I))  Q:'I  S Y0 =$G(^(I,U) ) D
  2075   "RTN","XPD IA",76,0)
  2076    ..I $L(Y0 ) D  Q:'Y
  2077   "RTN","XPD IA",77,0)
  2078    ...S Y=$$ LK("^DIC(1 9)",Y0)
  2079   "RTN","XPD IA",78,0)
  2080    ...K ^DIC (19,DA,10, I,U)
  2081   "RTN","XPD IA",79,0)
  2082    ...I 'Y K  ^DIC(19,D A,10,I) D  BMES^XPDUT L(" Option  "_Y0_" in  Menu "_$P (^DIC(19,D A,0),U)_"  **NOT FOUN D**") Q
  2083   "RTN","XPD IA",80,0)
  2084    ...S $P(^ DIC(19,DA, 10,I,0),U) =Y
  2085   "RTN","XPD IA",81,0)
  2086    ..S X=I_U _(X+1)
  2087   "RTN","XPD IA",82,0)
  2088    .S:X $P(^ DIC(19,DA, 10,0),U,3, 4)=X
  2089   "RTN","XPD IA",83,0)
  2090    .;re-inde x this opt ion
  2091   "RTN","XPD IA",84,0)
  2092    .D IX1^DI K
  2093   "RTN","XPD IA",85,0)
  2094    K ^TMP($J ,"XPD")
  2095   "RTN","XPD IA",86,0)
  2096    Q
  2097   "RTN","XPD IA",87,0)
  2098    ;
  2099   "RTN","XPD IA",88,0)
  2100   OPTDEL ;op tion delet e
  2101   "RTN","XPD IA",89,0)
  2102    D DEL("^D IC(19,",DU Z)
  2103   "RTN","XPD IA",90,0)
  2104    D OPT^XPD IA2
  2105   "RTN","XPD IA",91,0)
  2106    Q
  2107   "RTN","XPD IA",92,0)
  2108    ;
  2109   "RTN","XPD IA",93,0)
  2110   PROF1 ;pro tocols fil e pre
  2111   "RTN","XPD IA",94,0)
  2112    K ^TMP($J ,"XPD")
  2113   "RTN","XPD IA",95,0)
  2114    Q
  2115   "RTN","XPD IA",96,0)
  2116    ;
  2117   "RTN","XPD IA",97,0)
  2118   PROE1 ;pro tocols ent ry pre
  2119   "RTN","XPD IA",98,0)
  2120    G PROE1^X PDIA0
  2121   "RTN","XPD IA",99,0)
  2122    ;
  2123   "RTN","XPD IA",100,0)
  2124   PROF2 ;pro tocols fil e post
  2125   "RTN","XPD IA",101,0)
  2126    N ACT,DA, DIK,I,X,Y, Y0
  2127   "RTN","XPD IA",102,0)
  2128    ;loop thr u all the  new incomm ing protoc ols
  2129   "RTN","XPD IA",103,0)
  2130    S DA=0,DI K=DIC F  S  DA=$O(^TM P($J,"XPD" ,DA)) Q:'D A  S ACT=^ (DA) D
  2131   "RTN","XPD IA",104,0)
  2132    .;if use  as link th en goto PR OFL, just  update men us
  2133   "RTN","XPD IA",105,0)
  2134    .G:ACT=2  PROFL
  2135   "RTN","XPD IA",106,0)
  2136    .;repoint  Package ( 0;12)
  2137   "RTN","XPD IA",107,0)
  2138    .S Y0=^OR D(101,DA,0 ) S:$L($P( Y0,U,12))  $P(Y0,U,12 )=$$LK("^D IC(9.4)",$ P(Y0,U,12) ),^ORD(101 ,DA,0)=Y0
  2139   "RTN","XPD IA",108,0)
  2140    .;repoint  File Link  (5;1), it s a variab le pointer
  2141   "RTN","XPD IA",109,0)
  2142    .S Y0=$P( $G(^ORD(10 1,DA,5)),U ),Y=$P(Y0, ";",2),Y0= $P(Y0,";")
  2143   "RTN","XPD IA",110,0)
  2144    .I Y0,$L( Y) S Y0=$O (@("^"_Y_" ""B"","""_ Y0_""",0)" )),$P(^ORD (101,DA,5) ,U)=$S(Y0: Y0_";"_Y,1 :"")
  2145   "RTN","XPD IA",111,0)
  2146    .;repoint  HL7 field s, node 77 0
  2147   "RTN","XPD IA",112,0)
  2148    .S Y0=$G( ^ORD(101,D A,770)) I  $L(Y0) D   S ^ORD(101 ,DA,770)=Y 0
  2149   "RTN","XPD IA",113,0)
  2150    ..S $P(Y0 ,U)=$$LK(" ^HL(771)", $P(Y0,U)), $P(Y0,U,2) =$$LK("^HL (771)",$P( Y0,U,2))
  2151   "RTN","XPD IA",114,0)
  2152    ..S $P(Y0 ,U,3)=$$LK ("^HL(771. 2)",$P(Y0, U,3)),$P(Y 0,U,11)=$$ LK("^HL(77 1.2)",$P(Y 0,U,11))
  2153   "RTN","XPD IA",115,0)
  2154    ..S $P(Y0 ,U,4)=$$LK ("^HL(779. 001)",$P(Y 0,U,4)),$P (Y0,U,7)=$ $LK("^HLCS (870)",$P( Y0,U,7))
  2155   "RTN","XPD IA",116,0)
  2156    ..S $P(Y0 ,U,8)=$$LK ("^HL(779. 003)",$P(Y 0,U,8)),$P (Y0,U,9)=$ $LK("^HL(7 79.003)",$ P(Y0,U,9))
  2157   "RTN","XPD IA",117,0)
  2158    ..S $P(Y0 ,U,10)=$$L K("^HL(771 .5)",$P(Y0 ,U,10))
  2159   "RTN","XPD IA",118,0)
  2160    .;loop th ru Access  and resolv e (3;1), k ill if it  doesn't re solve
  2161   "RTN","XPD IA",119,0)
  2162    .S (I,X)= 0 F  S I=$ O(^ORD(101 ,DA,3,I))  Q:'I  S Y0 =$P($G(^(I ,0)),U) D
  2163   "RTN","XPD IA",120,0)
  2164    ..;Y0=.01  of Access (Security  Key)
  2165   "RTN","XPD IA",121,0)
  2166    ..S Y=$$L K("^DIC(19 .1)",Y0)
  2167   "RTN","XPD IA",122,0)
  2168    ..I 'Y K  ^ORD(101,D A,3,I) D B MES^XPDUTL (" Key "_Y 0_" in Pro tocol "_$P (^ORD(101, DA,0),U)_"  **NOT FOU ND**") Q
  2169   "RTN","XPD IA",123,0)
  2170    ..S $P(^O RD(101,DA, 3,I,0),U)= Y,X=I_U_(X +1)
  2171   "RTN","XPD IA",124,0)
  2172    .S:X $P(^ ORD(101,DA ,3,0),U,3, 4)=X
  2173   "RTN","XPD IA",125,0)
  2174   PROFL .;ne ed to loop  through ^ TMP($J,"XP D",DA,10,I ) these ar e menus th at need to  be
  2175   "RTN","XPD IA",126,0)
  2176    .;merged,  they are  also linke d menu, bu t treat li ke merge
  2177   "RTN","XPD IA",127,0)
  2178    .S I=0 F   S I=$O(^T MP($J,"XPD ",DA,10,I) ) Q:'I  S  Y0=$G(^(I, 0)),X=$G(^ (U)) D:X]" " MENU(DA, X,Y0)
  2179   "RTN","XPD IA",128,0)
  2180    .;loop th ru Menu an d repoint  Option (0; 1), text i s on ^(U)  node
  2181   "RTN","XPD IA",129,0)
  2182    .;also ne ed to reco unt all me nus and re set zeroth  node, use  X
  2183   "RTN","XPD IA",130,0)
  2184    .S (I,X)= 0 F  S I=$ O(^ORD(101 ,DA,10,I))  Q:'I  S Y 0=$G(^(I,U )) D
  2185   "RTN","XPD IA",131,0)
  2186    ..I $L(Y0 ) D  Q:'Y
  2187   "RTN","XPD IA",132,0)
  2188    ...S Y=$$ LK("^ORD(1 01)",Y0)
  2189   "RTN","XPD IA",133,0)
  2190    ...K ^ORD (101,DA,10 ,I,U)
  2191   "RTN","XPD IA",134,0)
  2192    ...I 'Y K  ^ORD(101, DA,10,I) D  BMES^XPDU TL(" Proto col "_Y0_"  in Protoc ol Menu "_ $P(^ORD(10 1,DA,0),U) _" **NOT F OUND**") Q
  2193   "RTN","XPD IA",135,0)
  2194    ...S $P(^ ORD(101,DA ,10,I,0),U )=Y
  2195   "RTN","XPD IA",136,0)
  2196    ..S X=I_U _(X+1)
  2197   "RTN","XPD IA",137,0)
  2198    .S:X $P(^ ORD(101,DA ,10,0),U,3 ,4)=X
  2199   "RTN","XPD IA",138,0)
  2200    .;need to  loop thro ugh ^TMP($ J,"XPD",DA ,775,I) th ese are su bscribers  that need  to be
  2201   "RTN","XPD IA",139,0)
  2202    .;merged,  they are  also linke d subscrib er, but tr eat like m erge
  2203   "RTN","XPD IA",140,0)
  2204    .S I=0 F   S I=$O(^T MP($J,"XPD ",DA,775,I )) Q:'I  S  Y0=$G(^(I ,0)),X=$G( ^(U)) D:X] "" SUBS(DA ,X)
  2205   "RTN","XPD IA",141,0)
  2206    .;loop th ru subscri ber and re point Opti on (0;1),  text is on  ^(U) node
  2207   "RTN","XPD IA",142,0)
  2208    .;also ne ed to reco unt all me nus and re set zeroth  node, use  X
  2209   "RTN","XPD IA",143,0)
  2210    .S (I,X)= 0 F  S I=$ O(^ORD(101 ,DA,775,I) ) Q:'I  S  Y0=$G(^(I, U)) D
  2211   "RTN","XPD IA",144,0)
  2212    ..I $L(Y0 ) D  Q:'Y
  2213   "RTN","XPD IA",145,0)
  2214    ...S Y=$$ LK("^ORD(1 01)",Y0)
  2215   "RTN","XPD IA",146,0)
  2216    ...K ^ORD (101,DA,77 5,I,U)
  2217   "RTN","XPD IA",147,0)
  2218    ...I 'Y K  ^ORD(101, DA,775,I)  D BMES^XPD UTL(" Prot ocol "_Y0_ " in Proto col Subscr iber "_$P( ^ORD(101,D A,0),U)_"  **NOT FOUN D**") Q
  2219   "RTN","XPD IA",148,0)
  2220    ...S $P(^ ORD(101,DA ,775,I,0), U)=Y
  2221   "RTN","XPD IA",149,0)
  2222    ..S X=I_U _(X+1)
  2223   "RTN","XPD IA",150,0)
  2224    .S:X $P(^ ORD(101,DA ,775,0),U, 3,4)=X
  2225   "RTN","XPD IA",151,0)
  2226    .;re-inde x this opt ion
  2227   "RTN","XPD IA",152,0)
  2228    .D IX1^DI K
  2229   "RTN","XPD IA",153,0)
  2230    K ^TMP($J ,"XPD")
  2231   "RTN","XPD IA",154,0)
  2232    Q
  2233   "RTN","XPD IA",155,0)
  2234    ;
  2235   "RTN","XPD IA",156,0)
  2236   PRODEL ;op tion delet e
  2237   "RTN","XPD IA",157,0)
  2238    D DEL("^O RD(101,",D UZ)
  2239   "RTN","XPD IA",158,0)
  2240    D PRO^XPD IA2
  2241   "RTN","XPD IA",159,0)
  2242    Q
  2243   "RTN","XPD IA",160,0)
  2244    ;
  2245   "RTN","XPD IA",161,0)
  2246   LK(GR,X) ; lookup, GR =global ro ot, X=look up value
  2247   "RTN","XPD IA",162,0)
  2248    Q:$G(X)=" " ""
  2249   "RTN","XPD IA",163,0)
  2250    N I S I=$ O(@GR@("B" ,X,0))
  2251   "RTN","XPD IA",164,0)
  2252    I I,$D(@G R@(I,0))#2  Q I
  2253   "RTN","XPD IA",165,0)
  2254    Q ""
  2255   "RTN","XPD IA",166,0)
  2256    ;
  2257   "RTN","XPD IA",167,0)
  2258   ADD(XPDSDD ,XPDSDA,X)  ;add to m ultiple, X PDSDD=sub  DD#, XPDSD A=DA, X=va lue
  2259   "RTN","XPD IA",168,0)
  2260    Q:$G(X)=" "
  2261   "RTN","XPD IA",169,0)
  2262    N XPD
  2263   "RTN","XPD IA",170,0)
  2264    S XPD(XPD SDD,"?+1," _XPDSDA_", ",.01)=X
  2265   "RTN","XPD IA",171,0)
  2266    D UPDATE^ DIE("E","X PD")
  2267   "RTN","XPD IA",172,0)
  2268    Q
  2269   "RTN","XPD IA",173,0)
  2270    ;this is  used to ad d menu ite ms to an o ption or p rotocol
  2271   "RTN","XPD IA",174,0)
  2272   MENU(DA,X, X0) ;DA=ie n of optio n/protocol , X=Menu i tem, X0=0  node of me nu item
  2273   "RTN","XPD IA",175,0)
  2274    N DIC,DLA YGO,DIK,D0 ,D1,I,Y,Y0
  2275   "RTN","XPD IA",176,0)
  2276    S DIC=$S( XPDFIL=19: "^DIC(19," ,1:"^ORD(1 01,")_DA_" ,10,",DIC( 0)="L",DLA YGO=XPDFIL ,(D0,DA(1) )=DA
  2277   "RTN","XPD IA",177,0)
  2278    S:'$D(@(D IC_"0)"))  @(DIC_"0)" )=U_$P(^DD (XPDFIL,10 ,0),U,2)
  2279   "RTN","XPD IA",178,0)
  2280    S:$L($G(X 0)) DIC("D R")="2///" _$P(X0,U,2 )_";3///"_ $P(X0,U,3) _$S($L($P( X0,U,4)):" ;4///"_$P( X0,U,4)_"; 5///"_$P(X 0,U,5)_";6 ///"_$P(X0 ,U,6),1:"" )
  2281   "RTN","XPD IA",179,0)
  2282    D ^DIC
  2283   "RTN","XPD IA",180,0)
  2284    Q
  2285   "RTN","XPD IA",181,0)
  2286    ;this is  used to ad d subscrib er items t o a protoc ol
  2287   "RTN","XPD IA",182,0)
  2288   SUBS(DA,X)  ;DA=ien o f protocol , X=subscr iber
  2289   "RTN","XPD IA",183,0)
  2290    N DIC,DLA YGO,DIK,D0 ,D1,I,Y,Y0
  2291   "RTN","XPD IA",184,0)
  2292    S DIC="^O RD(101,"_D A_",775,", DIC(0)="L" ,DLAYGO=XP DFIL,(D0,D A(1))=DA
  2293   "RTN","XPD IA",185,0)
  2294    S:'$D(@(D IC_"0)"))  @(DIC_"0)" )=U_$P(^DD (XPDFIL,77 5,0),U,2)
  2295   "RTN","XPD IA",186,0)
  2296    D ^DIC
  2297   "RTN","XPD IA",187,0)
  2298    Q
  2299   "RTN","XPD IA",188,0)
  2300    ;
  2301   "RTN","XPD IA",189,0)
  2302   DEL(DIK,DU Z) ;delete
  2303   "RTN","XPD IA",190,0)
  2304    N DA,XPDI ,XPDF
  2305   "RTN","XPD IA",191,0)
  2306    S XPDI=0, DUZ(0)="@" ,XPDF=+$P( DIK,"(",2)
  2307   "RTN","XPD IA",192,0)
  2308    F  S XPDI =$O(^TMP($ J,"XPDEL", XPDI)) Q:' XPDI  D
  2309   "RTN","XPD IA",193,0)
  2310    .K ^TMP(" DIFIXPT",$ J) S DA=XP DI
  2311   "RTN","XPD IA",194,0)
  2312    .D ^DIK ; FIXPT^DIA3 ("D",XPDF, XPDI)
  2313   "RTN","XPD IA",195,0)
  2314    .I $D(^TM P("DIFIXPT ",$J))  D  WP^XPDUTL( "^TMP(""DI FIXPT"",$J )")
  2315   "RTN","XPD IA",196,0)
  2316    Q
  2317   "RTN","XPD IA0")
  2318   0^11^B3150 0090
  2319   "RTN","XPD IA0",1,0)
  2320   XPDIA0 ;SF ISC/RSD -  Cont. of X PDIA ;03/0 9/2000  06 :50
  2321   "RTN","XPD IA0",2,0)
  2322    ;;8.0;KER NEL;**131, 144,672**; Jul 10, 19 95;Build 7
  2323   "RTN","XPD IA0",3,0)
  2324    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  2325   "RTN","XPD IA0",4,0)
  2326    Q
  2327   "RTN","XPD IA0",5,0)
  2328   PROE1 ;pro tocols ent ry pre
  2329   "RTN","XPD IA0",6,0)
  2330    N %,I
  2331   "RTN","XPD IA0",7,0)
  2332    S ^TMP($J ,"XPD",DA) =XPDFL
  2333   "RTN","XPD IA0",8,0)
  2334    ;if Event  Driver, s ubscriber  multiple i s on node  775
  2335   "RTN","XPD IA0",9,0)
  2336    I $P(^XTM P("XPDI",X PDA,"KRN", 101,OLDA,0 ),U,4)="E"  D
  2337   "RTN","XPD IA0",10,0)
  2338    . Q:$D(^X TMP("XPDI" ,XPDA,"KRN ",101,OLDA ,775))
  2339   "RTN","XPD IA0",11,0)
  2340    . ;pre pa tch HL*1.6 *57, conve rt menu mu ltiple to  subscriber
  2341   "RTN","XPD IA0",12,0)
  2342    . M ^XTMP ("XPDI",XP DA,"KRN",1 01,OLDA,77 5)=^XTMP(" XPDI",XPDA ,"KRN",101 ,OLDA,10)
  2343   "RTN","XPD IA0",13,0)
  2344    . K ^XTMP ("XPDI",XP DA,"KRN",1 01,OLDA,10 )
  2345   "RTN","XPD IA0",14,0)
  2346    ;if Menu  linking or  merge sav e menu and  subscribe r mult. an d process  in FPOS co de
  2347   "RTN","XPD IA0",15,0)
  2348    I XPDFL>1  D
  2349   "RTN","XPD IA0",16,0)
  2350    . M ^TMP( $J,"XPD",D A,775)=^XT MP("XPDI", XPDA,"KRN" ,101,OLDA, 775),^TMP( $J,"XPD",D A,10)=^XTM P("XPDI",X PDA,"KRN", 101,OLDA,1 0)
  2351   "RTN","XPD IA0",17,0)
  2352    . K ^XTMP ("XPDI",XP DA,"KRN",1 01,OLDA,77 5),^(10)
  2353   "RTN","XPD IA0",18,0)
  2354    ;if Menu  link, XPDQ UIT preven ts data me rge
  2355   "RTN","XPD IA0",19,0)
  2356    I XPDFL=2  S XPDQUIT =1 Q
  2357   "RTN","XPD IA0",20,0)
  2358    ;if this  is new to  the site t hen disabl e and quit
  2359   "RTN","XPD IA0",21,0)
  2360    I $G(XPDN EW) D:XPDS ET  Q
  2361   "RTN","XPD IA0",22,0)
  2362    .;quit if  option al ready has  out of ord er msg.
  2363   "RTN","XPD IA0",23,0)
  2364    .Q:$P(^XT MP("XPDI", XPDA,"KRN" ,101,OLDA, 0),U,3)]""
  2365   "RTN","XPD IA0",24,0)
  2366    .S $P(^XT MP("XPDI", XPDA,"KRN" ,101,OLDA, 0),U,3)=$P (XPDSET,U, 3)
  2367   "RTN","XPD IA0",25,0)
  2368    .D ADD^XQ OO1($P(XPD SET,U,2),1 01,DA)
  2369   "RTN","XPD IA0",26,0)
  2370    S I=^XTMP ("XPDI",XP DA,"KRN",1 01,OLDA,0) ,%=^ORD(10 1,DA,0)
  2371   "RTN","XPD IA0",27,0)
  2372    ;$P(%,U,3 )=disable  message,
  2373   "RTN","XPD IA0",28,0)
  2374    S:$P(I,U, 3)]"" $P(I ,U,3)=$P(% ,U,3)
  2375   "RTN","XPD IA0",29,0)
  2376    ;if there  is no new  Security  Key, save  the old Ke y
  2377   "RTN","XPD IA0",30,0)
  2378    S:$P(I,U, 6)="" $P(I ,U,6)=$P(% ,U,6)
  2379   "RTN","XPD IA0",31,0)
  2380    S ^XTMP(" XPDI",XPDA ,"KRN",101 ,OLDA,0)=I
  2381   "RTN","XPD IA0",32,0)
  2382    ;if there  is a new  Descriptio n, kill th e old Desc ription
  2383   "RTN","XPD IA0",33,0)
  2384    K:$O(^XTM P("XPDI",X PDA,"KRN", 101,OLDA,1 ,0)) ^ORD( 101,DA,1)
  2385   "RTN","XPD IA0",34,0)
  2386    ;kill old  ACCESS mu ltiple
  2387   "RTN","XPD IA0",35,0)
  2388    K ^ORD(10 1,DA,3) S  I=0
  2389   "RTN","XPD IA0",36,0)
  2390    ;XPDFL=3- merge menu  items, Qu it
  2391   "RTN","XPD IA0",37,0)
  2392    ;the new  menu items  have alre ady been s aved into  ^TMP, will  restore i n
  2393   "RTN","XPD IA0",38,0)
  2394    ;the file  post acti on as a re link
  2395   "RTN","XPD IA0",39,0)
  2396    Q:XPDFL=3
  2397   "RTN","XPD IA0",40,0)
  2398    ;we are r eplacing m enu items,  kill the  old.
  2399   "RTN","XPD IA0",41,0)
  2400    ;loop thr u and kill  "AD" and  "AB" x-ref ., it will  be reset  with new o ptions
  2401   "RTN","XPD IA0",42,0)
  2402    F  S I=$O (^ORD(101, DA,10,I))  Q:'I  S %= +$G(^(I,0) ) K:% ^ORD (101,"AD", %,DA,I)
  2403   "RTN","XPD IA0",43,0)
  2404    F  S I=$O (^ORD(101, DA,775,I))  Q:'I  S % =+$G(^(I,0 )) K:% ^OR D(101,"AB" ,%,DA,I)
  2405   "RTN","XPD IA0",44,0)
  2406    K ^ORD(10 1,DA,10),^ ORD(101,DA ,775)
  2407   "RTN","XPD IA0",45,0)
  2408    Q
  2409   "RTN","XPD IA0",46,0)
  2410    ;
  2411   "RTN","XPD IA0",47,0)
  2412   ENTF1 ;ENT ITY #1.5 f ile pre
  2413   "RTN","XPD IA0",48,0)
  2414    K ^TMP($J ,"XPD")
  2415   "RTN","XPD IA0",49,0)
  2416    Q
  2417   "RTN","XPD IA0",50,0)
  2418    ;
  2419   "RTN","XPD IA0",51,0)
  2420   ENTE1 ;ENT ITY #1.5 e ntry pre
  2421   "RTN","XPD IA0",52,0)
  2422    N %,%1
  2423   "RTN","XPD IA0",53,0)
  2424    S ^TMP($J ,"XPD",DA) =XPDFL,%1= 0
  2425   "RTN","XPD IA0",54,0)
  2426    ;save ENT ITY (0;8)  & repoint  in file po st FPOS
  2427   "RTN","XPD IA0",55,0)
  2428    F  S %1=$ O(^XTMP("X PDI",XPDA, "KRN",1.5, OLDA,1,%1) ) Q:'%1  S  %=$G(^(%1 ,0)) D:$P( %,U,8)]""
  2429   "RTN","XPD IA0",56,0)
  2430    . S ^TMP( $J,"XPD",D A,1,%1)=$P (%,U,8)
  2431   "RTN","XPD IA0",57,0)
  2432    ;kill the  Entity be fore insta lling
  2433   "RTN","XPD IA0",58,0)
  2434    S %=$G(^D DE(DA,0))
  2435   "RTN","XPD IA0",59,0)
  2436    ;kill the  DEFAULT F ILE NUMBER  #.02 cros s ref.
  2437   "RTN","XPD IA0",60,0)
  2438    I $P(%,U, 2) K ^DDE( "F",$P(%,U ,2),DA)
  2439   "RTN","XPD IA0",61,0)
  2440    ;just sav e the .01  field
  2441   "RTN","XPD IA0",62,0)
  2442    S ^DDE(DA ,0)=$P(%,U ),%1=0
  2443   "RTN","XPD IA0",63,0)
  2444    ;loop thr u ITEM mul tiple #1,  check ENTI TY #.08
  2445   "RTN","XPD IA0",64,0)
  2446    F  S %1=$ O(^DDE(DA, 1,%1)) Q:' %1  S %=$G (^(%1,0))  D:$P(%,U,8 )]""
  2447   "RTN","XPD IA0",65,0)
  2448    . ;kill t he file le vel cross  ref. ^DDE( "AD",entit y,ien,mult iple)
  2449   "RTN","XPD IA0",66,0)
  2450    . K ^DDE( "AD",$P(%, U,8),DA,%1 )
  2451   "RTN","XPD IA0",67,0)
  2452    ; kill re st of file
  2453   "RTN","XPD IA0",68,0)
  2454    S %=0 F   S %=$O(^DD E(DA,%)) Q :%=""  K ^ (%)
  2455   "RTN","XPD IA0",69,0)
  2456    Q
  2457   "RTN","XPD IA0",70,0)
  2458    ;
  2459   "RTN","XPD IA0",71,0)
  2460   ENTF2 ;ENT ITY #1.5 f ile post
  2461   "RTN","XPD IA0",72,0)
  2462    ;Loop tmp  global cr eated in e ntry pre a nd repoint  ENTITY (8 )
  2463   "RTN","XPD IA0",73,0)
  2464    N %,%1,%2
  2465   "RTN","XPD IA0",74,0)
  2466    S %1=0
  2467   "RTN","XPD IA0",75,0)
  2468    F  S %1=$ O(^TMP($J, "XPD",%1)) ,%2=0 Q:'% 1  F  S %2 =$O(^TMP($ J,"XPD",%1 ,1,%2)) Q: '%2  S %=^ (%2) D
  2469   "RTN","XPD IA0",76,0)
  2470    . S %=$$L K^XPDIA("^ DDE",%)
  2471   "RTN","XPD IA0",77,0)
  2472    . I %]"", $D(^DDE(%1 ,1,%2,0))# 2 S $P(^DD E(%1,1,%2, 0),U,8)=%
  2473   "RTN","XPD IA0",78,0)
  2474    Q
  2475   "RTN","XPD IA0",79,0)
  2476    ;
  2477   "RTN","XPD IA0",80,0)
  2478   ENTDEL(RT)  ;ENTITY # 1.5 delete
  2479   "RTN","XPD IA0",81,0)
  2480    D DELIEN^ XPDUTL1(1. 5,RT)
  2481   "RTN","XPD IA0",82,0)
  2482    Q
  2483   "RTN","XPD IA0",83,0)
  2484    ;
  2485   "RTN","XPD IA0",84,0)
  2486   POLF1 ;POL ICY #1.6 f ile pre
  2487   "RTN","XPD IA0",85,0)
  2488    K ^TMP($J ,"XPD")
  2489   "RTN","XPD IA0",86,0)
  2490    ;add TYPE  during a  new record , XPDDR is  for ident ifiers
  2491   "RTN","XPD IA0",87,0)
  2492    S XPDDR(. 02)="$P(OL DA(0),U,2) "
  2493   "RTN","XPD IA0",88,0)
  2494    Q
  2495   "RTN","XPD IA0",89,0)
  2496    ;
  2497   "RTN","XPD IA0",90,0)
  2498   POLE1 ;POL ICY entry  pre
  2499   "RTN","XPD IA0",91,0)
  2500    N %,I
  2501   "RTN","XPD IA0",92,0)
  2502    ;XPDFL= 0 -send,1-de lete,2-lin k,3-merge, 4-attach,5 -disable
  2503   "RTN","XPD IA0",93,0)
  2504    ;attach &  disable n ever get h ere
  2505   "RTN","XPD IA0",94,0)
  2506    S ^TMP($J ,"XPD",DA) =XPDFL
  2507   "RTN","XPD IA0",95,0)
  2508    ;if Membe r linking  or merge s ave Member  mult. and  process i n FPOS cod e
  2509   "RTN","XPD IA0",96,0)
  2510    I XPDFL>1  M ^TMP($J ,"XPD",DA, 10)=^XTMP( "XPDI",XPD A,"KRN",1. 6,OLDA,10)  K ^XTMP(" XPDI",XPDA ,"KRN",1.6 ,OLDA,10)
  2511   "RTN","XPD IA0",97,0)
  2512    ;if Menu  link, XPDQ UIT preven ts data me rge
  2513   "RTN","XPD IA0",98,0)
  2514    I XPDFL=2  S XPDQUIT =1 Q
  2515   "RTN","XPD IA0",99,0)
  2516    ;if this  is new to  the site q uit
  2517   "RTN","XPD IA0",100,0 )
  2518    I $G(XPDN EW) Q
  2519   "RTN","XPD IA0",101,0 )
  2520    ;if there  is a new  Descriptio n, kill th e old Desc ription
  2521   "RTN","XPD IA0",102,0 )
  2522    K:$O(^XTM P("XPDI",X PDA,"KRN", 1.6,OLDA,1 ,0)) ^DIAC (1.6,DA,1)
  2523   "RTN","XPD IA0",103,0 )
  2524    Q
  2525   "RTN","XPD IA0",104,0 )
  2526    ;
  2527   "RTN","XPD IA0",105,0 )
  2528   POLE2 ;POL ICY #1.6 e ntry post
  2529   "RTN","XPD IA0",106,0 )
  2530    N %,%1,%2
  2531   "RTN","XPD IA0",107,0 )
  2532    ;repoint   ATTRIBUTE  FUNCTION  (0;4) and  RESULT FUN CTION (0;7 )
  2533   "RTN","XPD IA0",108,0 )
  2534    S %=^DIAC (1.6,DA,0)  D  S ^DIA C(1.6,DA,0 )=%
  2535   "RTN","XPD IA0",109,0 )
  2536    .F %1=4,7  S %2=$P(% ,U,%1),$P( %,U,%1)=$$ LK^XPDIA(" ^DIAC(1.62 )",%2)
  2537   "RTN","XPD IA0",110,0 )
  2538    .Q
  2539   "RTN","XPD IA0",111,0 )
  2540    ;repoint  DENY OBLIG ATION (7)  and PERMIT  OBLIGATIO N (8)
  2541   "RTN","XPD IA0",112,0 )
  2542    F %1=7,8  S %=$G(^DI AC(1.6,DA, %1)) D:$L( %)
  2543   "RTN","XPD IA0",113,0 )
  2544    .S %2=$P( %,U),$P(%, U)=$$LK^XP DIA("^DIAC (1.62)",%2 )
  2545   "RTN","XPD IA0",114,0 )
  2546    .S ^DIAC( 1.6,DA,%1) =%
  2547   "RTN","XPD IA0",115,0 )
  2548    .Q
  2549   "RTN","XPD IA0",116,0 )
  2550    ;loop thr u CONDITIO NS (3) and  repoint F UNCTION (0 ;2)
  2551   "RTN","XPD IA0",117,0 )
  2552    S %1=0 F   S %1=$O(^ DIAC(1.6,D A,3,%1)) Q :'%1  S %= $G(^(%1,0) ) D
  2553   "RTN","XPD IA0",118,0 )
  2554    .S %2=$P( %,U,2) Q:% 2=""
  2555   "RTN","XPD IA0",119,0 )
  2556    .S $P(%,U ,2)=$$LK^X PDIA("^DIA C(1.62)",% 2)
  2557   "RTN","XPD IA0",120,0 )
  2558    .S ^DIAC( 1.6,DA,3,% 1,0)=%
  2559   "RTN","XPD IA0",121,0 )
  2560    .Q
  2561   "RTN","XPD IA0",122,0 )
  2562    Q
  2563   "RTN","XPD IA0",123,0 )
  2564    ;
  2565   "RTN","XPD IA0",124,0 )
  2566   POLF2 ;POL ICY #1.6 f ile post
  2567   "RTN","XPD IA0",125,0 )
  2568    N ACT,DA, DIK,I,X,Y, Y0
  2569   "RTN","XPD IA0",126,0 )
  2570    ;loop thr u all the  new incomm ing polici es
  2571   "RTN","XPD IA0",127,0 )
  2572    S DA=0,DI K=DIC F  S  DA=$O(^TM P($J,"XPD" ,DA)) Q:'D A  S ACT=^ (DA) D
  2573   "RTN","XPD IA0",128,0 )
  2574    .;need to  loop thro ugh ^TMP($ J,"XPD",DA ,10,I) the se are MEM BERS that  need to be
  2575   "RTN","XPD IA0",129,0 )
  2576    .;merged,  they are  also linke d memeber,  but treat  like merg e
  2577   "RTN","XPD IA0",130,0 )
  2578    .S I=0 F   S I=$O(^T MP($J,"XPD ",DA,10,I) ) Q:'I  S  Y0=$G(^(I, 0)),X=$G(^ (U)) D:X]" " MEM(DA,X ,Y0)
  2579   "RTN","XPD IA0",131,0 )
  2580    .;loop th ru Menu an d repoint  Option (0; 1), text i s on ^(U)  node
  2581   "RTN","XPD IA0",132,0 )
  2582    .;also ne ed to reco unt all me nus and re set zeroth  node, use  X
  2583   "RTN","XPD IA0",133,0 )
  2584    .S (I,X)= 0 F  S I=$ O(^DIAC(1. 6,DA,10,I) ) Q:'I  S  Y0=$G(^(I, U)) D
  2585   "RTN","XPD IA0",134,0 )
  2586    ..I $L(Y0 ) D  Q:'Y
  2587   "RTN","XPD IA0",135,0 )
  2588    ...S Y=$$ LK^XPDIA(" ^DIAC(1.6) ",Y0)
  2589   "RTN","XPD IA0",136,0 )
  2590    ...K ^DIA C(1.6,DA,1 0,I,U)
  2591   "RTN","XPD IA0",137,0 )
  2592    ...I 'Y K  ^DIAC(1.6 ,DA,10,I)  D BMES^XPD UTL(" Poli cy "_Y0_"  in Policy  Members "_ $P(^DIAC(1 .6,DA,0),U )_" **NOT  FOUND**")  Q
  2593   "RTN","XPD IA0",138,0 )
  2594    ...S $P(^ DIAC(1.6,D A,10,I,0), U)=Y
  2595   "RTN","XPD IA0",139,0 )
  2596    ...Q
  2597   "RTN","XPD IA0",140,0 )
  2598    ..S X=I_U _(X+1)
  2599   "RTN","XPD IA0",141,0 )
  2600    ..Q
  2601   "RTN","XPD IA0",142,0 )
  2602    .S:X $P(^ DIAC(1.6,D A,10,0),U, 3,4)=X
  2603   "RTN","XPD IA0",143,0 )
  2604    .;re-inde x this opt ion
  2605   "RTN","XPD IA0",144,0 )
  2606    .D IX1^DI K
  2607   "RTN","XPD IA0",145,0 )
  2608    .Q
  2609   "RTN","XPD IA0",146,0 )
  2610    K ^TMP($J ,"XPD")
  2611   "RTN","XPD IA0",147,0 )
  2612    Q
  2613   "RTN","XPD IA0",148,0 )
  2614    ;
  2615   "RTN","XPD IA0",149,0 )
  2616   POLDEL(RT)  ;POLICY d elete
  2617   "RTN","XPD IA0",150,0 )
  2618    D DELPTR^ XPDUTL1(1. 6,RT) ;Del ete any po inter entr ies
  2619   "RTN","XPD IA0",151,0 )
  2620    D DELIEN^ XPDUTL1(1. 6,RT) ;Del ete the en tries
  2621   "RTN","XPD IA0",152,0 )
  2622    Q
  2623   "RTN","XPD IA0",153,0 )
  2624    ;
  2625   "RTN","XPD IA0",154,0 )
  2626   POLEE1 ;EV ENT #1.61  entry pre
  2627   "RTN","XPD IA0",155,0 )
  2628    N %
  2629   "RTN","XPD IA0",156,0 )
  2630    S %=^XTMP ("XPDI",XP DA,"KRN",1 .61,OLDA,0 )
  2631   "RTN","XPD IA0",157,0 )
  2632    ;repoint  POLICY (0; 5)
  2633   "RTN","XPD IA0",158,0 )
  2634    I $P(%,U, 5)]"" S $P (%,U,5)=$$ LK^XPDIA(" ^DIAC(1.6) ",$P(%,U,5 )),^XTMP(" XPDI",XPDA ,"KRN",1.6 1,OLDA,0)= %
  2635   "RTN","XPD IA0",159,0 )
  2636    Q
  2637   "RTN","XPD IA0",160,0 )
  2638    ;
  2639   "RTN","XPD IA0",161,0 )
  2640   POLEDEL(RT ) ;EVENT d elete
  2641   "RTN","XPD IA0",162,0 )
  2642    D DELIEN^ XPDUTL1(1. 61,RT)
  2643   "RTN","XPD IA0",163,0 )
  2644    Q
  2645   "RTN","XPD IA0",164,0 )
  2646    ;
  2647   "RTN","XPD IA0",165,0 )
  2648   POLFE1 ;FU NCTION #1. 62 entry p re
  2649   "RTN","XPD IA0",166,0 )
  2650    ;if there  is a new  Descriptio n, kill th e old Desc ription
  2651   "RTN","XPD IA0",167,0 )
  2652    K:$O(^XTM P("XPDI",X PDA,"KRN", 1.62,OLDA, 2,0)) ^DIA C(1.62,DA, 2)
  2653   "RTN","XPD IA0",168,0 )
  2654    Q
  2655   "RTN","XPD IA0",169,0 )
  2656    ;
  2657   "RTN","XPD IA0",170,0 )
  2658   POLFDEL(RT ) ;FUNCTIO N delete
  2659   "RTN","XPD IA0",171,0 )
  2660    D DELPTR^ XPDUTL1(1. 62,RT) ;De lete any p ointer ent ries
  2661   "RTN","XPD IA0",172,0 )
  2662    D DELIEN^ XPDUTL1(1. 62,RT) ;De lete the e ntries
  2663   "RTN","XPD IA0",173,0 )
  2664    Q
  2665   "RTN","XPD IA0",174,0 )
  2666    ;
  2667   "RTN","XPD IA0",175,0 )
  2668    ;this is  used to ad d member t o a policy
  2669   "RTN","XPD IA0",176,0 )
  2670   MEM(DA,X,X 0) ;DA=ien  of option /protocol,  X=Member,  X0=0 node  of member
  2671   "RTN","XPD IA0",177,0 )
  2672    N DIC,DLA YGO,DIK,D0 ,D1,I,Y,Y0
  2673   "RTN","XPD IA0",178,0 )
  2674    S DIC="^D IAC(1.6,"_ DA_",10,", DIC(0)="L" ,DLAYGO=XP DFIL,(D0,D A(1))=DA
  2675   "RTN","XPD IA0",179,0 )
  2676    S:'$D(@(D IC_"0)"))  @(DIC_"0)" )=U_$P(^DD (XPDFIL,10 ,0),U,2)
  2677   "RTN","XPD IA0",180,0 )
  2678    S:$L($G(X 0)) DIC("D R")=".02// /"_$P(X0,U ,2)
  2679   "RTN","XPD IA0",181,0 )
  2680    D ^DIC
  2681   "RTN","XPD IA0",182,0 )
  2682    Q
  2683   "RTN","XPD IA1")
  2684   0^15^B7330 0100
  2685   "RTN","XPD IA1",1,0)
  2686   XPDIA1 ;SF ISC/RSD -  Install Pr e/Post Act ions for K ernel file s cont. ;0 6/24/2008
  2687   "RTN","XPD IA1",2,0)
  2688    ;;8.0;KER NEL;**2,44 ,51,58,68, 85,131,146 ,182,229,3 02,399,507 ,539,672** ;Jul 10, 1 995;Build  7
  2689   "RTN","XPD IA1",3,0)
  2690    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  2691   "RTN","XPD IA1",4,0)
  2692    Q
  2693   "RTN","XPD IA1",5,0)
  2694   HLPF1 ;hel p frames f ile pre
  2695   "RTN","XPD IA1",6,0)
  2696    K ^TMP($J ,"XPD")
  2697   "RTN","XPD IA1",7,0)
  2698    Q
  2699   "RTN","XPD IA1",8,0)
  2700   HLPE1 ;ent ry pre
  2701   "RTN","XPD IA1",9,0)
  2702    S ^TMP($J ,"XPD",DA) ="" K ^DIC (9.2,DA,1) ,^(2),^(3) ,^(10)
  2703   "RTN","XPD IA1",10,0)
  2704    Q
  2705   "RTN","XPD IA1",11,0)
  2706   HLPF2 ;fil e post
  2707   "RTN","XPD IA1",12,0)
  2708    N DA,DIK, I,X,Y,Y0
  2709   "RTN","XPD IA1",13,0)
  2710    ;need to  send error  message,  need to se tup messag e
  2711   "RTN","XPD IA1",14,0)
  2712    S DA=0,DI K=DIC F  S  DA=$O(^TM P($J,"XPD" ,DA)) Q:'D A  D
  2713   "RTN","XPD IA1",15,0)
  2714    .;repoint  Related F rame (2;0)
  2715   "RTN","XPD IA1",16,0)
  2716    .S I=0 F   S I=$O(^D IC(9.2,DA, 2,I)) Q:'I   S Y0=$G( ^(I,0)),Y= $$LK^XPDIA ("^DIC(9.2 )",$P(Y0,U ,2)),$P(^D IC(9.2,DA, 2,I,0),U,2 )=Y
  2717   "RTN","XPD IA1",17,0)
  2718    .;repoint  OBJECT (1 0;0)
  2719   "RTN","XPD IA1",18,0)
  2720    .S (I,X)= 0 F  S I=$ O(^DIC(9.2 ,DA,10,I))  Q:'I  S Y 0=$G(^(I,0 )) D
  2721   "RTN","XPD IA1",19,0)
  2722    ..S Y=$$L K^XPDIA("^ MAG",$P(Y0 ,U)) S:Y $ P(^DIC(9.2 ,DA,10,I,0 ),U)=Y,X=X +1_U_I
  2723   "RTN","XPD IA1",20,0)
  2724    ..K:'Y ^D IC(9.2,DA, 10,I)
  2725   "RTN","XPD IA1",21,0)
  2726    .I X S $P (^DIC(9.2, DA,10,0),U ,3,4)=$P(X ,U,2)_U_+X
  2727   "RTN","XPD IA1",22,0)
  2728    .D IX1^DI K
  2729   "RTN","XPD IA1",23,0)
  2730    K ^TMP($J ,"XPD")
  2731   "RTN","XPD IA1",24,0)
  2732    Q
  2733   "RTN","XPD IA1",25,0)
  2734   HLPDEL ;he lp frame d elete
  2735   "RTN","XPD IA1",26,0)
  2736    N DA,DIK, XPDI,XPDJ
  2737   "RTN","XPD IA1",27,0)
  2738    S XPDI=0
  2739   "RTN","XPD IA1",28,0)
  2740    F  S XPDI =$O(^TMP($ J,"XPDEL", XPDI)),XPD J=0 Q:'XPD I  D
  2741   "RTN","XPD IA1",29,0)
  2742    .S DIK="^ DIC(9.2,XP DJ,2,"
  2743   "RTN","XPD IA1",30,0)
  2744    .;check o ther frame s that poi nt to this  one
  2745   "RTN","XPD IA1",31,0)
  2746    .F  S XPD J=$O(^DIC( 9.2,"AE",X PDI,XPDJ))  Q:'XPDJ   S Z=$O(^(X PDJ,0)) D: Z
  2747   "RTN","XPD IA1",32,0)
  2748    ..K DA S  DA=Z,DA(1) =XPDJ D ^D IK
  2749   "RTN","XPD IA1",33,0)
  2750    .;delete  this frame
  2751   "RTN","XPD IA1",34,0)
  2752    .K DA S D A=XPDI,DIK ="^DIC(9.2 ," D ^DIK
  2753   "RTN","XPD IA1",35,0)
  2754    Q
  2755   "RTN","XPD IA1",36,0)
  2756   BULE1 ;bul letin entr y pre
  2757   "RTN","XPD IA1",37,0)
  2758    N X,I S I =0
  2759   "RTN","XPD IA1",38,0)
  2760    ;save cur rent Mail  Groups (2)
  2761   "RTN","XPD IA1",39,0)
  2762    I $G(^XMB (3.6,DA,2, 0))]"" S X (0)=^(0) F   S I=$O(^ XMB(3.6,DA ,2,I)) Q:' I  S X(I)= $G(^(I,0))
  2763   "RTN","XPD IA1",40,0)
  2764    K ^XMB(3. 6,DA)
  2765   "RTN","XPD IA1",41,0)
  2766    ;after ki lling data , put back  Mail Grou ps before  data merge
  2767   "RTN","XPD IA1",42,0)
  2768    I $D(X) S  ^XMB(3.6, DA,2,0)=X( 0),I=0 F   S I=$O(X(I )) Q:'I  S  ^XMB(3.6, DA,2,I,0)= X(I)
  2769   "RTN","XPD IA1",43,0)
  2770    Q
  2771   "RTN","XPD IA1",44,0)
  2772   BULDEL ;de l bulletin s
  2773   "RTN","XPD IA1",45,0)
  2774    D DELIEN^ XPDUTL1(3. 6,$G(%))
  2775   "RTN","XPD IA1",46,0)
  2776    Q
  2777   "RTN","XPD IA1",47,0)
  2778   MAILGF1 ;m ail groups  file pre
  2779   "RTN","XPD IA1",48,0)
  2780    K ^TMP($J ,"XPD")
  2781   "RTN","XPD IA1",49,0)
  2782    Q
  2783   "RTN","XPD IA1",50,0)
  2784   MAILGE1 ;m ail group  entry pre
  2785   "RTN","XPD IA1",51,0)
  2786    N I,J
  2787   "RTN","XPD IA1",52,0)
  2788    S ^TMP($J ,"XPD",DA) =""
  2789   "RTN","XPD IA1",53,0)
  2790    ;save MEM BER GROUPS  (5;0)
  2791   "RTN","XPD IA1",54,0)
  2792    I $O(^XTM P("XPDI",X PDA,"KRN", 3.8,OLDA,5 ,0)) M ^TM P($J,"XPD" ,DA,5)=^XT MP("XPDI", XPDA,"KRN" ,3.8,OLDA, 5) K ^XTMP ("XPDI",XP DA,"KRN",3 .8,OLDA,5)
  2793   "RTN","XPD IA1",55,0)
  2794    ;save MEM BER - REMO TE (6;0)
  2795   "RTN","XPD IA1",56,0)
  2796    I $O(^XTM P("XPDI",X PDA,"KRN", 3.8,OLDA,6 ,0)) M ^TM P($J,"XPD" ,DA,6)=^XT MP("XPDI", XPDA,"KRN" ,3.8,OLDA, 6) K ^XTMP ("XPDI",XP DA,"KRN",3 .8,OLDA,6)
  2797   "RTN","XPD IA1",57,0)
  2798    ;if there  is a new  Descriptio n, kill th e old Desc ription
  2799   "RTN","XPD IA1",58,0)
  2800    K:$O(^XTM P("XPDI",X PDA,"KRN", 3.8,OLDA,2 ,0)) ^XMB( 3.8,DA,2)
  2801   "RTN","XPD IA1",59,0)
  2802    ;I=curren t mail gro up, J=inco ming mail  group
  2803   "RTN","XPD IA1",60,0)
  2804    S I=^XMB( 3.8,DA,0), J=^XTMP("X PDI",XPDA, "KRN",3.8, OLDA,0)
  2805   "RTN","XPD IA1",61,0)
  2806    ;save REF ERENCE COU NT (0;4) &  LAST REFE RENCED (0; 5)
  2807   "RTN","XPD IA1",62,0)
  2808    S:$P(I,U, 4) $P(J,U, 4)=$P(I,U, 4) S:$P(I, U,5) $P(J, U,5)=$P(I, U,5)
  2809   "RTN","XPD IA1",63,0)
  2810    ;check CO ORDINATOR  (0;7), bri ng in one  that was a sked durin g install  question
  2811   "RTN","XPD IA1",64,0)
  2812    D
  2813   "RTN","XPD IA1",65,0)
  2814    .;get the  existing  coordinato r, and set  it
  2815   "RTN","XPD IA1",66,0)
  2816    .I $P(I,U ,7) S $P(J ,U,7)=$P(I ,U,7)
  2817   "RTN","XPD IA1",67,0)
  2818    .;check i f there is  a pre-que stion
  2819   "RTN","XPD IA1",68,0)
  2820    .S %=$O(^ XPD(9.7,XP DA,"QUES", "B","XPM"_ OLDA_"#1", 0)) Q:'%
  2821   "RTN","XPD IA1",69,0)
  2822    .;if they  entered a  coordinat or, then s et it
  2823   "RTN","XPD IA1",70,0)
  2824    .I $G(^XP D(9.7,XPDA ,"QUES",%, 1)) S $P(J ,U,7)=^(1)
  2825   "RTN","XPD IA1",71,0)
  2826    S ^XTMP(" XPDI",XPDA ,"KRN",3.8 ,OLDA,0)=J ,I=$G(^XMB (3.8,DA,3) )
  2827   "RTN","XPD IA1",72,0)
  2828    ;save ORG ANIZER (3; 1)
  2829   "RTN","XPD IA1",73,0)
  2830    I $P(I,U)  S $P(^XTM P("XPDI",X PDA,"KRN", 3.8,OLDA,3 ),U)=$P(I, U)
  2831   "RTN","XPD IA1",74,0)
  2832    Q
  2833   "RTN","XPD IA1",75,0)
  2834   MAILGF2 ;m ail group  file post
  2835   "RTN","XPD IA1",76,0)
  2836    N DA,DIK, XPDMDA,XPD I,Y
  2837   "RTN","XPD IA1",77,0)
  2838    S XPDMDA= 0,DIK="^XM B(3.8,"
  2839   "RTN","XPD IA1",78,0)
  2840    F  S XPDM DA=$O(^TMP ($J,"XPD", XPDMDA)) Q :'XPDMDA   D
  2841   "RTN","XPD IA1",79,0)
  2842    .;merge &  repoint M EMBER GROU P (5;0)
  2843   "RTN","XPD IA1",80,0)
  2844    .S XPDI=0
  2845   "RTN","XPD IA1",81,0)
  2846    .F  S XPD I=$O(^TMP( $J,"XPD",X PDMDA,5,XP DI)) Q:'XP DI  S Y=$P ($G(^(XPDI ,0)),U) D: Y]"" ADD^X PDIA(3.811 ,XPDMDA,Y)
  2847   "RTN","XPD IA1",82,0)
  2848    .;merge &  repoint M EMBER - RE MOTE (6;0)
  2849   "RTN","XPD IA1",83,0)
  2850    .S XPDI=0
  2851   "RTN","XPD IA1",84,0)
  2852    .F  S XPD I=$O(^TMP( $J,"XPD",X PDMDA,6,XP DI)) Q:'XP DI  S Y=$P ($G(^(XPDI ,0)),U) D: Y]"" ADD^X PDIA(3.812 ,XPDMDA,Y)
  2853   "RTN","XPD IA1",85,0)
  2854    .S DA=XPD MDA D IX1^ DIK
  2855   "RTN","XPD IA1",86,0)
  2856    K ^TMP($J ,"XPD")
  2857   "RTN","XPD IA1",87,0)
  2858    Q
  2859   "RTN","XPD IA1",88,0)
  2860   MAILGDEL(R T) ;Mail G roup delet e
  2861   "RTN","XPD IA1",89,0)
  2862    D DELPTR^ XPDUTL1(3. 8,RT) ;Del ete any po inter entr ies
  2863   "RTN","XPD IA1",90,0)
  2864    D DELIEN^ XPDUTL1(3. 8,RT) ;Del ete the en tries
  2865   "RTN","XPD IA1",91,0)
  2866    Q
  2867   "RTN","XPD IA1",92,0)
  2868   HLAPF1 ;HL 7 applicat ion parame ter #771 f ile pre
  2869   "RTN","XPD IA1",93,0)
  2870    K ^TMP($J ,"XPD")
  2871   "RTN","XPD IA1",94,0)
  2872    Q
  2873   "RTN","XPD IA1",95,0)
  2874   HLAPE1 ;HL 7 applicat ion parame ter #771 e ntry pre
  2875   "RTN","XPD IA1",96,0)
  2876    N I,J
  2877   "RTN","XPD IA1",97,0)
  2878    S ^TMP($J ,"XPD",DA) =""
  2879   "RTN","XPD IA1",98,0)
  2880    S I=^HL(7 71,DA,0),J =^XTMP("XP DI",XPDA," KRN",771,O LDA,0)
  2881   "RTN","XPD IA1",99,0)
  2882    ;save FAC ILITY NAME  (0;3)
  2883   "RTN","XPD IA1",100,0 )
  2884    S:$P(I,U, 3)]"" $P(J ,U,3)=$P(I ,U,3)
  2885   "RTN","XPD IA1",101,0 )
  2886    ;repoint  MAIL GROUP  (0;4)
  2887   "RTN","XPD IA1",102,0 )
  2888    S:$P(J,U, 4)]"" $P(J ,U,4)=$$LK ^XPDIA("^X MB(3.8)",$ P(J,U,4))
  2889   "RTN","XPD IA1",103,0 )
  2890    ;repoint  COUNTRY CO DE (0;7)
  2891   "RTN","XPD IA1",104,0 )
  2892    S:$P(J,U, 7)]"" $P(J ,U,7)=$$LK ^XPDIA("^H L(779.004) ",$P(J,U,7 ))
  2893   "RTN","XPD IA1",105,0 )
  2894    S ^XTMP(" XPDI",XPDA ,"KRN",771 ,OLDA,0)=J
  2895   "RTN","XPD IA1",106,0 )
  2896    ;remove H L7 SEGMENT  (SEG;0),  HL7 MESSAG E (MSG;0)
  2897   "RTN","XPD IA1",107,0 )
  2898    K ^HL(771 ,DA,"SEG") ,^("MSG")
  2899   "RTN","XPD IA1",108,0 )
  2900    Q
  2901   "RTN","XPD IA1",109,0 )
  2902   HLAPF2 ;HL 7 applicat ion parame ter #771 f ile post
  2903   "RTN","XPD IA1",110,0 )
  2904    N DA,DIK, XPDI,X,Y
  2905   "RTN","XPD IA1",111,0 )
  2906    S DA=0,DI K="^HL(771 ,"
  2907   "RTN","XPD IA1",112,0 )
  2908    F  S DA=$ O(^TMP($J, "XPD",DA))  Q:'DA  D
  2909   "RTN","XPD IA1",113,0 )
  2910    .;repoint  HL7 SEGME NT (SEG;0)
  2911   "RTN","XPD IA1",114,0 )
  2912    .S XPDI=0
  2913   "RTN","XPD IA1",115,0 )
  2914    .F  S XPD I=$O(^HL(7 71,DA,"SEG ",XPDI)) Q :'XPDI  S  Y=$P($G(^( XPDI,0)),U ) D
  2915   "RTN","XPD IA1",116,0 )
  2916    ..S X=$$L K^XPDIA("^ HL(771.3)" ,$P(Y,U))
  2917   "RTN","XPD IA1",117,0 )
  2918    ..I X]""  S $P(^HL(7 71,DA,"SEG ",XPDI,0), U)=X Q
  2919   "RTN","XPD IA1",118,0 )
  2920    ..K ^HL(7 71,DA,"SEG ",XPDI)
  2921   "RTN","XPD IA1",119,0 )
  2922    .;repoint  HL7 MESSA GE (MSG;0)
  2923   "RTN","XPD IA1",120,0 )
  2924    .S XPDI=0
  2925   "RTN","XPD IA1",121,0 )
  2926    .F  S XPD I=$O(^HL(7 71,DA,"MSG ",XPDI)) Q :'XPDI  S  Y=$P($G(^( XPDI,0)),U ) D
  2927   "RTN","XPD IA1",122,0 )
  2928    ..S X=$$L K^XPDIA("^ HL(771.3)" ,$P(Y,U))
  2929   "RTN","XPD IA1",123,0 )
  2930    ..I X]""  S $P(^HL(7 71,DA,"MSG ",XPDI,0), U)=X Q
  2931   "RTN","XPD IA1",124,0 )
  2932    ..K ^HL(7 71,DA,"MSG ",XPDI)
  2933   "RTN","XPD IA1",125,0 )
  2934    .D IX1^DI K
  2935   "RTN","XPD IA1",126,0 )
  2936    K ^TMP($J ,"XPD")
  2937   "RTN","XPD IA1",127,0 )
  2938    Q
  2939   "RTN","XPD IA1",128,0 )
  2940   HLLLPE ;HL 7 lower le vel protoc ol #869.2  entry pre
  2941   "RTN","XPD IA1",129,0 )
  2942    N I,J,L,T MP,Y
  2943   "RTN","XPD IA1",130,0 )
  2944    S L=$P(^X TMP("XPDI" ,XPDA,"KRN ",869.2,OL DA,0),U),I =0
  2945   "RTN","XPD IA1",131,0 )
  2946    ;loop thr u logical  links and  find those  pointing  to this ll p
  2947   "RTN","XPD IA1",132,0 )
  2948    F  S I=$O (^XTMP("XP DI",XPDA," KRN",870,I )) Q:'I  S  J=$G(^(I, 0)) D
  2949   "RTN","XPD IA1",133,0 )
  2950    . Q:$P(J, U,3)'=L
  2951   "RTN","XPD IA1",134,0 )
  2952    . ;save l lp into tm p, get the  llp type  field
  2953   "RTN","XPD IA1",135,0 )
  2954    . M TMP=^ XTMP("XPDI ",XPDA,"KR N",869.2,O LDA) S Y=$ P(TMP(0),U ,2)
  2955   "RTN","XPD IA1",136,0 )
  2956    . K TMP(- 1),TMP(0)
  2957   "RTN","XPD IA1",137,0 )
  2958    . M ^XTMP ("XPDI",XP DA,"KRN",8 70,I)=TMP  S $P(^(I,0 ),U,3)=Y
  2959   "RTN","XPD IA1",138,0 )
  2960    S I=$P(^X TMP("XPDI" ,XPDA,"KRN ",869.2,OL DA,0),U,2)
  2961   "RTN","XPD IA1",139,0 )
  2962    ;repoint  LLP TYPE ( 0;2)
  2963   "RTN","XPD IA1",140,0 )
  2964    S:I]"" $P (^XTMP("XP DI",XPDA," KRN",869.2 ,OLDA,0),U ,2)=$$LK^X PDIA("^HLC S(869.1)", I)
  2965   "RTN","XPD IA1",141,0 )
  2966    S I=$P($G (^XTMP("XP DI",XPDA," KRN",869.2 ,OLDA,100) ),U)
  2967   "RTN","XPD IA1",142,0 )
  2968    ;repoint  MAIL GROUP  (100;1)
  2969   "RTN","XPD IA1",143,0 )
  2970    S:I]"" $P (^XTMP("XP DI",XPDA," KRN",869.2 ,OLDA,100) ,U)=$$LK^X PDIA("^XMB (3.8)",I)
  2971   "RTN","XPD IA1",144,0 )
  2972    ;save HLL P DEVICE ( 200;1)
  2973   "RTN","XPD IA1",145,0 )
  2974    S I=$G(^H LCS(869.2, DA,200))
  2975   "RTN","XPD IA1",146,0 )
  2976    S:I $P(^X TMP("XPDI" ,XPDA,"KRN ",869.2,OL DA,200),U) =$P(I,U)
  2977   "RTN","XPD IA1",147,0 )
  2978    ;save X3. 28 DEVICE  (300;1)
  2979   "RTN","XPD IA1",148,0 )
  2980    S I=$G(^H LCS(869.2, DA,300))
  2981   "RTN","XPD IA1",149,0 )
  2982    S:I $P(^X TMP("XPDI" ,XPDA,"KRN ",869.2,OL DA,300),U) =$P(I,U)
  2983   "RTN","XPD IA1",150,0 )
  2984    ;save TCP /IP Start- up Node (4 00;6)
  2985   "RTN","XPD IA1",151,0 )
  2986    S I=$G(^H LCS(869.2, DA,400))
  2987   "RTN","XPD IA1",152,0 )
  2988    S:I $P(^X TMP("XPDI" ,XPDA,"KRN ",869.2,OL DA,400),U, 6)=$P(I,U, 6)
  2989   "RTN","XPD IA1",153,0 )
  2990    Q
  2991   "RTN","XPD IA1",154,0 )
  2992   HLLLE ;HL7  logical l ink #870 e ntry pre
  2993   "RTN","XPD IA1",155,0 )
  2994    N I,J,K,L ,Y
  2995   "RTN","XPD IA1",156,0 )
  2996    S I=^HLCS (870,DA,0) ,J=^XTMP(" XPDI",XPDA ,"KRN",870 ,OLDA,0)
  2997   "RTN","XPD IA1",157,0 )
  2998    ;repoint  INSTITUTIO N (0;2)
  2999   "RTN","XPD IA1",158,0 )
  3000    I $P(J,U, 2)]"" S Y= $$LK^XPDIA ("^DIC(4)" ,$P(J,U,2) ) D:Y=""   S $P(J,U,2 )=Y
  3001   "RTN","XPD IA1",159,0 )
  3002    .D BMES^X PDUTL(" Co uldn't res olve Insti tution "_$ P(J,U,2)_"  for Logic al Link "_ $P(^HLCS(8 70,DA,0),U ))
  3003   "RTN","XPD IA1",160,0 )
  3004    ;repoint  LLP TYPE ( 0;3)
  3005   "RTN","XPD IA1",161,0 )
  3006    S:$P(J,U, 3)]"" $P(J ,U,3)=$$LK ^XPDIA("^H LCS(869.1) ",$P(J,U,3 ))
  3007   "RTN","XPD IA1",162,0 )
  3008    ;repoint  MAILMAN DO MAIN (0;7)
  3009   "RTN","XPD IA1",163,0 )
  3010    I $P(J,U, 7)]"" S Y= $$LK^XPDIA ("^DIC(4.2 )",$P(J,U, 7)) D:Y=""   S $P(J,U ,7)=Y
  3011   "RTN","XPD IA1",164,0 )
  3012    .D BMES^X PDUTL(" Co uldn't res olve Domai n "_$P(J,U ,7)_" for  Logical Li nk "_$P(^H LCS(870,DA ,0),U))
  3013   "RTN","XPD IA1",165,0 )
  3014    ;save nod e 0; piece s 4,5,6,7, 9,10,11,12 ,16,19,21
  3015   "RTN","XPD IA1",166,0 )
  3016    F L=4:1:7 ,9:1:12,16 ,19,21 S:$ P(I,U,L)]" " $P(J,U,L )=$P(I,U,L )
  3017   "RTN","XPD IA1",167,0 )
  3018    ;set SHUT DOWN LLP ( 0;15) no f or multi-l istener an d yes for  all else
  3019   "RTN","XPD IA1",168,0 )
  3020    S Y=$P($G (^HLCS(870 ,DA,400)), U,3) S:Y]" " $P(J,U,1 5)=$S(Y="M ":0,1:1)
  3021   "RTN","XPD IA1",169,0 )
  3022    S ^XTMP(" XPDI",XPDA ,"KRN",870 ,OLDA,0)=J
  3023   "RTN","XPD IA1",170,0 )
  3024    S I=$P($G (^XTMP("XP DI",XPDA," KRN",870,O LDA,100)), U)
  3025   "RTN","XPD IA1",171,0 )
  3026    ;repoint  MAIL GROUP  (100;1)
  3027   "RTN","XPD IA1",172,0 )
  3028    S:I]"" $P (^XTMP("XP DI",XPDA," KRN",870,O LDA,100),U )=$$LK^XPD IA("^XMB(3 .8)",I)
  3029   "RTN","XPD IA1",173,0 )
  3030    ;save dat a from sit e on nodes  200,300,4 00,500
  3031   "RTN","XPD IA1",174,0 )
  3032    F L=200,3 00,400,500  S I=$G(^H LCS(870,DA ,L)) D:I]" "
  3033   "RTN","XPD IA1",175,0 )
  3034    . S J=$G( ^XTMP("XPD I",XPDA,"K RN",870,OL DA,L)) Q:J =""
  3035   "RTN","XPD IA1",176,0 )
  3036    . ;check  local data  (I) and i f exist se t incommin g data (J)
  3037   "RTN","XPD IA1",177,0 )
  3038    . F K=1:1 :10 S Y=$P (I,U,K) S: Y]"" $P(J, U,K)=Y
  3039   "RTN","XPD IA1",178,0 )
  3040    . S ^XTMP ("XPDI",XP DA,"KRN",8 70,OLDA,L) =J
  3041   "RTN","XPD IA1",179,0 )
  3042    ;remove f ollowing v alues when  a Test si te (not a  Production  site)
  3043   "RTN","XPD IA1",180,0 )
  3044    D:$P($$PA RAM^HLCS2, U,3)'="P"
  3045   "RTN","XPD IA1",181,0 )
  3046    . ;MAILMA N DOMAIN ( 0;7), DNS  DOMAIN (0; 8)
  3047   "RTN","XPD IA1",182,0 )
  3048    . S $P(^X TMP("XPDI" ,XPDA,"KRN ",870,OLDA ,0),U,7,8) ="^"
  3049   "RTN","XPD IA1",183,0 )
  3050    . ;TCP/IP  ADDRESS ( 400,1), IP V6 ADDRESS  (500,1)
  3051   "RTN","XPD IA1",184,0 )
  3052    . S J=$G( ^XTMP("XPD I",XPDA,"K RN",870,OL DA,400))
  3053   "RTN","XPD IA1",185,0 )
  3054    . S:J]""  $P(^XTMP(" XPDI",XPDA ,"KRN",870 ,OLDA,400) ,U)=""
  3055   "RTN","XPD IA1",186,0 )
  3056    . S J=$G( ^XTMP("XPD I",XPDA,"K RN",870,OL DA,500))
  3057   "RTN","XPD IA1",187,0 )
  3058    . S:J]""  $P(^XTMP(" XPDI",XPDA ,"KRN",870 ,OLDA,500) ,U)=""
  3059   "RTN","XPD IA1",188,0 )
  3060    Q
  3061   "RTN","XPD IA1",189,0 )
  3062   KEYF1 ;SEC URITY KEY  file pre
  3063   "RTN","XPD IA1",190,0 )
  3064    K ^TMP($J ,"XPD")
  3065   "RTN","XPD IA1",191,0 )
  3066    Q
  3067   "RTN","XPD IA1",192,0 )
  3068   KEYE1 ;SEC URITY KEY  file entry  pre
  3069   "RTN","XPD IA1",193,0 )
  3070    S ^TMP($J ,"XPD",DA) =""
  3071   "RTN","XPD IA1",194,0 )
  3072    Q
  3073   "RTN","XPD IA1",195,0 )
  3074   KEYF2 ;SEC URITY KEY  file post
  3075   "RTN","XPD IA1",196,0 )
  3076    N DA,DIK, I,X,Y,Y0
  3077   "RTN","XPD IA1",197,0 )
  3078    ;Repoint  fields
  3079   "RTN","XPD IA1",198,0 )
  3080    S DA=0,DI K=DIC
  3081   "RTN","XPD IA1",199,0 )
  3082    F  S DA=$ O(^TMP($J, "XPD",DA))  Q:'DA  D
  3083   "RTN","XPD IA1",200,0 )
  3084    . ;Repoin t SUBORDIN ATE (3)
  3085   "RTN","XPD IA1",201,0 )
  3086    . S I=0 F   S I=$O(^ DIC(19.1,D A,3,I)) Q: 'I  S Y0=$ G(^(I,0))  D
  3087   "RTN","XPD IA1",202,0 )
  3088    . . S Y=$ $LK^XPDIA( "^DIC(19.1 )",$P(Y0,U )) S:Y $P( ^DIC(19.1, DA,3,I,0), U)=Y
  3089   "RTN","XPD IA1",203,0 )
  3090    . ;MUTUAL LY EXCLUSI VE KEYS (5 )
  3091   "RTN","XPD IA1",204,0 )
  3092    . S (I,X) =0 F  S I= $O(^DIC(19 .1,DA,5,I) ) Q:'I  S  Y0=$G(^(I, 0)) D
  3093   "RTN","XPD IA1",205,0 )
  3094    . . S Y=$ $LK^XPDIA( "^DIC(19.1 )",$P(Y0,U )) S:Y $P( ^DIC(19.1, DA,5,I,0), U)=Y
  3095   "RTN","XPD IA1",206,0 )
  3096    . D IX1^D IK
  3097   "RTN","XPD IA1",207,0 )
  3098    K ^TMP($J ,"XPD")
  3099   "RTN","XPD IA1",208,0 )
  3100    Q
  3101   "RTN","XPD IA1",209,0 )
  3102   KEYDEL ;de l security  keys
  3103   "RTN","XPD IA1",210,0 )
  3104    N XPDI S  XPDI=0
  3105   "RTN","XPD IA1",211,0 )
  3106    F  S XPDI =$O(^TMP($ J,"XPDEL", XPDI)) Q:' XPDI  D DE L^XPDKEY(X PDI)
  3107   "RTN","XPD IA1",212,0 )
  3108    Q
  3109   "RTN","XPD IA1",213,0 )
  3110   LME1 ;List  Templates  entry pre
  3111   "RTN","XPD IA1",214,0 )
  3112    ;kill old  entry bef ore data m erge
  3113   "RTN","XPD IA1",215,0 )
  3114    K ^SD(409 .61,DA)
  3115   "RTN","XPD IA1",216,0 )
  3116    Q
  3117   "RTN","XPD IA1",217,0 )
  3118   LMDEL ;del  list mana ger templa tes
  3119   "RTN","XPD IA1",218,0 )
  3120    D DELIEN^ XPDUTL1(40 9.61,$NA(^ TMP($J,"XP DEL")))
  3121   "RTN","XPD IA1",219,0 )
  3122    Q
  3123   "RTN","XPD IA1",220,0 )
  3124   RPCDEL ;de l Kernel R PC, file 8 994
  3125   "RTN","XPD IA1",221,0 )
  3126    D DELIEN^ XPDUTL1(89 94,$G(%))
  3127   "RTN","XPD IA1",222,0 )
  3128    Q
  3129   "RTN","XPD IA1",223,0 )
  3130   RPCE1 ;RPC  pre entry , file 899 4
  3131   "RTN","XPD IA1",224,0 )
  3132    ;kill Inp ut paramet ers multip le, field  #2
  3133   "RTN","XPD IA1",225,0 )
  3134    K ^XWB(89 94,DA,2)
  3135   "RTN","XPD IA1",226,0 )
  3136    Q
  3137   "RTN","XPD IA1",227,0 )
  3138   CRC32PE ;p re entry f or Kernel  RPCs CRC32
  3139   "RTN","XPD IA1",228,0 )
  3140    ;if there  is a new  Descriptio n, kill th e old Desc ription
  3141   "RTN","XPD IA1",229,0 )
  3142    K:$O(^XTM P("XPDI",X PDA,"KRN", 8994.2,OLD A,1,0)) ^X WB(8994.2, DA,1)
  3143   "RTN","XPD IA1",230,0 )
  3144    Q
  3145   "RTN","XPD IA1",231,0 )
  3146   CRC32DEL ; del Kernel  RPCs CRC3 2
  3147   "RTN","XPD IA1",232,0 )
  3148    D DELIEN^ XPDUTL1(89 94.2,$G(%) )
  3149   "RTN","XPD IA1",233,0 )
  3150    Q
  3151   "RTN","XPD IA1",234,0 )
  3152   HLAPDEL(RT ) ;del HL7  applicati on paramet er #771
  3153   "RTN","XPD IA1",235,0 )
  3154    D DELIEN^ XPDUTL1(77 1,RT)
  3155   "RTN","XPD IA1",236,0 )
  3156    Q
  3157   "RTN","XPD IA1",237,0 )
  3158   HLLLDEL(RT ) ;del HL7  logical l ink #870
  3159   "RTN","XPD IA1",238,0 )
  3160    N DA,DIK, XPDI,XPDJ, Y
  3161   "RTN","XPD IA1",239,0 )
  3162    S XPDI=0
  3163   "RTN","XPD IA1",240,0 )
  3164    ;loop thr u protocol s, #101, g et LL fiel d, 770.7 ( 700;7)
  3165   "RTN","XPD IA1",241,0 )
  3166    F  S XPDI =$O(^ORD(1 01,XPDI))  Q:'XPDI  S  Y=$P($G(^ (XPDI,700) ),U,7) D:Y
  3167   "RTN","XPD IA1",242,0 )
  3168    . Q:'$D(^ TMP($J,"XP DEL",Y))
  3169   "RTN","XPD IA1",243,0 )
  3170    . K XPDJ  S XPDJ(101 ,XPDI_",", 770.7)="@"
  3171   "RTN","XPD IA1",244,0 )
  3172    . D FILE^ DIE("","XP DJ")
  3173   "RTN","XPD IA1",245,0 )
  3174    ;subscrip tion, #774
  3175   "RTN","XPD IA1",246,0 )
  3176    F  S XPDI =$O(TMP($J ,"XPDEL",X PDI)) Q:'X PDI  D:$D( ^HLS(774," C",XPDI))
  3177   "RTN","XPD IA1",247,0 )
  3178    . S XPDJ= 0 F  S XPD J=$O(^HLS( 774,"C",XP DI,XPDJ))
  3179   "RTN","XPD IA1",248,0 )
  3180    D DELIEN^ XPDUTL1(87 0,RT)
  3181   "RTN","XPD IA1",249,0 )
  3182    Q
  3183   "RTN","XPD IA1",250,0 )
  3184   HLOE ;HLO  applicatio n registry  #779.2
  3185   "RTN","XPD IA1",251,0 )
  3186    N I,J,K,L ,Y
  3187   "RTN","XPD IA1",252,0 )
  3188    S I=^HLD( 779.2,DA,0 ),J=^XTMP( "XPDI",XPD A,"KRN",77 9.2,OLDA,0 )
  3189   "RTN","XPD IA1",253,0 )
  3190    ;repoint  APPLICATIO N SPECIFIC  LISTENER  (0;9)
  3191   "RTN","XPD IA1",254,0 )
  3192    I $P(J,U, 9)]"" S Y= $$LK^XPDIA ("^HLCS(87 0)",$P(J,U ,9)) D:Y=" "  S $P(J, U,9)=Y
  3193   "RTN","XPD IA1",255,0 )
  3194    .D BMES^X PDUTL(" Co uldn't res olve APPLI CATION SPE CIFIC LIST ENER "_$P( J,U,2)_" H LO APPLICA TION "_$P( I,U))
  3195   "RTN","XPD IA1",256,0 )
  3196    S ^XTMP(" XPDI",XPDA ,"KRN",779 .2,OLDA,0) =J
  3197   "RTN","XPD IA1",257,0 )
  3198    ;repoint  Package Fi le Link (2 ;1)
  3199   "RTN","XPD IA1",258,0 )
  3200    S J=$P($G (^XTMP("XP DI",XPDA," KRN",779.2 ,OLDA,2)), U)
  3201   "RTN","XPD IA1",259,0 )
  3202    S:J]"" $P (^XTMP("XP DI",XPDA," KRN",779.2 ,OLDA,2),U )=$$LK^XPD IA("^DIC(9 .4)",J)
  3203   "RTN","XPD IA1",260,0 )
  3204    ;save dat a from sit e on nodes  200,300,4 00
  3205   "RTN","XPD IA1",261,0 )
  3206    Q
  3207   "RTN","XPD IA3")
  3208   0^3^B12998 832
  3209   "RTN","XPD IA3",1,0)
  3210   XPDIA3 ;SF ISC/RWF -  Install Pr e/Post Act ions for K ernel file s cont. ;6 /22/06  09 :13
  3211   "RTN","XPD IA3",2,0)
  3212    ;;8.0;KER NEL;**201, 302,393,49 8,603,672* *;Jul 10,  1995;Build  7
  3213   "RTN","XPD IA3",3,0)
  3214    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  3215   "RTN","XPD IA3",4,0)
  3216    Q
  3217   "RTN","XPD IA3",5,0)
  3218    ;^XTMP("X PDI",,XPDA ,"KRN",XPD FILE,OLDA)  is the gl obal root
  3219   "RTN","XPD IA3",6,0)
  3220    ;XPDNM=pa ckage name , XPDA=ien  in ^XPD(9 .6,
  3221   "RTN","XPD IA3",7,0)
  3222    ;DA=ien i n file, OL DA= ien in  ^XTMP
  3223   "RTN","XPD IA3",8,0)
  3224    ;
  3225   "RTN","XPD IA3",9,0)
  3226   PAR0F2 ;PA RAMETER fi le 8989.5:  post.  Th is is a fa ke entry c alled from  the post  of file 89 89.51
  3227   "RTN","XPD IA3",10,0)
  3228    ;Now load  any entri es from 89 89.5
  3229   "RTN","XPD IA3",11,0)
  3230    N XP1,XP2 ,XP3,DIK,O LDA,DA,ERR ,PN,PE,PT, ROOT
  3231   "RTN","XPD IA3",12,0)
  3232    S XP1=$O( ^XTMP("XPD I",XPDA,"P KG",0)) ;G et the pac kage
  3233   "RTN","XPD IA3",13,0)
  3234    Q:'XP1  S  PN=$G(^XT MP("XPDI", XPDA,"PKG" ,XP1,0))
  3235   "RTN","XPD IA3",14,0)
  3236    S PE=$$FI ND1^DIC(9. 4,,"MX",$P (PN,U,2))  ;Get the I EN of the  package
  3237   "RTN","XPD IA3",15,0)
  3238    S OLDA=0, ROOT=$NA(^ XTMP("XPDI ",XPDA,"KR N",8989.5) )
  3239   "RTN","XPD IA3",16,0)
  3240    F  S OLDA =$O(@ROOT@ (OLDA)) Q: 'OLDA  D
  3241   "RTN","XPD IA3",17,0)
  3242    . S XP1=@ ROOT@(OLDA ,0)
  3243   "RTN","XPD IA3",18,0)
  3244    . S $P(XP 1,U,1)=PE_ ";DIC(9.4, " ;entity
  3245   "RTN","XPD IA3",19,0)
  3246    . S $P(XP 1,U,2)=$$L K^XPDIA($N A(^XTV(898 9.51)),$P( XP1,U,2))
  3247   "RTN","XPD IA3",20,0)
  3248    . S DA=$$ LKPAR($P(X P1,U),$P(X P1,U,2),$P (XP1,U,3))
  3249   "RTN","XPD IA3",21,0)
  3250    . ;Remove  the curre nt entry i f we have  one
  3251   "RTN","XPD IA3",22,0)
  3252    . I DA>0  S DIK="^XT V(8989.5,"  D ^DIK
  3253   "RTN","XPD IA3",23,0)
  3254    . ;Otherw ise Add th e zero nod e, See tha t we have  a IEN
  3255   "RTN","XPD IA3",24,0)
  3256    . I DA'>0  D ADDPAR( $P(XP1,U), $P(XP1,U,2 ),$P(XP1,U ,3)) S DA= $$LKPAR($P (XP1,U),$P (XP1,U,2), $P(XP1,U,3 ))
  3257   "RTN","XPD IA3",25,0)
  3258    . Q:'DA   ;don't hav e a entry
  3259   "RTN","XPD IA3",26,0)
  3260    . ;Merge  the date ; with IHS f ix
  3261   "RTN","XPD IA3",27,0)
  3262    . M ^XTV( 8989.5,DA) =^XTMP("XP DI",XPDA," KRN",8989. 5,OLDA)
  3263   "RTN","XPD IA3",28,0)
  3264    . S ^XTV( 8989.5,DA, 0)=XP1 ;ze ro node wi th new poi nters
  3265   "RTN","XPD IA3",29,0)
  3266    . ;Get De finition a nd check i f Data Typ e is point er, then g et pointed  to global  ref.
  3267   "RTN","XPD IA3",30,0)
  3268    . S PT=$G (^XTV(8989 .51,+$P(XP 1,U,2),1))  D:$P(PT,U )="P"
  3269   "RTN","XPD IA3",31,0)
  3270    . . S XP3 =$G(^XTV(8 989.5,DA,1 )),PT=$P(P T,U,2)
  3271   "RTN","XPD IA3",32,0)
  3272    . . S:PT  $P(XP3,U)= $$FIND1^DI C(PT,"","X ",$P(XP3,U )) ;resolv e pointer  value
  3273   "RTN","XPD IA3",33,0)
  3274    . . S:$P( XP3,U) ^XT V(8989.5,D A,1)=XP3
  3275   "RTN","XPD IA3",34,0)
  3276    . ;X-ref  it
  3277   "RTN","XPD IA3",35,0)
  3278    . S DIK=" ^XTV(8989. 5," D IX1^ DIK
  3279   "RTN","XPD IA3",36,0)
  3280    Q
  3281   "RTN","XPD IA3",37,0)
  3282    ;
  3283   "RTN","XPD IA3",38,0)
  3284   LKPAR(ENT, PAR,INST)  ;Lookup an  entry
  3285   "RTN","XPD IA3",39,0)
  3286    Q $O(^XTV (8989.5,"A C",PAR,ENT ,INST,0))
  3287   "RTN","XPD IA3",40,0)
  3288    ;
  3289   "RTN","XPD IA3",41,0)
  3290   ADDPAR(ENT ,PAR,INST)  ;Add a pa rameter in stance
  3291   "RTN","XPD IA3",42,0)
  3292    N FDA,FDA IEN,DIERR
  3293   "RTN","XPD IA3",43,0)
  3294    S FDA(898 9.5,"+1,", .01)=ENT
  3295   "RTN","XPD IA3",44,0)
  3296    S FDA(898 9.5,"+1,", .02)=PAR
  3297   "RTN","XPD IA3",45,0)
  3298    S FDA(898 9.5,"+1,", .03)=INST
  3299   "RTN","XPD IA3",46,0)
  3300    D UPDATE^ DIE("","FD A","FDAIEN ","DIERR")
  3301   "RTN","XPD IA3",47,0)
  3302    Q
  3303   "RTN","XPD IA3",48,0)
  3304    ;
  3305   "RTN","XPD IA3",49,0)
  3306   PAR1F1 ;PA RAMETER Fi le 8989.51 : file Pre
  3307   "RTN","XPD IA3",50,0)
  3308    Q
  3309   "RTN","XPD IA3",51,0)
  3310   PAR1E1 ;PA RAMETER fi le 8989.51 : entry pr e
  3311   "RTN","XPD IA3",52,0)
  3312    N XP1,XP2 ,XP3
  3313   "RTN","XPD IA3",53,0)
  3314    S ^TMP($J ,"XPD",DA) =""
  3315   "RTN","XPD IA3",54,0)
  3316    ;if there  is a new  Descriptio n, kill th e old Desc ription
  3317   "RTN","XPD IA3",55,0)
  3318    K:$O(^XTM P("XPDI",X PDA,"KRN", 8989.51,OL DA,20,0))  ^XTV(8989. 51,DA,20)
  3319   "RTN","XPD IA3",56,0)
  3320    ;Kill any  old Allow able entri es
  3321   "RTN","XPD IA3",57,0)
  3322    K:$O(^XTM P("XPDI",X PDA,"KRN", 8989.51,OL DA,30,0))  ^XTV(8989. 51,DA,30)
  3323   "RTN","XPD IA3",58,0)
  3324    Q
  3325   "RTN","XPD IA3",59,0)
  3326   PAR1F2 ;PA RAMETER fi le 8989.51 : file pos t
  3327   "RTN","XPD IA3",60,0)
  3328    N XPD,DIK ,DA
  3329   "RTN","XPD IA3",61,0)
  3330    S DA=0
  3331   "RTN","XPD IA3",62,0)
  3332    F  S DA=$ O(^TMP($J, "XPD",DA))  Q:'DA  D
  3333   "RTN","XPD IA3",63,0)
  3334    . S DIK=" ^XTV(8989. 51," D IX1 ^DIK
  3335   "RTN","XPD IA3",64,0)
  3336    D PAR0F2  ;Go load t he entries  from 8989 .5
  3337   "RTN","XPD IA3",65,0)
  3338    Q
  3339   "RTN","XPD IA3",66,0)
  3340   PAR1DEL(RT ) ;Delete  Parameter  Def entrie s
  3341   "RTN","XPD IA3",67,0)
  3342    D DELPTR^ XPDUTL1(89 89.51,RT)  ;Cleanup p ointers
  3343   "RTN","XPD IA3",68,0)
  3344    D DELIEN^ XPDUTL1(89 89.51,RT)  ;Cleanup e ntries
  3345   "RTN","XPD IA3",69,0)
  3346    Q
  3347   "RTN","XPD IA3",70,0)
  3348    ;
  3349   "RTN","XPD IA3",71,0)
  3350   PAR2F1 ;PA RAMETER TE MPLATE Fil e 8989.52:  file Pre
  3351   "RTN","XPD IA3",72,0)
  3352    K ^TMP($J ,"XPD")
  3353   "RTN","XPD IA3",73,0)
  3354    Q
  3355   "RTN","XPD IA3",74,0)
  3356   PAR2E1 ;PA RAMETER TE MPLATE fil e 8989.52:  entry Pre
  3357   "RTN","XPD IA3",75,0)
  3358    N XP1,XP2 ,ROOT
  3359   "RTN","XPD IA3",76,0)
  3360    S ROOT=$N A(^XTMP("X PDI",XPDA, "KRN",8989 .52))
  3361   "RTN","XPD IA3",77,0)
  3362    S XP2=$P( @ROOT@(OLD A,0),U,4)  ;Use insta nce of
  3363   "RTN","XPD IA3",78,0)
  3364    ;Because  we change  the transp ort global  see that  a restart  will work
  3365   "RTN","XPD IA3",79,0)
  3366    I $L(XP2) ,XP2?1A.E  S $P(@ROOT @(OLDA,0), U,4)=$$LK^ XPDIA($NA( ^XTV(8989. 51)),XP2)
  3367   "RTN","XPD IA3",80,0)
  3368    S XP1=0
  3369   "RTN","XPD IA3",81,0)
  3370    F  S XP1= $O(@ROOT@( OLDA,10,XP 1)),XP2=""  Q:'XP1  D
  3371   "RTN","XPD IA3",82,0)
  3372    . S XP2=$ P(@ROOT@(O LDA,10,XP1 ,0),U,2) ; Parameter
  3373   "RTN","XPD IA3",83,0)
  3374    . I $L(XP 2),XP2?1A. E S $P(@RO OT@(OLDA,1 0,XP1,0),U ,2)=$$LK^X PDIA($NA(^ XTV(8989.5 1)),XP2)
  3375   "RTN","XPD IA3",84,0)
  3376    . Q
  3377   "RTN","XPD IA3",85,0)
  3378    ;kill the  Parameter  multiple  at the sit e
  3379   "RTN","XPD IA3",86,0)
  3380    K ^XTV(89 89.52,DA,1 0)
  3381   "RTN","XPD IA3",87,0)
  3382    Q
  3383   "RTN","XPD IA3",88,0)
  3384   PAR2F2 ;PA RAMETER TE MPLATE fil e 8989.52:  file Post
  3385   "RTN","XPD IA3",89,0)
  3386    Q
  3387   "RTN","XPD IA3",90,0)
  3388   PAR2DEL(RT ) ;Delete  Parameter  Templates
  3389   "RTN","XPD IA3",91,0)
  3390    D DELIEN^ XPDUTL1(89 89.52,RT)
  3391   "RTN","XPD IA3",92,0)
  3392    Q
  3393   "RTN","XPD IA3",93,0)
  3394   XULM ;XULM  LOCK DICT IONARY fil e 8993; en try Pre
  3395   "RTN","XPD IA3",94,0)
  3396    N XP1,XP2 ,ROOT
  3397   "RTN","XPD IA3",95,0)
  3398    S ROOT=$N A(^XTMP("X PDI",XPDA, "KRN",8993 ))
  3399   "RTN","XPD IA3",96,0)
  3400    ;repoint  PACKAGE (1 ;1)
  3401   "RTN","XPD IA3",97,0)
  3402    S XP1=$P( $G(@ROOT@( OLDA,1)),U )
  3403   "RTN","XPD IA3",98,0)
  3404    I XP1]""  S XP1=$$LK ^XPDIA("^D IC(9.4)",X P1),$P(@RO OT@(OLDA,1 ),U)=XP1
  3405   "RTN","XPD IA3",99,0)
  3406    ;check WP  fields, i f new then  delete ol d at site
  3407   "RTN","XPD IA3",100,0 )
  3408    ;USAGE #4
  3409   "RTN","XPD IA3",101,0 )
  3410    K:$O(@ROO T@(OLDA,4, 0)) ^XLM(8 993,DA,4)
  3411   "RTN","XPD IA3",102,0 )
  3412    ;DESCRIPT ION #2, un der COMPUT ABLE FILE  REFERENCES  #3 multip le
  3413   "RTN","XPD IA3",103,0 )
  3414    ;XP1 is a  file numb er and is  the same o n all syst ems
  3415   "RTN","XPD IA3",104,0 )
  3416    S XP1=0
  3417   "RTN","XPD IA3",105,0 )
  3418    F  S XP1= $O(@ROOT@( OLDA,3,XP1 )) Q:'XP1   I $O(^(XP 1,2,0)) K  ^XLM(8993, DA,3,XP1,2 )
  3419   "RTN","XPD IA3",106,0 )
  3420    Q
  3421   "RTN","XPD IGP")
  3422   0^1^B16340 784
  3423   "RTN","XPD IGP",1,0)
  3424   XPDIGP ;SF ISC/RSD -  load Globa l Distribu tion ;08/2 5/2014
  3425   "RTN","XPD IGP",2,0)
  3426    ;;8.0;KER NEL;**41,4 22,672**;J ul 10, 199 5;Build 7
  3427   "RTN","XPD IGP",3,0)
  3428    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  3429   "RTN","XPD IGP",4,0)
  3430    ;XPDT is  undefine i f PKG^XPDI L1 aborted , need to  close devi ce
  3431   "RTN","XPD IGP",5,0)
  3432    I '$D(XPD T) D ^%ZIS C Q
  3433   "RTN","XPD IGP",6,0)
  3434    N %,XPD,X PDIST,XPDB LD,XPDNM
  3435   "RTN","XPD IGP",7,0)
  3436    S XPDA=+X PDT(1),XPD NM=$P(XPDT (1),U,2),X PDBLD=$O(^ XTMP("XPDI ",XPDA,"BL D",0))
  3437   "RTN","XPD IGP",8,0)
  3438    ;update I nstall fil e, read in  the other  globals,  close devi ce
  3439   "RTN","XPD IGP",9,0)
  3440    D XPCK,GP I:'$G(XPDQ UIT),^%ZIS C
  3441   "RTN","XPD IGP",10,0)
  3442    I $G(XPDQ UIT) D ABR TALL^XPDI( 1) Q
  3443   "RTN","XPD IGP",11,0)
  3444    ;run post  install r outine
  3445   "RTN","XPD IGP",12,0)
  3446    S XPD=$$I NRTN^XPDIL 1("INIT")  I XPD]"" D
  3447   "RTN","XPD IGP",13,0)
  3448    .;% = rou tine name  only, remo ve tag
  3449   "RTN","XPD IGP",14,0)
  3450    .S %=$P(X PD,U,$L(XP D,U)) Q:'$ D(^XTMP("X PDI",XPDA, "RTN",%))
  3451   "RTN","XPD IGP",15,0)
  3452    .W ! D SA VE^XPDIJ(% ),BMES^XPD UTL(" Runn ing Post I nstall rou tine "_XPD ),@XPD
  3453   "RTN","XPD IGP",16,0)
  3454    .;update  Package fi le
  3455   "RTN","XPD IGP",17,0)
  3456    ;XPDIST i s flag for  site trac king, it i s set in P KG^XPDIP
  3457   "RTN","XPD IGP",18,0)
  3458    S XPDIST= 0 D BMES^X PDUTL(" Up dating KID S files...  "),PKG^XP DIP
  3459   "RTN","XPD IGP",19,0)
  3460    ;sends si te trackin g bulletin
  3461   "RTN","XPD IGP",20,0)
  3462    ;I XPDIST  S %=$$EN^ XPDIST(XPD A) D BMES^ XPDUTL(" " _$P("NO ", U,'%)_"Ins tall Messa ge sent to  FORUM ")  ; p672remo ved
  3463   "RTN","XPD IGP",21,0)
  3464    I XPDIST  S %=$$EN^X PDIST(XPDA ) D BMES^X PDUTL(" "_ $P("NO ",U ,'$P(%,"#" ,2))_"Inst all Messag e sent "_% ) ; p672 S end tracki ng message  to Forum.
  3465   "RTN","XPD IGP",22,0)
  3466    W !! D BM ES^XPDUTL( " "_XPDNM_ " Installe d."),STMP^ XPDIJ1(17)  W !!
  3467   "RTN","XPD IGP",23,0)
  3468    K ^XTMP(" XPDI",XPDA ),XPD
  3469   "RTN","XPD IGP",24,0)
  3470    ;update t he status  field
  3471   "RTN","XPD IGP",25,0)
  3472    S XPD(9.7 ,XPDA_",", .02)=3 D F ILE^DIE("" ,"XPD")
  3473   "RTN","XPD IGP",26,0)
  3474    Q
  3475   "RTN","XPD IGP",27,0)
  3476   DISP ;disp lay the co ntents
  3477   "RTN","XPD IGP",28,0)
  3478    N X,Y,Z
  3479   "RTN","XPD IGP",29,0)
  3480    W !,"This  is a Glob al Distrib ution. It  contains G lobal(s) t hat will", !,"update  your syste m at this  time. The  following  Global(s)  will be in stalled:", !!
  3481   "RTN","XPD IGP",30,0)
  3482    F Y=1:1 S  X=$P(XPDG P,"^",Y) Q :X=""  D
  3483   "RTN","XPD IGP",31,0)
  3484    .S Z=+$P( X,";"),X=$ P(X,";",2) ,XPDT("GP" ,X)=Z_U_Y
  3485   "RTN","XPD IGP",32,0)
  3486    .W "^"_X, ?12,$P("Ov erwrite^Re place",U,Z +1),!
  3487   "RTN","XPD IGP",33,0)
  3488    .;if unsu bscripted  global and  replacing
  3489   "RTN","XPD IGP",34,0)
  3490    .W:X'["(" &Z "**WARN ING - Glob al will be  KILLED be fore insta ll,",!,"Ch eck global  protectio n on ALL s ystems bef ore contin uing.",!
  3491   "RTN","XPD IGP",35,0)
  3492    W !,"If y ou continu e with the  Load, the  Global(s)  will be", !,"Install ed at this  time.",!
  3493   "RTN","XPD IGP",36,0)
  3494    Q
  3495   "RTN","XPD IGP",37,0)
  3496   GPI ;globa l package  input
  3497   "RTN","XPD IGP",38,0)
  3498    N DIRUT,G P,GR,X,XPD SEQ,Y,Z
  3499   "RTN","XPD IGP",39,0)
  3500    ;start re ading the  HFS again,   rwf, cha nged all r ead timeou t from 0 t o 1.
  3501   "RTN","XPD IGP",40,0)
  3502    U IO R X: 10,Y:10
  3503   "RTN","XPD IGP",41,0)
  3504    ;the next  read must  be the GL OBAL
  3505   "RTN","XPD IGP",42,0)
  3506    I X'="**G LOBAL**" U  IO(0) W ! !,"ERROR i n HFS file  format!"  S XPDQUIT= 1 Q
  3507   "RTN","XPD IGP",43,0)
  3508    U IO(0) D  BMES^XPDU TL(" "_Y)  U IO
  3509   "RTN","XPD IGP",44,0)
  3510    ;XPDSEQ i s the disk  sequence  number
  3511   "RTN","XPD IGP",45,0)
  3512    S GP=$P(Y ,U,2),GR=$ S(Y[")":$E (Y,1,$L(Y) -1)_",",1: Y_"("),XPD SEQ=1
  3513   "RTN","XPD IGP",46,0)
  3514    K:XPDT("G P",GP) @Y
  3515   "RTN","XPD IGP",47,0)
  3516    ;X=global  ref, Y=gl obal value . DIRUT is  when user  is prompt ed for
  3517   "RTN","XPD IGP",48,0)
  3518    ;next dis k in NEXTD  and they  abort
  3519   "RTN","XPD IGP",49,0)
  3520    F  R X:10 ,Y:10 Q:X= "**END**"   D  I $D(D IRUT) S XP DQUIT=1 Q
  3521   "RTN","XPD IGP",50,0)
  3522    .;new glo bal
  3523   "RTN","XPD IGP",51,0)
  3524    .I X="**G LOBAL**" D   Q
  3525   "RTN","XPD IGP",52,0)
  3526    ..;comple tes last g lobal chec k point
  3527   "RTN","XPD IGP",53,0)
  3528    ..D XPCOM (GP,Y)
  3529   "RTN","XPD IGP",54,0)
  3530    ..;reset  global ref
  3531   "RTN","XPD IGP",55,0)
  3532    ..S GP=$P (Y,U,2),GR =$S(Y[")": $E(Y,1,$L( Y)-1)_",", 1:Y_"(")
  3533   "RTN","XPD IGP",56,0)
  3534    ..;kill g lobal if f lag is set
  3535   "RTN","XPD IGP",57,0)
  3536    ..K:XPDT( "GP",GP) @ Y
  3537   "RTN","XPD IGP",58,0)
  3538    .;I X="** CONTINUE** " D NEXTD^ XPDIL Q ;r emoved on  p651: The  line in XP DIGP needs  to be rem oved.  X=" **CONTINUE **" will o nly happen  if the fi le was on  multiple d iskettes. 
  3539   "RTN","XPD IGP",59,0)
  3540    .S @(GR_X )=Y
  3541   "RTN","XPD IGP",60,0)
  3542    D XPCOM(G P)
  3543   "RTN","XPD IGP",61,0)
  3544    U IO(0)
  3545   "RTN","XPD IGP",62,0)
  3546    Q
  3547   "RTN","XPD IGP",63,0)
  3548    ;
  3549   "RTN","XPD IGP",64,0)
  3550    ;create G lobal mult iple of In stall file
  3551   "RTN","XPD IGP",65,0)
  3552   XPCK N DIR ,DIRUT,X,X PD,XPDJ,X, Y,Z
  3553   "RTN","XPD IGP",66,0)
  3554    S DIR(0)= "Y",DIR("A ")="Global s will now  be instal led, OK",D IR("B")="Y ES",DIR("? ")="YES wi ll continu e with ins tall, NO w ill abort  install"
  3555   "RTN","XPD IGP",67,0)
  3556    W ! D ^DI R I $D(DIR UT)!'Y S X PDQUIT=1 Q
  3557   "RTN","XPD IGP",68,0)
  3558    W ! D BME S^XPDUTL("  Install S tarted for  "_XPDNM_"  : "),STMP ^XPDIJ1(11 ),BMES^XPD UTL(" Inst alling Glo bals:")
  3559   "RTN","XPD IGP",69,0)
  3560    S X=""
  3561   "RTN","XPD IGP",70,0)
  3562    F  S X=$O (XPDT("GP" ,X)) Q:X=" "  S Z=$P( XPDT("GP", X),U,2),XP D(9.718,"+ "_Z_","_XP DA_",",.01 )=X,XPDJ(Z )=Z
  3563   "RTN","XPD IGP",71,0)
  3564    D:$D(XPD) >9 UPDATE^ DIE("S","X PD","XPDJ" )
  3565   "RTN","XPD IGP",72,0)
  3566    Q
  3567   "RTN","XPD IGP",73,0)
  3568    ;
  3569   "RTN","XPD IGP",74,0)
  3570   XPCOM(X,XP DN) ;compl ete checkp oint for g lobal X,XP DN=next gl obal
  3571   "RTN","XPD IGP",75,0)
  3572    N GR,GP,X PD,Y,Z
  3573   "RTN","XPD IGP",76,0)
  3574    U IO(0)
  3575   "RTN","XPD IGP",77,0)
  3576    S Y=$$NOW ^XLFDT,Z=+ $P(XPDT("G P",X),U,2) ,XPD(9.718 ,Z_","_XPD A_",",1)=Y
  3577   "RTN","XPD IGP",78,0)
  3578    D MES^XPD UTL("                 "_$$FMTE^X LFDT(Y)),F ILE^DIE("" ,"XPD")
  3579   "RTN","XPD IGP",79,0)
  3580    D:$L($G(X PDN)) BMES ^XPDUTL("  "_XPDN)
  3581   "RTN","XPD IGP",80,0)
  3582    U IO
  3583   "RTN","XPD IGP",81,0)
  3584    Q
  3585   "RTN","XPD IJ")
  3586   0^4^B25041 581
  3587   "RTN","XPD IJ",1,0)
  3588   XPDIJ ;SFI SC/RSD - I nstall Job  ;08/14/20 08
  3589   "RTN","XPD IJ",2,0)
  3590    ;;8.0;KER NEL;**2,21 ,28,41,44, 68,81,95,1 08,124,229 ,275,506,6 72**;Jul 1 0, 1995;Bu ild 7
  3591   "RTN","XPD IJ",3,0)
  3592    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  3593   "RTN","XPD IJ",4,0)
  3594   EN ;instal l all pack ages
  3595   "RTN","XPD IJ",5,0)
  3596    ;XPDA=ien  of first  package
  3597   "RTN","XPD IJ",6,0)
  3598    ;this is  needed to  restore XP DIJ1
  3599   "RTN","XPD IJ",7,0)
  3600    D LNRF("X PDUTL") ;p 275 SAVE c alls RTNLO G^XPDUTL
  3601   "RTN","XPD IJ",8,0)
  3602    D LNRF("X PDIJ1") ;S ee that XP DIJ1 is lo aded befor  it is cal led
  3603   "RTN","XPD IJ",9,0)
  3604    N IEN,XPD I,XPD0,XPD SET,XPDABO RT,XPDMENU ,XPDQUIT,X PDVOL,X,Y, ZTRTN,ZTDT H,ZTIO,ZTD ESC,ZTSK
  3605   "RTN","XPD IJ",10,0)
  3606    M X=DUZ N  DUZ M DUZ =X S DUZ(0 )="@" ;See  that inst all has fu ll FM priv .
  3607   "RTN","XPD IJ",11,0)
  3608    I $$NEWER R^%ZTER N  $ETRAP,$ES TACK S $ET RAP="D ERR ^XPDIJ"
  3609   "RTN","XPD IJ",12,0)
  3610    E  S X="E RR^XPDIJ", @^%ZOSF("T RAP")
  3611   "RTN","XPD IJ",13,0)
  3612    ;check th at Install  entry exi sts, set s tatus to " Start of I nstall"
  3613   "RTN","XPD IJ",14,0)
  3614    Q:'$D(^XP D(9.7,+$G( XPDA),0))   S XPD0=^( 0),$P(^(0) ,U,9)=2
  3615   "RTN","XPD IJ",15,0)
  3616    D INIT^XP DID
  3617   "RTN","XPD IJ",16,0)
  3618    ;See if n eed to Inh ibit Logon s
  3619   "RTN","XPD IJ",17,0)
  3620    I $$ANSWE R^XPDIQ("X PI1") D IN HIBIT^XPDI J1("Y")
  3621   "RTN","XPD IJ",18,0)
  3622    ;disable  options &  protocols  for setnam e, XPDSET= 1/0^setnam e^out of o rder msg.
  3623   "RTN","XPD IJ",19,0)
  3624    S Y=$P(XP D0,U,8),XP DSET=+Y_U_ $E(Y,2,99) _U_$S($L(Y ):$P($G(^X TMP("XQOO" ,$E(Y,2,99 ),0)),U),1 :"")
  3625   "RTN","XPD IJ",20,0)
  3626    ;hang the  number of  seconds g iven in 0; 10
  3627   "RTN","XPD IJ",21,0)
  3628    I XPDSET  D OFF^XQOO 1($P(XPDSE T,U,2)) I  $P(XPD0,U, 10) H ($P( XPD0,U,10) *60)
  3629   "RTN","XPD IJ",22,0)
  3630    ;check th at Install  still exi sts, wasn' t unloaded
  3631   "RTN","XPD IJ",23,0)
  3632    I '$D(^XP D(9.7,XPDA ,0))!'$D(^ XTMP("XPDI ",XPDA)) D  EXIT^XPDI D(" Build  NOT instal led, Trans port Globa l missing! !!!") Q
  3633   "RTN","XPD IJ",24,0)
  3634    S Y=0
  3635   "RTN","XPD IJ",25,0)
  3636    ;XPDABORT  can be se t in pre o r post ins tall to ab ort instal l
  3637   "RTN","XPD IJ",26,0)
  3638    F  S Y=$O (^XPD(9.7, "ASP",XPDA ,Y)) Q:'Y   S %=$O(^( Y,0)) D:%   Q:$D(XPDA BORT)
  3639   "RTN","XPD IJ",27,0)
  3640    .N XPD,XP DA,XPDNM,X PDV,XPDV0, XPDVOL,XPD X,XPDY,Y
  3641   "RTN","XPD IJ",28,0)
  3642    .;Now do  the Instal l
  3643   "RTN","XPD IJ",29,0)
  3644    .S XPDA=% ,XPDNM=$P( $G(^XPD(9. 7,XPDA,0)) ,U) D IN^X PDIJ1 Q:$D (XPDABORT)
  3645   "RTN","XPD IJ",30,0)
  3646    ;
  3647   "RTN","XPD IJ",31,0)
  3648    ;Now do M aster Buil d Post INI T.
  3649   "RTN","XPD IJ",32,0)
  3650    I '$D(XPD ABORT),$D( XPDT("MAST ER")) D
  3651   "RTN","XPD IJ",33,0)
  3652    .N XPDBLD ,XPDGREF
  3653   "RTN","XPD IJ",34,0)
  3654    .S XPDBLD =$O(^XTMP( "XPDI",XPD A,"BLD",0) ),XPDGREF= "^XTMP(""X PDI"","_XP DA_",""TEM P"")"
  3655   "RTN","XPD IJ",35,0)
  3656    .D POST^X PDIJ1
  3657   "RTN","XPD IJ",36,0)
  3658    ;ZTREQ te lls taskma n to delet e task
  3659   "RTN","XPD IJ",37,0)
  3660    I $G(ZTSK ) S ZTREQ= "@" D
  3661   "RTN","XPD IJ",38,0)
  3662    .;remove  task # fro m Install  File
  3663   "RTN","XPD IJ",39,0)
  3664    .N XPD S  XPD(9.7,XP DA_",",5)= "@"
  3665   "RTN","XPD IJ",40,0)
  3666    .D FILE^D IE("","XPD ")
  3667   "RTN","XPD IJ",41,0)
  3668    ;quit if  install wa s aborted
  3669   "RTN","XPD IJ",42,0)
  3670    I $D(XPDA BORT) D EX IT^XPDID(" Install Ab orted!!"), ^%ZISC Q
  3671   "RTN","XPD IJ",43,0)
  3672    ;put opti on back in  order
  3673   "RTN","XPD IJ",44,0)
  3674    I $P(XPDS ET,U,2)]""  D ON^XQOO 1($P(XPDSE T,U,2)) K  ^XTMP("XQO O",$P(XPDS ET,U,2))
  3675   "RTN","XPD IJ",45,0)
  3676    ;check if  menu rebu ild is wan ted (only  if option  has been a dded to an y installs )
  3677   "RTN","XPD IJ",46,0)
  3678    ;XPDMENU  is used to  check tha t it is on ly done on ce
  3679   "RTN","XPD IJ",47,0)
  3680    S (Y,XPDM ENU)=0
  3681   "RTN","XPD IJ",48,0)
  3682    F  S Y=$O (^XPD(9.7, "ASP",XPDA ,Y)) Q:'Y   S %=$O(^( Y,0)) D:%   Q:XPDMENU
  3683   "RTN","XPD IJ",49,0)
  3684    .N XPDA,Y
  3685   "RTN","XPD IJ",50,0)
  3686    .S XPDA=%
  3687   "RTN","XPD IJ",51,0)
  3688    .I $$ANSW ER^XPDIQ(" XPO1") D B MES^XPDUTL (" Call ME NU rebuild "),KIDS^XQ 81 S XPDME NU=1
  3689   "RTN","XPD IJ",52,0)
  3690    .;There s hould be n o reason t o check ot her CPUs a nymore, pa tch 496
  3691   "RTN","XPD IJ",53,0)
  3692    .Q
  3693   "RTN","XPD IJ",54,0)
  3694    .;check i f need to  queue menu  rebuild o n other CP Us
  3695   "RTN","XPD IJ",55,0)
  3696    .D:$O(^XP D(9.7,XPDA ,"VOL",0))
  3697   "RTN","XPD IJ",56,0)
  3698    ..N XPDU, XPDY,XPDV, XPDV0,ZTUC I,ZTCPU
  3699   "RTN","XPD IJ",57,0)
  3700    ..X ^%ZOS F("UCI") S  XPDU=$P(Y ,","),XPDY =$P(Y,",", 2),XPDV=0
  3701   "RTN","XPD IJ",58,0)
  3702    ..;loop t hru VOLUME S SET and  don't do c urrent vol ume set
  3703   "RTN","XPD IJ",59,0)
  3704    ..F  S XP DV=$O(^XPD (9.7,XPDA, "VOL",XPDV )) Q:'XPDV   S XPDV0= $P(^(XPDV, 0),U) D:XP DV0'=XPDY
  3705   "RTN","XPD IJ",60,0)
  3706    ...S ZTUC I=XPDU,ZTD TH=$H,ZTIO ="",ZTDESC ="Install  Menu Rebui ld",ZTCPU= XPDV0,ZTRT N="KIDS^XQ 81" D ^%ZT LOAD
  3707   "RTN","XPD IJ",61,0)
  3708    ;
  3709   "RTN","XPD IJ",62,0)
  3710    ;See if n eed to res et inhibit  logons
  3711   "RTN","XPD IJ",63,0)
  3712    I $$ANSWE R^XPDIQ("X PI1") D IN HIBIT^XPDI J1("N")
  3713   "RTN","XPD IJ",64,0)
  3714    ;
  3715   "RTN","XPD IJ",65,0)
  3716    ;clean up  globals
  3717   "RTN","XPD IJ",66,0)
  3718    S Y=0
  3719   "RTN","XPD IJ",67,0)
  3720    F  S Y=$O (^XPD(9.7, "ASP",XPDA ,Y)) Q:'Y   S XPDI=$O (^(Y,0)) D :XPDI
  3721   "RTN","XPD IJ",68,0)
  3722    . N %,Y,X PD,X
  3723   "RTN","XPD IJ",69,0)
  3724    . ;See if  need to d elete Env, Pre,Post r outines.
  3725   "RTN","XPD IJ",70,0)
  3726    . S %=$O( ^XTMP("XPD I",XPDI,"B LD",0)),XP D=$G(^XTMP ("XPDI",XP DI,"BLD",% ,"INID"))
  3727   "RTN","XPD IJ",71,0)
  3728    . I '$$GE T^XUPARAM( "XPD NO_EP P_DELETE")  F %=1:1:3  I $P(XPD, U,%)="y" D
  3729   "RTN","XPD IJ",72,0)
  3730    . . S X=^ XTMP("XPDI ",XPDI,$P( "PRE^INIT^ INI",U,%))  S:X[U X=$ P(X,U,2) X :X]"" ^%ZO SF("DEL")
  3731   "RTN","XPD IJ",73,0)
  3732    . ;kill t ransport g lobal
  3733   "RTN","XPD IJ",74,0)
  3734    . K ^XTMP ("XPDI",XP DI)
  3735   "RTN","XPD IJ",75,0)
  3736    . ;update  the statu s field
  3737   "RTN","XPD IJ",76,0)
  3738    . S XPD(9 .7,XPDI_", ",.02)=3
  3739   "RTN","XPD IJ",77,0)
  3740    . D FILE^ DIE("","XP D")
  3741   "RTN","XPD IJ",78,0)
  3742    D EXIT^XP DID("Insta ll Complet ed"),^%ZIS C
  3743   "RTN","XPD IJ",79,0)
  3744    Q
  3745   "RTN","XPD IJ",80,0)
  3746    ;
  3747   "RTN","XPD IJ",81,0)
  3748   SAVE(X) ;r estore rou tine X
  3749   "RTN","XPD IJ",82,0)
  3750    N %,DIE,X CM,XCN,XCS
  3751   "RTN","XPD IJ",83,0)
  3752    S DIE="^X TMP(""XPDI "",XPDA,"" RTN"",X,", XCN=0
  3753   "RTN","XPD IJ",84,0)
  3754    X ^%ZOSF( "SAVE") D  RTNLOG^XPD UTL(X)
  3755   "RTN","XPD IJ",85,0)
  3756    Q
  3757   "RTN","XPD IJ",86,0)
  3758   RTN(XPDA)  ;restore a ll routine s for pack age XPDA
  3759   "RTN","XPD IJ",87,0)
  3760    ;^XPD("XP DI",XPDA," RTN",routi ne name)=0 -install,  1-delete,  2-skip^che cksum
  3761   "RTN","XPD IJ",88,0)
  3762    Q:$G(XPDA )=""
  3763   "RTN","XPD IJ",89,0)
  3764    N X,XPDI, XPDJ S XPD I=""
  3765   "RTN","XPD IJ",90,0)
  3766    F  S XPDI =$O(^XTMP( "XPDI",XPD A,"RTN",XP DI)) Q:XPD I=""  S XP DJ=^(XPDI)  D
  3767   "RTN","XPD IJ",91,0)
  3768    .;if we a re doing V T graphic  display, s et counter
  3769   "RTN","XPD IJ",92,0)
  3770    .I $D(XPD IDVT) S XP DIDCNT=XPD IDCNT+1 D: '(XPDIDCNT #XPDIDMOD)  UPDATE^XP DID(XPDIDC NT)
  3771   "RTN","XPD IJ",93,0)
  3772    .I 'XPDJ  D SAVE(XPD I) Q
  3773   "RTN","XPD IJ",94,0)
  3774    .;set che cksum to n ull, since  routine w asn't load ed
  3775   "RTN","XPD IJ",95,0)
  3776    .I $P(XPD J,U,2) S $ P(^XTMP("X PDI",XPDA, "BLD",XPDB LD,"KRN",9 .8,"NM",$P (XPDJ,U,2) ,0),U,4)=" "
  3777   "RTN","XPD IJ",96,0)
  3778    .I $P(XPD J,U)=1 S X =XPDI X ^% ZOSF("DEL" )
  3779   "RTN","XPD IJ",97,0)
  3780    ;if graph ic display , update f ull count
  3781   "RTN","XPD IJ",98,0)
  3782    I $D(XPDI DVT) D UPD ATE^XPDID( XPDIDCNT)
  3783   "RTN","XPD IJ",99,0)
  3784    Q
  3785   "RTN","XPD IJ",100,0)
  3786    ;
  3787   "RTN","XPD IJ",101,0)
  3788   VOLERR(V,F ) ;volume  set not up dated,V=vo lume set,  F=flag
  3789   "RTN","XPD IJ",102,0)
  3790    N XQA,XQA MSG,XPDMES
  3791   "RTN","XPD IJ",103,0)
  3792    S XPDMES( 1)=" ",XPD MES(2)=" * * Job on V OLUME SET  "_V_$S(F:"  never sta rted **",1 :" has bee n idle for  an hour." )
  3793   "RTN","XPD IJ",104,0)
  3794    S XPDMES( 3)=" ** "_ V_" has NO T been upd ated! **"
  3795   "RTN","XPD IJ",105,0)
  3796    S XQA(DUZ )="",XQAMS G="VOLUME  SET "_V_"  NOT update d for Inst all "_$E($ P($G(^XPD( 9.7,+$G(XP DA),0)),"^ "),1,30)
  3797   "RTN","XPD IJ",106,0)
  3798    D MES^XPD UTL(.XPDME S),SETUP^X QALERT
  3799   "RTN","XPD IJ",107,0)
  3800    Q
  3801   "RTN","XPD IJ",108,0)
  3802    ;come her e on error , record e rror in In stall file  and clean up var.
  3803   "RTN","XPD IJ",109,0)
  3804   ERR N XPDE RROR,XQA,X QAMSG
  3805   "RTN","XPD IJ",110,0)
  3806    S XPDERRO R=$$EC^%ZO SV
  3807   "RTN","XPD IJ",111,0)
  3808    ;record e rror, writ e message,  reset ter minal
  3809   "RTN","XPD IJ",112,0)
  3810    D ^%ZTER, BMES^XPDUT L(XPDERROR ),EXIT^XPD ID()
  3811   "RTN","XPD IJ",113,0)
  3812    S XQA(DUZ )="",XQAMS G="Install  "_$E($P($ G(^XPD(9.7 ,+$G(XPDA) ,0)),"^"), 1,30)_" ha s encounte red an Err or."
  3813   "RTN","XPD IJ",114,0)
  3814    D SETUP^X QALERT G U NWIND^%ZTE R
  3815   "RTN","XPD IJ",115,0)
  3816    ;
  3817   "RTN","XPD IJ",116,0)
  3818   LNRF(RN) ; Load neede d routines  first
  3819   "RTN","XPD IJ",117,0)
  3820    I $D(^XTM P("XPDI",X PDA,"RTN", RN)) D
  3821   "RTN","XPD IJ",118,0)
  3822    .N X
  3823   "RTN","XPD IJ",119,0)
  3824    .D SAVE(R N)
  3825   "RTN","XPD IJ",120,0)
  3826    .S XCN=$$ RTNUP^XPDU TL(RN,2)
  3827   "RTN","XPD IJ",121,0)
  3828    Q
  3829   "RTN","XPD IL")
  3830   0^14^B2156 1860
  3831   "RTN","XPD IL",1,0)
  3832   XPDIL ;SFI SC/RSD - l oad Distri bution Glo bal ;05/05 /2008
  3833   "RTN","XPD IL",2,0)
  3834    ;;8.0;KER NEL;**15,4 4,58,68,10 8,422,525, 672**;Jul  10, 1995;B uild 7
  3835   "RTN","XPD IL",3,0)
  3836    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  3837   "RTN","XPD IL",4,0)
  3838    ;
  3839   "RTN","XPD IL",5,0)
  3840   EN1 N POP, XPDA,XPDST ,XPDIT,XPD T,XPDGP,XP DQUIT,XPDR EQAB,XPDSK PE
  3841   "RTN","XPD IL",6,0)
  3842    S:'$D(DT)  DT=$$DT^X LFDT S:'$D (U) U="^"
  3843   "RTN","XPD IL",7,0)
  3844    S XPDST=0
  3845   "RTN","XPD IL",8,0)
  3846    D ST I $G (XPDQUIT)  D ABRTALL^ XPDI(1) G  NONE
  3847   "RTN","XPD IL",9,0)
  3848    ;XPDST= s tarting Bu ild
  3849   "RTN","XPD IL",10,0)
  3850    ;XPDT("DA ",ien)=seq  # to inst all
  3851   "RTN","XPD IL",11,0)
  3852    ;XPDT("NM ",build na me)=seq #
  3853   "RTN","XPD IL",12,0)
  3854    ;XPDT(seq  #)=ien^Bu ild name
  3855   "RTN","XPD IL",13,0)
  3856    ;XPDT("GP ",global)=  1-replace , 0-overwr ite^ien
  3857   "RTN","XPD IL",14,0)
  3858    ;XPDGP=gl obals from  a Global  Package
  3859   "RTN","XPD IL",15,0)
  3860    ;XPDSKPE= 1 don't ru n Environm ent Check^ has questi on been as ked
  3861   "RTN","XPD IL",16,0)
  3862    S XPDIT=0 ,XPDSKPE=" 0^0"
  3863   "RTN","XPD IL",17,0)
  3864    F  S XPDI T=$O(XPDT( XPDIT)) Q: 'XPDIT  S  XPDA=+XPDT (XPDIT) D   I '$D(XPD T) Q
  3865   "RTN","XPD IL",18,0)
  3866    .;check i f this Bui ld has an  Envir. Che ck
  3867   "RTN","XPD IL",19,0)
  3868    .I $G(^XT MP("XPDI", XPDA,"PRE" ))]"" D  I  $G(XPDQUI T) D ABRTA LL^XPDI(1)  Q
  3869   "RTN","XPD IL",20,0)
  3870    ..;quit i f we alrea dy asked t his questi on
  3871   "RTN","XPD IL",21,0)
  3872    ..Q:$P(XP DSKPE,U,2)
  3873   "RTN","XPD IL",22,0)
  3874    ..S $P(XP DSKPE,U,2) =1
  3875   "RTN","XPD IL",23,0)
  3876    ..N DIR,D IRUT
  3877   "RTN","XPD IL",24,0)
  3878    ..S DIR(0 )="Y",DIR( "A")="Want  to RUN th e Environm ent Check  Routine",D IR("B")="Y ES"
  3879   "RTN","XPD IL",25,0)
  3880    ..S DIR(" A",1)="Bui ld "_$P(XP DT(XPDIT), U,2)_" has  an Enviro nmental Ch eck Routin e"
  3881   "RTN","XPD IL",26,0)
  3882    ..D ^DIR  I $D(DIRUT ) S XPDQUI T=1 Q
  3883   "RTN","XPD IL",27,0)
  3884    ..S:'Y XP DSKPE="1^1 "
  3885   "RTN","XPD IL",28,0)
  3886    .D PKG^XP DIL1(XPDA)
  3887   "RTN","XPD IL",29,0)
  3888    ;Global P ackage
  3889   "RTN","XPD IL",30,0)
  3890    G:$D(XPDG P) ^XPDIGP
  3891   "RTN","XPD IL",31,0)
  3892    I $D(XPDT ),$D(^XPD( 9.7,+XPDST ,0)) W !," Use INSTAL L NAME: ", $P(^(0),U) ," to inst all this D istributio n.",!
  3893   "RTN","XPD IL",32,0)
  3894    Q
  3895   "RTN","XPD IL",33,0)
  3896   ST ;global  input
  3897   "RTN","XPD IL",34,0)
  3898    N DIR,DIR UT,GR,IOP, X,Y,Z,%ZIS
  3899   "RTN","XPD IL",35,0)
  3900    G:'$D(^DD (3.5,0)) O PEN
  3901   "RTN","XPD IL",36,0)
  3902    I '$D(^%Z IS(1,"B"," HFS")) W ! !,"You mus t have a d evice call ed 'HFS' i n order to  load a di stribution !",*7 S XP DQUIT=1 Q
  3903   "RTN","XPD IL",37,0)
  3904    D HOME^%Z IS
  3905   "RTN","XPD IL",38,0)
  3906    S DIR(0)= "F^3:245", DIR("A")=" Enter a Ho st File",D IR("?")="E nter a fil ename and/ or path to  input Dis tribution. "
  3907   "RTN","XPD IL",39,0)
  3908    D ^DIR I  $D(DIRUT)  S XPDQUIT= 1 Q
  3909   "RTN","XPD IL",40,0)
  3910    S %ZIS="" ,%ZIS("HFS NAME")=Y,% ZIS("HFSMO DE")="R",I OP="HFS"
  3911   "RTN","XPD IL",41,0)
  3912    D ^%ZIS I  POP W !," Couldn't o pen file o r HFS devi ce!!",*7 S  XPDQUIT=1  Q
  3913   "RTN","XPD IL",42,0)
  3914    ;don't cl ose device  if we hav e a global  package,  we need to  bring in  the global s now
  3915   "RTN","XPD IL",43,0)
  3916    D GI,^%ZI SC:'$D(XPD GP)!$G(XPD QUIT)
  3917   "RTN","XPD IL",44,0)
  3918    Q
  3919   "RTN","XPD IL",45,0)
  3920    ;
  3921   "RTN","XPD IL",46,0)
  3922    ;if no de vice file,  Virgin In stall
  3923   "RTN","XPD IL",47,0)
  3924   OPEN ;use  open comma nd
  3925   "RTN","XPD IL",48,0)
  3926    N IO,IOPA R,DIR,DIRU T,DTOUT,DU OUT
  3927   "RTN","XPD IL",49,0)
  3928    S DIR(0)= "F^1:79",D IR("A")="D evice Name "
  3929   "RTN","XPD IL",50,0)
  3930    S DIR("?" ,1)="Devic e Name is  either the  name of t he HFS fil e or the n ame of the  HFS Devic e.",DIR("? ",2)="i.e.   for MSM  enter  51" ,DIR("?")= "      for  DSM enter   DISK$USE R::[ANONYM OUS]:KRN8. KID"
  3931   "RTN","XPD IL",51,0)
  3932    D ^DIR I  $D(DIRUT)  S POP=1 Q
  3933   "RTN","XPD IL",52,0)
  3934    S IO=Y,DI R(0)="FO^1 :79",DIR(" A")="Devic e Paramete rs"
  3935   "RTN","XPD IL",53,0)
  3936    S DIR("?" ,1)="Devic e Paramete r is the O pen parame ter this M  operating  system ne eds to",DI R("?",2)=" open the D evice Name .",DIR("?" ,3)="i.e.  for MSM en ter  (""B: \KRN8.KID" ":""R"")", DIR("?")="      for D SM enter   READONLY"
  3937   "RTN","XPD IL",54,0)
  3938    D ^DIR I  $D(DTOUT)! $D(DUOUT)  S POP=1 Q
  3939   "RTN","XPD IL",55,0)
  3940    S IOPAR=Y
  3941   "RTN","XPD IL",56,0)
  3942    X "O IO:" _IOPAR_":1 0" E  U $P  W !,"Coul dn't open  ",IO S POP =1 Q
  3943   "RTN","XPD IL",57,0)
  3944    S IO(0)=$ P
  3945   "RTN","XPD IL",58,0)
  3946    D GI D ^% ZISC
  3947   "RTN","XPD IL",59,0)
  3948    Q
  3949   "RTN","XPD IL",60,0)
  3950    ;
  3951   "RTN","XPD IL",61,0)
  3952   GI N X,XPD SEQ,Y,Z
  3953   "RTN","XPD IL",62,0)
  3954    U IO R X: 10,Y:10 ;r wf was :0
  3955   "RTN","XPD IL",63,0)
  3956    U IO(0) W  !!,X,!,"C omment: ", Y
  3957   "RTN","XPD IL",64,0)
  3958    S XPDST(" H")=Y,XPDS T("H1")=Y_ "  ;Create d on "_$P( X,"KIDS Di stribution  saved on  ",2)
  3959   "RTN","XPD IL",65,0)
  3960    ;Z is the  string of  Builds in  this file
  3961   "RTN","XPD IL",66,0)
  3962    U IO F X= 1:1 R Z:1  S Z=$P(Z," **KIDS**", 2,99) Q:Z= ""  S X(X) =Z
  3963   "RTN","XPD IL",67,0)
  3964    U IO(0) I  $G(X(1))= "" W !!,"T his is not  a Distrib ution HFS  File!" S X PDQUIT=1 Q
  3965   "RTN","XPD IL",68,0)
  3966    ;global p ackage, se t XPDGP=fl ag;global^ flag;globa l^...  fla g=1 replac e
  3967   "RTN","XPD IL",69,0)
  3968    I $P(X(1) ,":")="GLO BALS" S XP DGP=$P(X(1 ),U,2,99), X(1)=$P(X( 1),U)
  3969   "RTN","XPD IL",70,0)
  3970    S XPDIT=0 ,X(1)=$P(X (1),":",2, 99)
  3971   "RTN","XPD IL",71,0)
  3972    W !!,"Thi s Distribu tion conta ins Transp ort Global s for the  following  Package(s) :"
  3973   "RTN","XPD IL",72,0)
  3974    F X=1:1:X -1 F Z=1:1  S Y=$P(X( X),U,Z) Q: Y=""  D  Q :$G(XPDQUI T)
  3975   "RTN","XPD IL",73,0)
  3976    . ;can't  install if  global ex ist, that  means Buil d never fi nish insta ll
  3977   "RTN","XPD IL",74,0)
  3978    . ;INST w ill show n ame
  3979   "RTN","XPD IL",75,0)
  3980    . S XPDIT =XPDIT+1 I  '$$INST^X PDIL1(Y) S  XPDQUIT=1  Q
  3981   "RTN","XPD IL",76,0)
  3982    Q:$G(XPDQ UIT)
  3983   "RTN","XPD IL",77,0)
  3984    W !,"Dist ribution O K!",!
  3985   "RTN","XPD IL",78,0)
  3986    D:$D(XPDG P) DISP^XP DIGP
  3987   "RTN","XPD IL",79,0)
  3988    S DIR(0)= "Y",DIR("A ")="Want t o Continue  with Load ",DIR("B") ="YES"
  3989   "RTN","XPD IL",80,0)
  3990    D ^DIR I  $D(DIRUT)! 'Y S XPDQU IT=1 Q
  3991   "RTN","XPD IL",81,0)
  3992    W !,"Load ing Distri bution..." ,!
  3993   "RTN","XPD IL",82,0)
  3994    ;reset ex piration d ate to T+7  on transp ort global
  3995   "RTN","XPD IL",83,0)
  3996    S ^XTMP(" XPDI",0)=$ $FMADD^XLF DT(DT,7)_U _DT
  3997   "RTN","XPD IL",84,0)
  3998    ;start re ading the  HFS again
  3999   "RTN","XPD IL",85,0)
  4000    U IO R X: 10,Y:10 ;r wf was :0
  4001   "RTN","XPD IL",86,0)
  4002    ;the next  read must  be the IN STALL NAME
  4003   "RTN","XPD IL",87,0)
  4004    I X'="**I NSTALL NAM E**"!'$D(X PDT("NM",Y )) U IO(0)  W !!,"ERR OR in HFS  file forma t!" S XPDQ UIT=1 Q
  4005   "RTN","XPD IL",88,0)
  4006    ;XPDSEQ i s the disk  sequence  number
  4007   "RTN","XPD IL",89,0)
  4008    S %=XPDT( "NM",Y),GR ="^XTMP("" XPDI"","_+ XPDT(%)_", ",XPDSEQ=1
  4009   "RTN","XPD IL",90,0)
  4010    ;X=global  ref, Y=gl obal value . DIRUT is  when user  aborts
  4011   "RTN","XPD IL",91,0)
  4012    ;rwf next  line was  :0
  4013   "RTN","XPD IL",92,0)
  4014    F  R X:10 ,Y:10 Q:X= "**END**"   D  I $D(D IRUT) S XP DQUIT=1 Q
  4015   "RTN","XPD IL",93,0)
  4016    .I X="**I NSTALL NAM E**" D  Q
  4017   "RTN","XPD IL",94,0)
  4018    ..S %=+$G (XPDT("NM" ,Y)) I '%  S DIRUT=1  Q
  4019   "RTN","XPD IL",95,0)
  4020    ..S GR="^ XTMP(""XPD I"","_+XPD T(%)_","
  4021   "RTN","XPD IL",96,0)
  4022    .S @(GR_X )=Y
  4023   "RTN","XPD IL",97,0)
  4024    U IO(0)
  4025   "RTN","XPD IL",98,0)
  4026    Q
  4027   "RTN","XPD IL",99,0)
  4028    ;
  4029   "RTN","XPD IL",100,0)
  4030   NONE W !!, "**NOTHING  LOADED**" ,!
  4031   "RTN","XPD IL",101,0)
  4032    Q
  4033   "RTN","XPD IP")
  4034   0^6^B36894 605
  4035   "RTN","XPD IP",1,0)
  4036   XPDIP ;SFI SC/RSD - I nstall Pac kage & Rou tine file  ;03/08/200 6
  4037   "RTN","XPD IP",2,0)
  4038    ;;8.0;KER NEL;**15,2 1,28,30,41 ,44,51,58, 83,92,100, 108,137,22 9,350,393, 517,603,67 2**;Jul 10 , 1995;Bui ld 7
  4039   "RTN","XPD IP",3,0)
  4040    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  4041   "RTN","XPD IP",4,0)
  4042    Q
  4043   "RTN","XPD IP",5,0)
  4044   PKG ;
  4045   "RTN","XPD IP",6,0)
  4046    N %,OLDA, DA,DIK,XPD ,XPDFIL,XP DPKG,XPDBL DA,Y
  4047   "RTN","XPD IP",7,0)
  4048    ;update v ariable fo r graphic  display
  4049   "RTN","XPD IP",8,0)
  4050    I $D(XPDI DVT) S XPD IDTOT=10,X PDIDMOD=1, XPDIDCNT=0  D:XPDIDVT  UPDATE^XP DID(0)
  4051   "RTN","XPD IP",9,0)
  4052    ;XPDPKG=i en of Pack age file,  OLDA=old P ackage ien
  4053   "RTN","XPD IP",10,0)
  4054    S Y=$$PKG ADD,XPDPKG =$P(Y,U),O LDA=$P(Y,U ,2)
  4055   "RTN","XPD IP",11,0)
  4056    ;Package  file entry  not sent,  XPDPKG=0
  4057   "RTN","XPD IP",12,0)
  4058    G:'XPDPKG  PKGEND
  4059   "RTN","XPD IP",13,0)
  4060    ;update v ersion mul tiple
  4061   "RTN","XPD IP",14,0)
  4062    S DA=XPDP KG D PKGV
  4063   "RTN","XPD IP",15,0)
  4064   PKGH I $D( XPDIDVT) S  XPDIDCNT= XPDIDCNT+2  D UPDATE^ XPDID(XPDI DCNT)
  4065   "RTN","XPD IP",16,0)
  4066    S %=$P(^D IC(9.4,XPD PKG,0),U,4 )
  4067   "RTN","XPD IP",17,0)
  4068    ;repoint  Help Frame  (0;4)
  4069   "RTN","XPD IP",18,0)
  4070    I $L(%),' % S $P(^DI C(9.4,XPDP KG,0),U,4) =$$LK^XPDI A("^DIC(9. 2)",%),DIK ="^DIC(9.4 ," D IX1^D IK
  4071   "RTN","XPD IP",19,0)
  4072   PKGEND S X PDBLDA=$$B LD(XPDBLD)  Q:'XPDBLD A
  4073   "RTN","XPD IP",20,0)
  4074    ;Move the  Test/SEQ  number fro m build to  Install f ile.
  4075   "RTN","XPD IP",21,0)
  4076    S ^XPD(9. 7,XPDA,6)= $G(^XPD(9. 6,XPDBLDA, 6))
  4077   "RTN","XPD IP",22,0)
  4078    ;move Alp ha/Beta te sting info  to Kernel  site para  file
  4079   "RTN","XPD IP",23,0)
  4080    I XPDPKG  S %=$G(^XP D(9.6,XPDB LDA,"ABPKG ")) D
  4081   "RTN","XPD IP",24,0)
  4082    .;Install  message a nd they ha ve an addr ess, set f lag in XPD IST
  4083   "RTN","XPD IP",25,0)
  4084    .I $P(%,U )="y",$P(% ,U,2)="y", $L($P(%,U, 3)) S $P(X PDIST,U,2) =$P(%,U,3)
  4085   "RTN","XPD IP",26,0)
  4086    .D EN^XQA BLOAD(XPDB LDA)
  4087   "RTN","XPD IP",27,0)
  4088    Q
  4089   "RTN","XPD IP",28,0)
  4090   PKGADD() ; check Pack age file,  add if not  there
  4091   "RTN","XPD IP",29,0)
  4092    ;return n ew Package  file ien^ old ien
  4093   "RTN","XPD IP",30,0)
  4094    N DA,DIK, XPD,XPDFIL ,XPDO,X,Y
  4095   "RTN","XPD IP",31,0)
  4096    S DA=+$P( ^XPD(9.7,X PDA,0),U,2 ),XPDO=+$O (^XTMP("XP DI",XPDA," PKG",0)),O LDA(0)=$G( ^(XPDO,0)) ,X=$P(OLDA (0),U),XPD DR(1)="$P( OLDA(0),U, 2)" ;*603
  4097   "RTN","XPD IP",32,0)
  4098    I DA,$D(^ DIC(9.4,DA ,0)) Q DA_ U_XPDO
  4099   "RTN","XPD IP",33,0)
  4100    ;quit if  there was  no package  entry sen t
  4101   "RTN","XPD IP",34,0)
  4102    Q:'XPDO " 0^0"
  4103   "RTN","XPD IP",35,0)
  4104    S XPDFIL= 9.4,Y=$$DI C^XPDIK(9. 4,X,,,.XPD DR) Q:'Y " 0^0" ;*603
  4105   "RTN","XPD IP",36,0)
  4106    S DA=+Y
  4107   "RTN","XPD IP",37,0)
  4108    ;if new e ntry in pa ckage file , bring in  everythin g
  4109   "RTN","XPD IP",38,0)
  4110    I $P(Y,U, 3) D
  4111   "RTN","XPD IP",39,0)
  4112    .M ^DIC(9 .4,DA)=^XT MP("XPDI", XPDA,"PKG" ,XPDO)
  4113   "RTN","XPD IP",40,0)
  4114    .;kill th e -1 flag  node first
  4115   "RTN","XPD IP",41,0)
  4116    .K ^DIC(9 .4,DA,-1)
  4117   "RTN","XPD IP",42,0)
  4118    .;re-cros s ref afte r adding a  new packa ge
  4119   "RTN","XPD IP",43,0)
  4120    .S DIK="^ DIC(9.4,"  D IX1^DIK
  4121   "RTN","XPD IP",44,0)
  4122    ;add pack age to fil e 9.7
  4123   "RTN","XPD IP",45,0)
  4124    S XPD(9.7 ,XPDA_",", 1)=DA D FI LE^DIE("", "XPD")
  4125   "RTN","XPD IP",46,0)
  4126    Q DA_U_XP DO
  4127   "RTN","XPD IP",47,0)
  4128    ;
  4129   "RTN","XPD IP",48,0)
  4130   BLD(XPDBLD ) ;add Bui ld entry,  XPDBLD=Bui ld ien in  ^XTMP("XPD I",XPDA,"B LD",
  4131   "RTN","XPD IP",49,0)
  4132    N %,DA,DI K,XPDFIL,Y
  4133   "RTN","XPD IP",50,0)
  4134    I $D(XPDI DVT) S XPD IDCNT=XPDI DCNT+4 D U PDATE^XPDI D(XPDIDCNT )
  4135   "RTN","XPD IP",51,0)
  4136    ;XPDBLD=B uild ien i n ^XTMP, s et in XPDI J
  4137   "RTN","XPD IP",52,0)
  4138    S XPDFIL= 9.6,Y=$$DI C^XPDIK(9. 6,XPDNM) Q :'Y ""
  4139   "RTN","XPD IP",53,0)
  4140    S DA=+Y
  4141   "RTN","XPD IP",54,0)
  4142    ;Build en try not ne w, remove  old data
  4143   "RTN","XPD IP",55,0)
  4144    I '$P(Y,U ,3) S %=$P (^XPD(9.6, DA,0),U,2)  K ^XPD(9. 6,DA) K:%  ^XPD(9.6," C",%,DA)
  4145   "RTN","XPD IP",56,0)
  4146    M ^XPD(9. 6,DA)=^XTM P("XPDI",X PDA,"BLD", XPDBLD)
  4147   "RTN","XPD IP",57,0)
  4148    ;reset Pa ckage File  Link (0;2 )
  4149   "RTN","XPD IP",58,0)
  4150    ;XPDIST =  national  site track ing^A/B in stall mess age addres s
  4151   "RTN","XPD IP",59,0)
  4152    S $P(^XPD (9.6,DA,0) ,U,2)=$S(X PDPKG:XPDP KG,1:"") S :$P(^(0),U ,5)="y" XP DIST=1
  4153   "RTN","XPD IP",60,0)
  4154    ;re-index  cross-ref . on field s .01 and  1
  4155   "RTN","XPD IP",61,0)
  4156    S DIK="^X PD(9.6," F  Y=.01,1 S  DIK(1)=Y  D EN1^DIK
  4157   "RTN","XPD IP",62,0)
  4158    I $D(XPDI DVT) D UPD ATE^XPDID( XPDIDTOT)
  4159   "RTN","XPD IP",63,0)
  4160    Q DA
  4161   "RTN","XPD IP",64,0)
  4162    ;
  4163   "RTN","XPD IP",65,0)
  4164    ;update t he version  multiple  in the pac kage file
  4165   "RTN","XPD IP",66,0)
  4166   PKGV N %
  4167   "RTN","XPD IP",67,0)
  4168    I $D(XPDI DVT) S XPD IDCNT=XPDI DCNT+2 D U PDATE^XPDI D(XPDIDCNT )
  4169   "RTN","XPD IP",68,0)
  4170    ;%=ien in  the Versi on multipl e_U_ien in  Patch mul tiple in ^ XTMP
  4171   "RTN","XPD IP",69,0)
  4172    S %=$G(^X TMP("XPDI" ,XPDA,"PKG ",OLDA,-1) )
  4173   "RTN","XPD IP",70,0)
  4174    I XPDNM'[ "*" D  Q
  4175   "RTN","XPD IP",71,0)
  4176    .S %=+% Q :'$D(^XTMP ("XPDI",XP DA,"PKG",O LDA,22,%,0 ))  S %=^( 0) S:$D(^( 1)) %(1)=$ NA(^(1))
  4177   "RTN","XPD IP",72,0)
  4178    .S $P(%,U ,3,4)=DT_U _DUZ,%=$$P KGVER(DA,. %)
  4179   "RTN","XPD IP",73,0)
  4180    ;update p atch histo ry multipl e
  4181   "RTN","XPD IP",74,0)
  4182    Q:'$D(^XT MP("XPDI", XPDA,"PKG" ,OLDA,22,+ %,"PAH",+$ P(%,U,2),0 ))  S %=$P (^(0),U) S :$D(^(1))  %(1)=$NA(^ (1))
  4183   "RTN","XPD IP",75,0)
  4184    ;check Fi le Comment , %=patch  number
  4185   "RTN","XPD IP",76,0)
  4186    S:^XPD(9. 7,XPDA,2)[ " SEQ #" % =$P(^(2)," *",3)
  4187   "RTN","XPD IP",77,0)
  4188    S $P(%,U, 2,3)=$$NOW ^XLFDT()_U _DUZ,%=$$P KGPAT(DA,$ $VER^XPDUT L(XPDNM),. %)
  4189   "RTN","XPD IP",78,0)
  4190    Q
  4191   "RTN","XPD IP",79,0)
  4192    ;
  4193   "RTN","XPD IP",80,0)
  4194   PKGVER(XPD PDA,XPDI)  ;update ve rsion in p ackage fil e, XPDPDA= Package fi le ien, re turn ien o f version  multiple
  4195   "RTN","XPD IP",81,0)
  4196    ;XPDI=ver sion^date  distr.^dat e installe d^install  by
  4197   "RTN","XPD IP",82,0)
  4198    ;XPDI(1)= root of de scription  field
  4199   "RTN","XPD IP",83,0)
  4200    N I,X,XPD ,XPDIEN,XP DJ,XPDV
  4201   "RTN","XPD IP",84,0)
  4202    S XPDIEN= ","_XPDPDA _",",XPDV= $$MDIC(9.4 9,XPDIEN,$ P(XPDI,U))  Q:'XPDV 0
  4203   "RTN","XPD IP",85,0)
  4204    S XPD(9.4 ,XPDPDA_", ",13)=$P(X PDI,U),X=" XPD(9.49," ""_XPDV_XP DIEN_""")"
  4205   "RTN","XPD IP",86,0)
  4206    F I=1:1:3  S:$P(XPDI ,U,I+1)]""  @X@(I)=$P (XPDI,U,I+ 1)
  4207   "RTN","XPD IP",87,0)
  4208    S:$D(XPDI (1)) @X@(4 1)=XPDI(1)
  4209   "RTN","XPD IP",88,0)
  4210    D FILE^DI E("","XPD" )
  4211   "RTN","XPD IP",89,0)
  4212    Q XPDV
  4213   "RTN","XPD IP",90,0)
  4214    ;
  4215   "RTN","XPD IP",91,0)
  4216   PKGPAT(XPD PDA,XPDV,X PDI) ;upda te patch h istory
  4217   "RTN","XPD IP",92,0)
  4218    ;INPUT: X PDPDA=Pack age file i en, XPDV=v ersion
  4219   "RTN","XPD IP",93,0)
  4220    ;XPDI=pat ch^date in stalled^in stall by
  4221   "RTN","XPD IP",94,0)
  4222    ;RETURNS:  version i en^patch i en^[CURREN T VERSION,  if it was  set]
  4223   "RTN","XPD IP",95,0)
  4224    N I,X,XPD ,XPDP,XPDI EN,CURVER
  4225   "RTN","XPD IP",96,0)
  4226    ;quit if  we can't f ind the ve rsion mult iple, rese ts XPDV=ie n of versi on
  4227   "RTN","XPD IP",97,0)
  4228    S XPDIEN= ","_XPDPDA _",",XPDV= $$MDIC(9.4 9,XPDIEN,X PDV) Q:'XP DV 0
  4229   "RTN","XPD IP",98,0)
  4230    S XPDIEN= ","_XPDV_X PDIEN,XPDP =$$MDIC(9. 4901,XPDIE N,$P(XPDI, U)) Q:'XPD P 0
  4231   "RTN","XPD IP",99,0)
  4232    S X="XPD( 9.4901,""" _XPDP_XPDI EN_""")"
  4233   "RTN","XPD IP",100,0)
  4234    F I=.02,. 03 S:$P(XP DI,U,I*100 )]"" @X@(I )=$P(XPDI, U,I*100)
  4235   "RTN","XPD IP",101,0)
  4236    S:$D(XPDI (1)) @X@(1 )=XPDI(1)
  4237   "RTN","XPD IP",102,0)
  4238    ;if no CU RRENT VERS ION, set i t
  4239   "RTN","XPD IP",103,0)
  4240    I $G(^DIC (9.4,XPDPD A,"VERSION "))="" S X PD(9.4,XPD PDA_",",13 )=XPDV,CUR VER=XPDV
  4241   "RTN","XPD IP",104,0)
  4242    D FILE^DI E("","XPD" )
  4243   "RTN","XPD IP",105,0)
  4244    Q XPDV_U_ XPDP_U_$G( CURVER)
  4245   "RTN","XPD IP",106,0)
  4246    ;
  4247   "RTN","XPD IP",107,0)
  4248    ;XPDF=sub file #,XPD IEN=ien st ring, X=in put
  4249   "RTN","XPD IP",108,0)
  4250   MDIC(XPDF, XPDIEN,XPD X) ;
  4251   "RTN","XPD IP",109,0)
  4252    N DIERR,X PD,XPDN
  4253   "RTN","XPD IP",110,0)
  4254    D FIND^DI C(XPDF,XPD IEN,"","XQ f",XPDX,5, "","",""," XPD")
  4255   "RTN","XPD IP",111,0)
  4256    ;one or m ore matche s, just re turn first  one
  4257   "RTN","XPD IP",112,0)
  4258    I $G(XPD( 0)) D:XPD( 0)>1  Q XP D(1)
  4259   "RTN","XPD IP",113,0)
  4260    .N %
  4261   "RTN","XPD IP",114,0)
  4262    .S %(1)=$ P(^DD(XPDF ,.01,0),U) _"  "_XPDX _"  is Dup licated,", %(2)=" onl y ien #"_X PD(1)_" wa s updated. "
  4263   "RTN","XPD IP",115,0)
  4264    .D MES^XP DUTL(.%)
  4265   "RTN","XPD IP",116,0)
  4266    ;add a ne w entry
  4267   "RTN","XPD IP",117,0)
  4268    S XPDN(XP DF,"+1"_XP DIEN,.01)= XPDX K XPD
  4269   "RTN","XPD IP",118,0)
  4270    D UPDATE^ DIE("","XP DN","XPD")
  4271   "RTN","XPD IP",119,0)
  4272    I '$G(XPD (1)) D BME S^XPDUTL("  "_$P(^DD( XPDF,.01,0 ),U)_" "_X PDX_" **Co uldn't Add  to file** ") Q 0
  4273   "RTN","XPD IP",120,0)
  4274    Q XPD(1)
  4275   "RTN","XPD IP",121,0)
  4276    ;
  4277   "RTN","XPD IP",122,0)
  4278   RTN ;move  rtns to in stall file
  4279   "RTN","XPD IP",123,0)
  4280    N XPD,XPD C,XPDCR,XP DI,XPDJ,XP DK,XPDL,XP DM,XPDR,XP DRH,X,NOW
  4281   "RTN","XPD IP",124,0)
  4282    K ^XPD(9. 7,XPDA,"RT N"),^TMP($ J)
  4283   "RTN","XPD IP",125,0)
  4284    S (XPDC,X PDCR,XPDRH )=0,XPDJ=" ",NOW=$$NO W^XLFDT()
  4285   "RTN","XPD IP",126,0)
  4286    ;get all  routines t hat were l oaded, XPD M=action
  4287   "RTN","XPD IP",127,0)
  4288    ;actions  are 0=load , 1=delete , 2=skip
  4289   "RTN","XPD IP",128,0)
  4290    F  S XPDJ =$O(^XTMP( "XPDI",XPD A,"RTN",XP DJ)) Q:XPD J=""  S XP DM=^(XPDJ)  D:'XPDM
  4291   "RTN","XPD IP",129,0)
  4292    .;XPD, bu ild array  to update  ROUTINE mu ltiple in  INSTALL fi le
  4293   "RTN","XPD IP",130,0)
  4294    .S XPDC=X PDC+1,^TMP ($J,"XPDL" ,XPDC)=XPD C,^TMP($J, "XPD",9.70 4,"+"_XPDC _","_XPDA_ ",",.01)=X PDJ
  4295   "RTN","XPD IP",131,0)
  4296    .;XPDR, b uild array  to update  ROUTINE f ile, Set i nstall dat e
  4297   "RTN","XPD IP",132,0)
  4298    .;S:'$D(^ DIC(9.8,"B ",XPDJ)) X PDCR=XPDCR +1,^TMP($J ,"XPDR",9. 8,"?+"_XPD CR_",",.01 )=XPDJ,^(1 )="R"
  4299   "RTN","XPD IP",133,0)
  4300    .S XPDCR= XPDCR+1,^T MP($J,"XPD R",9.8,"?+ "_XPDCR_", ",.01)=XPD J,^(1)="R" ,^(7.4)=NO W ;**229
  4301   "RTN","XPD IP",134,0)
  4302    ;if we ar e doing VT  graphic d isplay, up date only  40%
  4303   "RTN","XPD IP",135,0)
  4304    I $D(XPDI DVT) S XPD IDCNT=XPDI DTOT*.4 D  UPDATE^XPD ID(XPDIDCN T)
  4305   "RTN","XPD IP",136,0)
  4306    F XPDK="D IKZ","DIEZ ","DIPZ" D
  4307   "RTN","XPD IP",137,0)
  4308    .S XPDI=0
  4309   "RTN","XPD IP",138,0)
  4310    .;loop th ru list of  compile t emplate ro utines
  4311   "RTN","XPD IP",139,0)
  4312    .;XTMP("X PDI",XPDA, "DIKZ",ien ,routine n ame)
  4313   "RTN","XPD IP",140,0)
  4314    .F  S XPD I=$O(^XTMP ("XPDI",XP DA,XPDK,XP DI)),XPDJ= "" Q:'XPDI   D
  4315   "RTN","XPD IP",141,0)
  4316    ..I 'XPDR H D BMES^X PDUTL(" Th e followin g Routines  were crea ted during  this inst all:") S X PDRH=1
  4317   "RTN","XPD IP",142,0)
  4318    ..F  S XP DJ=$O(^XTM P("XPDI",X PDA,XPDK,X PDI,XPDJ))  Q:XPDJ=""   D:'$D(^X TMP("XPDI" ,XPDA,"RTN ",XPDJ))
  4319   "RTN","XPD IP",143,0)
  4320    ...S XPDC =XPDC+1,^T MP($J,"XPD L",XPDC)=X PDC,^TMP($ J,"XPD",9. 704,"+"_XP DC_","_XPD A_",",.01) =XPDJ
  4321   "RTN","XPD IP",144,0)
  4322    ...D MES^ XPDUTL("      "_XPDJ)
  4323   "RTN","XPD IP",145,0)
  4324    ;update r outine mul tiple in I nstall fil e with rou tines and
  4325   "RTN","XPD IP",146,0)
  4326    ;compile  template r outines
  4327   "RTN","XPD IP",147,0)
  4328    I $D(^TMP ($J,"XPD") )>9 D
  4329   "RTN","XPD IP",148,0)
  4330    .D UPDATE ^DIE("","^ TMP($J,""X PD"")","^T MP($J,""XP DL"")")
  4331   "RTN","XPD IP",149,0)
  4332    .;if we a re doing V T graphic  display, u pdate only  40%
  4333   "RTN","XPD IP",150,0)
  4334    .I $D(XPD IDVT) S XP DIDCNT=XPD IDCNT+(XPD IDTOT*.40)  D UPDATE^ XPDID(XPDI DCNT)
  4335   "RTN","XPD IP",151,0)
  4336    ;update R outine fil e
  4337   "RTN","XPD IP",152,0)
  4338    D:$D(^TMP ($J,"XPDR" ))>9 UPDAT E^DIE(""," ^TMP($J,"" XPDR"")")
  4339   "RTN","XPD IP",153,0)
  4340    ;if we ar e doing VT  graphic d isplay, up date 100%
  4341   "RTN","XPD IP",154,0)
  4342    I $D(XPDI DVT) D UPD ATE^XPDID( XPDIDTOT)
  4343   "RTN","XPD IP",155,0)
  4344    Q
  4345   "RTN","XPD IST")
  4346   0^5^B18736 775
  4347   "RTN","XPD IST",1,0)
  4348   XPDIST ;SF ISC/RSD -  site track ing ;03/05 /2008
  4349   "RTN","XPD IST",2,0)
  4350    ;;8.0;KER NEL;**66,1 08,185,233 ,350,393,4 86,539,547 ,672**;Jul  10, 1995; Build 7
  4351   "RTN","XPD IST",3,0)
  4352    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  4353   "RTN","XPD IST",4,0)
  4354    ;Returns  ""=failed,  XMZ=sent
  4355   "RTN","XPD IST",5,0)
  4356    ;D0=ien i n file 9.7 , XPY=nati onal site  tracking^a ddress(opt ional)
  4357   "RTN","XPD IST",6,0)
  4358   EN(D0,XPY)  ;EF. send  message
  4359   "RTN","XPD IST",7,0)
  4360    N %,DIFRO M,XPD,XPD0 ,XPD1,XPD2 ,XPDV,XPZ, X,X1,Z,Y,X PD6,XPDTRA CK
  4361   "RTN","XPD IST",8,0)
  4362    ;Get data  needed
  4363   "RTN","XPD IST",9,0)
  4364    I '$D(^XP D(9.7,$G(D 0),0)) D B MES^XPDUTL (" INSTALL  file entr y missing" ) Q ""
  4365   "RTN","XPD IST",10,0)
  4366    ;p350 -ad d node 6 f or the Tes t# and Seq #. -REM
  4367   "RTN","XPD IST",11,0)
  4368    S XPD0=^X PD(9.7,D0, 0),XPD1=$G (^(1)),XPD 2=$G(^(2)) ,XPD6=$G(^ (6))
  4369   "RTN","XPD IST",12,0)
  4370    I '$P(XPD 0,U,2) D B MES^XPDUTL (" No link  to PACKAG E file") Q  ""
  4371   "RTN","XPD IST",13,0)
  4372    S XPD=$P( $G(^DIC(9. 4,+$P(XPD0 ,U,2),0)), U),XPDV=$$ VER^XPDUTL ($P(XPD0,U ))
  4373   "RTN","XPD IST",14,0)
  4374    I XPD=""  D BMES^XPD UTL(" PACK AGE file e ntry missi ng") Q ""
  4375   "RTN","XPD IST",15,0)
  4376    ;XPZ(1)=s tart, XPZ( 2)=complet ion date/t ime, XPZ(3 )=run time
  4377   "RTN","XPD IST",16,0)
  4378    S XPZ(1)= $P(XPD1,U) ,XPZ(2)=$P (XPD1,U,3) ,XPZ(3)=$$ FMDIFF^XLF DT(XPZ(2), XPZ(1),3), XPZ(1)=$$F MTE^XLFDT( XPZ(1)),XP Z(2)=$$FMT E^XLFDT(XP Z(2))
  4379   "RTN","XPD IST",17,0)
  4380    D LOCAL
  4381   "RTN","XPD IST",18,0)
  4382    S XPDTRAC K=$$TRACK
  4383   "RTN","XPD IST",19,0)
  4384    D REMEDY  ;p350 -REM
  4385   "RTN","XPD IST",20,0)
  4386    Q $$FORUM ()
  4387   "RTN","XPD IST",21,0)
  4388   LOCAL ;Sen d a messag e to local  mail grou p
  4389   "RTN","XPD IST",22,0)
  4390    N XMY,XPD TEXT,XMTEX T,XMDUZ,XM SUB,XMZ,XM MG
  4391   "RTN","XPD IST",23,0)
  4392    K ^TMP($J )
  4393   "RTN","XPD IST",24,0)
  4394    S X=$$MAI LGRP^XPDUT L(XPD) Q:X =""
  4395   "RTN","XPD IST",25,0)
  4396    S XMY(X)= "" D GETEN V^%ZOSV
  4397   "RTN","XPD IST",26,0)
  4398    ;Message  for users
  4399   "RTN","XPD IST",27,0)
  4400    S XPDTEXT (1,0)="PAC KAGE INSTA LL"
  4401   "RTN","XPD IST",28,0)
  4402    S XPDTEXT (2,0)="SIT E: "_$G(^X MB("NETNAM E"))
  4403   "RTN","XPD IST",29,0)
  4404    S XPDTEXT (3,0)="PAC KAGE: "_XP D
  4405   "RTN","XPD IST",30,0)
  4406    S XPDTEXT (4,0)="VER SION: "_XP DV
  4407   "RTN","XPD IST",31,0)
  4408    S XPDTEXT (5,0)="Sta rt time: " _XPZ(1)
  4409   "RTN","XPD IST",32,0)
  4410    S XPDTEXT (6,0)="Com pletion ti me: "_XPZ( 2)
  4411   "RTN","XPD IST",33,0)
  4412    S XPDTEXT (7,0)="Env ironment:  "_Y
  4413   "RTN","XPD IST",34,0)
  4414    S XPDTEXT (8,0)="Ins talled by:  "_$P($G(^ VA(200,+$P (XPD0,U,11 ),0)),U)
  4415   "RTN","XPD IST",35,0)
  4416    S XPDTEXT (9,0)="Ins tall Name:  "_$P(XPD0 ,U)
  4417   "RTN","XPD IST",36,0)
  4418    S XPDTEXT (10,0)="Di stribution  Date: "_$ $FMTE^XLFD T($P(XPD1, U,4))
  4419   "RTN","XPD IST",37,0)
  4420    S XMDUZ=$ S($P(XPD0, U,11):+$P( XPD0,U,11) ,1:.5),XMT EXT="XPDTE XT(",XMSUB =$P(XPD0,U )_" INSTAL LATION"
  4421   "RTN","XPD IST",38,0)
  4422    D ^XMD
  4423   "RTN","XPD IST",39,0)
  4424    Q
  4425   "RTN","XPD IST",40,0)
  4426   TRACK() ;E F. Should  VA track t he install ation of t his patch  at a natio nal level?
  4427   "RTN","XPD IST",41,0)
  4428    Q:$G(XPY) ="" 0  ; N o - Nation al site tr acking was  not reque sted
  4429   "RTN","XPD IST",42,0)
  4430    ;Quit if  not VA pro duction pr imary doma in
  4431   "RTN","XPD IST",43,0)
  4432    I $G(^XMB ("NETNAME" ))'[". DOM A IN . EXT " D BMES^X PDUTL(" No t a VA pri mary domai n") Q 0
  4433   "RTN","XPD IST",44,0)
  4434    ;X ^%ZOSF ("UCI") S  %=^%ZOSF(" PROD")
  4435   "RTN","XPD IST",45,0)
  4436    ;S:%'[","  Y=$P(Y,", ")
  4437   "RTN","XPD IST",46,0)
  4438    ;I Y'=% D  BMES^XPDU TL(" Not a  productio n UCI") Q  ""
  4439   "RTN","XPD IST",47,0)
  4440    ; 486/GMB  Replaced  the above  3 lines wi th the fol lowing lin e:
  4441   "RTN","XPD IST",48,0)
  4442    I '$$PROD ^XUPROD D  BMES^XPDUT L(" Not a  production  UCI") Q 0
  4443   "RTN","XPD IST",49,0)
  4444    Q 1
  4445   "RTN","XPD IST",50,0)
  4446   REMEDY ;Se nd to Reme dy Server  PII                        *p350 -REM
  4447   "RTN","XPD IST",51,0)
  4448    Q:'XPDTRA CK
  4449   "RTN","XPD IST",52,0)
  4450    N XMY,XPD TEXT,XMTEX T,XMDUZ,XM SUB,XMZ,XM MG
  4451   "RTN","XPD IST",53,0)
  4452    K ^TMP($J )
  4453   "RTN","XPD IST",54,0)
  4454    S:XPY XMY (" PII                      ")=""
  4455   "RTN","XPD IST",55,0)
  4456    S:$L($P(X PY,U,2)) X MY($P(XPY, U,2))=""
  4457   "RTN","XPD IST",56,0)
  4458    ;Message  for server  (all in o ne string)
  4459   "RTN","XPD IST",57,0)
  4460    ;XMTEXT=T ype(1),Dom ain(2-65), Pkg(66-95) ,Version(9 6-125),
  4461   "RTN","XPD IST",58,0)
  4462    ;       S tartTime(1 26-147),Co mpleteTime (148-169), RunTime(17 0-177),
  4463   "RTN","XPD IST",59,0)
  4464    ;       D ate(178-19 9),Install edBy(200-2 29),Instal lName(230- 259),
  4465   "RTN","XPD IST",60,0)
  4466    ;       D istributio nDate(260- 281),Seq#( 282-286),
  4467   "RTN","XPD IST",61,0)
  4468    ;       P atchTestVe rsion(287- 317)
  4469   "RTN","XPD IST",62,0)
  4470    ;
  4471   "RTN","XPD IST",63,0)
  4472    S X1=1_$G (^XMB("NET NAME")) ;T ype is alw ays "1"(1= patch,0=pk g).
  4473   "RTN","XPD IST",64,0)
  4474    S $E(X1,6 6,95)=XPD, $E(X1,96,1 25)=XPDV,$ E(X1,126,1 47)=XPZ(1) ,$E(X1,148 ,169)=XPZ( 2),$E(X1,1 70,177)=XP Z(3),$E(X1 ,178,199)= DT
  4475   "RTN","XPD IST",65,0)
  4476    S $E(X1,2 00,229)=$P ($G(^VA(20 0,+$P(XPD0 ,U,11),0)) ,U),$E(X1, 230,259)=$ P(XPD0,U), $E(X1,260, 281)=$P(XP D1,U,4),$E (X1,282,28 6)=$P(XPD6 ,U,2),$E(X 1,287,317) =$P(XPD6,U )
  4477   "RTN","XPD IST",66,0)
  4478    S XPDTEXT (1,0)=X1
  4479   "RTN","XPD IST",67,0)
  4480    S XMDUZ=$ S($P(XPD0, U,11):+$P( XPD0,U,11) ,1:.5),XMT EXT="XPDTE XT(",XMSUB ="KIDS-"_$ P(XPD0,U)_ " INSTALLA TION"
  4481   "RTN","XPD IST",68,0)
  4482    D ^XMD
  4483   "RTN","XPD IST",69,0)
  4484    Q
  4485   "RTN","XPD IST",70,0)
  4486   FORUM() ;E F. send to  Server on  FORUM
  4487   "RTN","XPD IST",71,0)
  4488    Q:'XPDTRA CK ""
  4489   "RTN","XPD IST",72,0)
  4490    N XMY,XPD TEXT,XMTEX T,XMDUZ,XM SUB,XMZ,XM MG
  4491   "RTN","XPD IST",73,0)
  4492    K ^TMP($J )
  4493   "RTN","XPD IST",74,0)
  4494    S:XPY XMY (" DN S        @ D O
M
A IN . EXT    ")=""
  4495   "RTN","XPD IST",75,0)
  4496    S:$L($P(X PY,U,2)) X MY($P(XPY, U,2))=""
  4497   "RTN","XPD IST",76,0)
  4498    ;Message  for server
  4499   "RTN","XPD IST",77,0)
  4500    S XPDTEXT (1,0)="PAC KAGE INSTA LL"
  4501   "RTN","XPD IST",78,0)
  4502    S XPDTEXT (2,0)="SIT E: "_$G(^X MB("NETNAM E"))
  4503   "RTN","XPD IST",79,0)
  4504    S XPDTEXT (3,0)="PAC KAGE: "_XP D
  4505   "RTN","XPD IST",80,0)
  4506    S XPDTEXT (4,0)="VER SION: "_XP DV
  4507   "RTN","XPD IST",81,0)
  4508    S XPDTEXT (5,0)="Sta rt time: " _XPZ(1)
  4509   "RTN","XPD IST",82,0)
  4510    S XPDTEXT (6,0)="Com pletion ti me: "_XPZ( 2)
  4511   "RTN","XPD IST",83,0)
  4512    S XPDTEXT (7,0)="Run  time: "_X PZ(3)
  4513   "RTN","XPD IST",84,0)
  4514    S XPDTEXT (8,0)="DAT E: "_DT
  4515   "RTN","XPD IST",85,0)
  4516    S XPDTEXT (9,0)="Ins talled by:  "_$P($G(^ VA(200,+$P (XPD0,U,11 ),0)),U)
  4517   "RTN","XPD IST",86,0)
  4518    S XPDTEXT (10,0)="In stall Name : "_$P(XPD 0,U)
  4519   "RTN","XPD IST",87,0)
  4520    S XPDTEXT (11,0)="Di stribution  Date: "_$ P(XPD1,U,4 )
  4521   "RTN","XPD IST",88,0)
  4522    S XPDTEXT (12,0)=XPD 2
  4523   "RTN","XPD IST",89,0)
  4524    S XPDTEXT (13,0)=+XP D6
  4525   "RTN","XPD IST",90,0)
  4526    S XMDUZ=$ S($P(XPD0, U,11):+$P( XPD0,U,11) ,1:.5),XMT EXT="XPDTE XT(",XMSUB =$P(XPD0,U )_" INSTAL LATION"
  4527   "RTN","XPD IST",91,0)
  4528    D ^XMD
  4529   "RTN","XPD IST",92,0)
  4530    Q "#"_$G( XMZ)
  4531   "RTN","XPD IST",93,0)
  4532    ;
  4533   "RTN","XPD IST",94,0)
  4534   CHKS(XPDPH ,XPDTEXT)  ;Get Check sum from F orum for p atch XPDPH , XPDTEXT  is passed  by referen ce
  4535   "RTN","XPD IST",95,0)
  4536    ;returns  XPDTEXT(ro utine name )= before  checksum
  4537   "RTN","XPD IST",96,0)
  4538    ;need to  create par ameter to  store url  - future
  4539   "RTN","XPD IST",97,0)
  4540    Q
  4541   "RTN","XPD IST",98,0)
  4542    K ^TMP($J ,"XPDTHC")
  4543   "RTN","XPD IST",99,0)
  4544    Q:$G(XPDP H)=""
  4545   "RTN","XPD IST",100,0 )
  4546    N XPDCHK, XPDHDR,XPD URL,I,X,Y
  4547   "RTN","XPD IST",101,0 )
  4548    S XPDURL= "http:// IP                 /cgi/PCHCS UM?PCH="_X PDPH,XPDCH K=0
  4549   "RTN","XPD IST",102,0 )
  4550    S X=$$GET URL^XTHC10 (XPDURL,,$ NA(^TMP($J ,"XPDTHC") ),.XPDHDR)
  4551   "RTN","XPD IST",103,0 )
  4552    I X>0 D
  4553   "RTN","XPD IST",104,0 )
  4554    . S I=""
  4555   "RTN","XPD IST",105,0 )
  4556    . F  S I= $O(^TMP($J ,"XPDTHC", I)) Q:I=""   S X=$G(^ (I)) D:$E( X,1,4)="<l i>"
  4557   "RTN","XPD IST",106,0 )
  4558    .. S Y=$P ($P(X,"</l i>"),U,4), X=$P($P(X, "<li>",2), U),XPDTEXT (X)=Y,XPDC HK=XPDCHK+ 1
  4559   "RTN","XPD IST",107,0 )
  4560    . Q
  4561   "RTN","XPD IST",108,0 )
  4562    S XPDTEXT =XPDCHK
  4563   "RTN","XPD IST",109,0 )
  4564    K ^TMP($J ,"XPDTHC")
  4565   "RTN","XPD IST",110,0 )
  4566    Q
  4567   "RTN","XPD MENU")
  4568   0^2^B53264 22
  4569   "RTN","XPD MENU",1,0)
  4570   XPDMENU ;S FISC/RWF,R SD - Manag e Menu ite ms ;11/02/ 2005  6895 30.624382
  4571   "RTN","XPD MENU",2,0)
  4572    ;;8.0;KER NEL;**21,3 02,393,672 **;Jul 10,  1995;Buil d 7
  4573   "RTN","XPD MENU",3,0)
  4574    ;;Per VA  Directive  6402, this  routine s hould not  be modifie d.
  4575   "RTN","XPD MENU",4,0)
  4576    Q
  4577   "RTN","XPD MENU",5,0)
  4578    ;
  4579   "RTN","XPD MENU",6,0)
  4580    ;MENU=opt ion to add  to,  OPT= option to  add to MEN U, SYN=syn onym
  4581   "RTN","XPD MENU",7,0)
  4582    ;ORD=disp lay order
  4583   "RTN","XPD MENU",8,0)
  4584   ADD(MENU,O PT,SYN,ORD ) ;EF. Add  options t o a menu o r extended  action
  4585   "RTN","XPD MENU",9,0)
  4586    Q:$G(MENU )']"" 0 Q: $G(OPT)']" " 0
  4587   "RTN","XPD MENU",10,0 )
  4588    N X,XPD1, XPD2,XPD3, DIC,DA,D0, DR,DLAYGO
  4589   "RTN","XPD MENU",11,0 )
  4590    S XPD1=$$ LKOPT(MENU ) Q:XPD1'> 0 "0^no me nu"
  4591   "RTN","XPD MENU",12,0 )
  4592    ;quit if  type is no t Broker,  Menu or Ex tended act ion
  4593   "RTN","XPD MENU",13,0 )
  4594    I "BMX"'[ $E($$TYPE( XPD1)_"~", 1) Q "0^wr ong type"
  4595   "RTN","XPD MENU",14,0 )
  4596    S XPD2=$$ LKOPT(OPT)  Q:XPD2'>0  "0^option  not found "
  4597   "RTN","XPD MENU",15,0 )
  4598    ;if OPTio n is not i n menu, ad d it
  4599   "RTN","XPD MENU",16,0 )
  4600    I '$D(^DI C(19,XPD1, 10,"B",XPD 2)) D
  4601   "RTN","XPD MENU",17,0 )
  4602    .S X=XPD2 ,(D0,DA(1) )=XPD1,DIC (0)="MLF", DIC("P")=$ P(^DD(19,1 0,0),"^",2 ),DLAYGO=1 9,DIC="^DI C(19,"_XPD 1_",10,"
  4603   "RTN","XPD MENU",18,0 )
  4604    .D FILE^D ICN
  4605   "RTN","XPD MENU",19,0 )
  4606    S XPD3=$O (^DIC(19,X PD1,10,"B" ,XPD2,0))
  4607   "RTN","XPD MENU",20,0 )
  4608    I XPD3>0  S DR="" S: $G(SYN)]""  DR="2///" _SYN_";" S :$G(ORD)]" " DR=DR_"3 ///"_ORD I  DR]"" S D IE="^DIC(1 9,"_XPD1_" ,10,",DA=X PD3,DA(1)= XPD1 D ^DI E
  4609   "RTN","XPD MENU",21,0 )
  4610    Q XPD3>0
  4611   "RTN","XPD MENU",22,0 )
  4612    ;
  4613   "RTN","XPD MENU",23,0 )
  4614   LKOPT(X) ; EF.  To lo okup on "B "
  4615   "RTN","XPD MENU",24,0 )
  4616    Q $O(^DIC (19,"B",X, 0))
  4617   "RTN","XPD MENU",25,0 )
  4618    ;
  4619   "RTN","XPD MENU",26,0 )
  4620   TYPE(X) ;E F. Return  option typ e, Pass IF N.
  4621   "RTN","XPD MENU",27,0 )
  4622    Q:X'>0 ""  Q $P($G(^ DIC(19,X,0 )),"^",4)
  4623   "RTN","XPD MENU",28,0 )
  4624    ;
  4625   "RTN","XPD MENU",29,0 )
  4626    ;MENU=opt ion to del ete from,   OPT=optio n to delet e
  4627   "RTN","XPD MENU",30,0 )
  4628   DELETE(MEN U,OPT) ;EF . Delete i tem from m enu or ext ended acti on.
  4629   "RTN","XPD MENU",31,0 )
  4630    Q:$G(MENU )']"" 0 Q: $G(OPT)']" " 0
  4631   "RTN","XPD MENU",32,0 )
  4632    N XPD1,XP D2,DIK,DA, X
  4633   "RTN","XPD MENU",33,0 )
  4634    S XPD1=$$ LKOPT(MENU ) Q:XPD1'> 0 0
  4635   "RTN","XPD MENU",34,0 )
  4636    I "MX"'[$ E($$TYPE(X PD1)_"~",1 ) Q 0
  4637   "RTN","XPD MENU",35,0 )
  4638    S XPD2=$$ LKOPT(OPT)  Q:XPD2'>0  0
  4639   "RTN","XPD MENU",36,0 )
  4640    S DA=$O(^ DIC(19,XPD 1,10,"B",X PD2,0)) Q: DA'>0 0
  4641   "RTN","XPD MENU",37,0 )
  4642    S DA(1)=X PD1,DIK="^ DIC(19,XPD 1,10," D ^ DIK
  4643   "RTN","XPD MENU",38,0 )
  4644    Q 1
  4645   "RTN","XPD MENU",39,0 )
  4646    ;
  4647   "RTN","XPD MENU",40,0 )
  4648    ;OPT=opti on to set  out of ord er,  TXT=m essage
  4649   "RTN","XPD MENU",41,0 )
  4650   OUT(OPT,TX T) ;Set op tion out o f order
  4651   "RTN","XPD MENU",42,0 )
  4652    Q:$G(OPT) ']""
  4653   "RTN","XPD MENU",43,0 )
  4654    N XPD,XPD 1
  4655   "RTN","XPD MENU",44,0 )
  4656    S XPD1=$$ LKOPT(OPT)  Q:XPD1'>0
  4657   "RTN","XPD MENU",45,0 )
  4658    S XPD(19, XPD1_",",2 )=$G(TXT)  D FILE^DIE ("","XPD")
  4659   "RTN","XPD MENU",46,0 )
  4660    Q
  4661   "RTN","XPD MENU",47,0 )
  4662    ;
  4663   "RTN","XPD MENU",48,0 )
  4664    ;OLD=old  name, NEW= new name
  4665   "RTN","XPD MENU",49,0 )
  4666   RENAME(OLD ,NEW) ;Ren ame option
  4667   "RTN","XPD MENU",50,0 )
  4668    Q:$G(OLD) ']""  Q:$G (NEW)']""
  4669   "RTN","XPD MENU",51,0 )
  4670    N XPD,XPD 1
  4671   "RTN","XPD MENU",52,0 )
  4672    S XPD1=$$ LKOPT(OLD)  Q:XPD1'>0
  4673   "RTN","XPD MENU",53,0 )
  4674    S XPD(19, XPD1_",",. 01)=NEW D  FILE^DIE(" ","XPD")
  4675   "RTN","XPD MENU",54,0 )
  4676    Q
  4677   "RTN","XPD MENU",55,0 )
  4678    ;
  4679   "RTN","XPD MENU",56,0 )
  4680    ;OPT=opti on name, T XT=Securit y Key, fil e 19.1
  4681   "RTN","XPD MENU",57,0 )
  4682   LOCK(OPT,T XT) ;Set o ption LOCK
  4683   "RTN","XPD MENU",58,0 )
  4684    Q:$G(OPT) ']""
  4685   "RTN","XPD MENU",59,0 )
  4686    N XPD,XPD 1
  4687   "RTN","XPD MENU",60,0 )
  4688    S XPD1=$$ LKOPT(OPT)  Q:XPD1'>0
  4689   "RTN","XPD MENU",61,0 )
  4690    S XPD(19, XPD1_",",3 )=$G(TXT)  D FILE^DIE ("E","XPD" )
  4691   "RTN","XPD MENU",62,0 )
  4692    Q
  4693   "RTN","XPD MENU",63,0 )
  4694    ;
  4695   "RTN","XPD MENU",64,0 )
  4696    ;OPT=opti on name, T XT=Securit y Key, fil e 19.1
  4697   "RTN","XPD MENU",65,0 )
  4698   RLOCK(OPT, TXT) ;Set  option Rev erse Lock
  4699   "RTN","XPD MENU",66,0 )
  4700    Q:$G(OPT) ']""
  4701   "RTN","XPD MENU",67,0 )
  4702    N XPD,XPD 1
  4703   "RTN","XPD MENU",68,0 )
  4704    S XPD1=$$ LKOPT(OPT)  Q:XPD1'>0
  4705   "RTN","XPD MENU",69,0 )
  4706    S XPD(19, XPD1_",",3 .01)=$G(TX T) D FILE^ DIE("E","X PD")
  4707   "RTN","XPD MENU",70,0 )
  4708    Q
  4709   "RTN","XPD T")
  4710   0^12^B6418 6009
  4711   "RTN","XPD T",1,0)
  4712   XPDT ;SFIS C/RSD - Tr ansport a  package ;0 2/12/2009
  4713   "RTN","XPD T",2,0)
  4714    ;;8.0;KER NEL;**2,10 ,28,41,44, 51,58,66,6 8,85,100,1 08,393,511 ,539,547,6 72**;Jul 1 0, 1995;Bu ild 7
  4715   "RTN","XPD T",3,0)
  4716    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  4717   "RTN","XPD T",4,0)
  4718   EN ;build  XTMP("XPDT ",ien, XPD A=ien,XPDN M=name
  4719   "RTN","XPD T",5,0)
  4720    ;XPDT(seq  #)=ien^na me^1=use c urrent tra nsport glo bal on sys tem
  4721   "RTN","XPD T",6,0)
  4722    ;XPDT("DA ",ien)=seq  #
  4723   "RTN","XPD T",7,0)
  4724    ;XPDVER=v ersion num ber^packag e name
  4725   "RTN","XPD T",8,0)
  4726    ;XPDGP=fl ag;global^ flag;globa l^...  fla g=1 replac e global a t site
  4727   "RTN","XPD T",9,0)
  4728    N DIR,DIR UT,I,POP,X PD,XPDA,XP DERR,XPDGP ,XPDGREF,X PDH,XPDH1, XPDHD,XPDI ,XPDNM,XPD SEQ,XPDSIZ ,XPDSIZA,X PDT,XPDTP, XPDVER
  4729   "RTN","XPD T",10,0)
  4730    N DUOUT,D TOUT,XPDFM SG,X,Y,Z,Z 1
  4731   "RTN","XPD T",11,0)
  4732    K ^TMP($J ,"XPD")
  4733   "RTN","XPD T",12,0)
  4734    S XPD="Fi rst Packag e Name: ", DIR(0)="Y" ,DIR("A")= "   Use th is Transpo rt Global" ,DIR("?")= "Yes, will  use the c urrent Tra nsport Glo bal on you r system.  No, will c reate a ne w one.",XP DT=0
  4735   "RTN","XPD T",13,0)
  4736    W !!,"Ent er the Pac kage Names  to be tra nsported.  The order  in which", !,"they ar e entered  will be th e order in  which the y are inst alled.",!!
  4737   "RTN","XPD T",14,0)
  4738    F  S XPDA =$$DIC^XPD E("AEMQZ", XPD) Q:'XP DA  D  Q:$ D(DIRUT)!$ D(XPDERR)
  4739   "RTN","XPD T",15,0)
  4740    .S:'XPDT  XPD="Anoth er Package  Name: "
  4741   "RTN","XPD T",16,0)
  4742    .;XPDI=na me^1=use c urrent tra nsport glo bal
  4743   "RTN","XPD T",17,0)
  4744    .S XPDI=$ P(Y(0),U)_ "^"
  4745   "RTN","XPD T",18,0)
  4746    .I $D(XPD T("DA",XPD A)) W "    ",$P(Y(0), U)," alrea dy listed" ,! Q
  4747   "RTN","XPD T",19,0)
  4748    .;if type  is Global  Package,  set DIRUT  if there i s other pa ckages
  4749   "RTN","XPD T",20,0)
  4750    .I $P(Y(0 ),U,3)=2 W  "   GLOBA L PACKAGE"  D  Q
  4751   "RTN","XPD T",21,0)
  4752    ..;if the re is alre ady a pack age in dis tribution,  abort
  4753   "RTN","XPD T",22,0)
  4754    ..I XPDT  S DIRUT=1  W !,"A GLO BAL PACKAG E cannot b e sent wit h any othe r packages " Q
  4755   "RTN","XPD T",23,0)
  4756    ..I $D(^X TMP("XPDT" ,XPDA)) W  "  **Canno t have a p re-existin g Transpor t Global** " S DIRUT= 1 Q
  4757   "RTN","XPD T",24,0)
  4758    ..W !?10, "will tran sport the  following  globals:", ! S X=0,XP DGP=""
  4759   "RTN","XPD T",25,0)
  4760    ..F  S X= $O(^XPD(9. 6,XPDA,"GL O",X)) Q:' X  S Z=$G( ^(X,0)) I  $P(Z,U)]""  S XPDGP=X PDGP_($P(Z ,U,2)="y") _";"_$P(Z, U)_"^" W ? 12,$P(Z,U) ,!
  4761   "RTN","XPD T",26,0)
  4762    ..;XPDERR  is set to  quit loop , so no ot her packag es can be  added
  4763   "RTN","XPD T",27,0)
  4764    ..S XPDER R=1,XPDT=X PDT+1,XPDT (XPDT)=XPD A_U_XPDI,X PDT("DA",X PDA)=XPDT
  4765   "RTN","XPD T",28,0)
  4766    .Q:$D(XPD ERR)
  4767   "RTN","XPD T",29,0)
  4768    .D PCK(XP DA,XPDI)
  4769   "RTN","XPD T",30,0)
  4770    .;multi-p ackage
  4771   "RTN","XPD T",31,0)
  4772    .Q:$P(Y(0 ),U,3)'=1
  4773   "RTN","XPD T",32,0)
  4774    .W "   (M ulti-Packa ge)" S X=0
  4775   "RTN","XPD T",33,0)
  4776    .I XPDT>1  S DIRUT=1  W !,"A Ma ster Build  must be t he first/o nly packag e in a tra nsport" Q
  4777   "RTN","XPD T",34,0)
  4778    .F  S X=$ O(^XPD(9.6 ,XPDA,10,X )) Q:'X  S  Z=$P($G(^ (X,0)),U), Z1=$P($G(^ (0)),U,2)  D:Z]""
  4779   "RTN","XPD T",35,0)
  4780    ..N XPDA, X
  4781   "RTN","XPD T",36,0)
  4782    ..W !?3,Z  S XPDA=$O (^XPD(9.6, "B",Z,0))
  4783   "RTN","XPD T",37,0)
  4784    ..I 'XPDA  W "  **Ca n't find d efinition  in Build f ile**" Q
  4785   "RTN","XPD T",38,0)
  4786    ..I $D(XP DT("DA",XP DA)) W "   already li sted" Q
  4787   "RTN","XPD T",39,0)
  4788    ..D PCK(X PDA,Z,Z1)
  4789   "RTN","XPD T",40,0)
  4790    .S XPDERR =1 ;XPDERR  is set to  quit loop , so no ot her packag es can be  added
  4791   "RTN","XPD T",41,0)
  4792    .Q
  4793   "RTN","XPD T",42,0)
  4794    G:'XPDT!$ D(DIRUT) Q UIT K XPDE RR
  4795   "RTN","XPD T",43,0)
  4796    W !!,"ORD ER   PACKA GE",!
  4797   "RTN","XPD T",44,0)
  4798    F XPDT=1: 1:XPDT S Y =$P(XPDT(X PDT),U,2)  W ?2,XPDT, ?7,Y D  W  !
  4799   "RTN","XPD T",45,0)
  4800    .W:$P(XPD T(XPDT),U, 3) "     * *will use  current Tr ansport Gl obal**"
  4801   "RTN","XPD T",46,0)
  4802    .;check i f New Vers ion and si ngle packa ge, has Pa ckage File  Link, Pac kage App.  History
  4803   "RTN","XPD T",47,0)
  4804    .Q:Y["*"! '$$PAH(+XP DT(XPDT))
  4805   "RTN","XPD T",48,0)
  4806    .S DIR(0) ="Y",DIR(" A")="Send  the PATCH  APPLICATIO N HISTORY  from the P ACKAGE fil e",DIR("B" )="YES"
  4807   "RTN","XPD T",49,0)
  4808    .W !! D ^ DIR I 'Y S  $P(XPDT(X PDT),U,5)= 1
  4809   "RTN","XPD T",50,0)
  4810    S DIR(0)= "Y",DIR("A ")="OK to  continue", DIR("B")=" YES",XPDH= ""
  4811   "RTN","XPD T",51,0)
  4812    W !! D ^D IR G:$D(DI RUT)!'Y QU IT K DIR
  4813   "RTN","XPD T",52,0)
  4814    I $G(XPDT P),XPDT>1  W !!,"You  cannot sen d multiple  Builds th rough Pack Man."
  4815   "RTN","XPD T",53,0)
  4816    S DIR(0)= "SAO^HF:Ho st File"_$ S(XPDT=1:" ;PM:PackMa n",1:"")
  4817   "RTN","XPD T",54,0)
  4818    S DIR("A" )="Transpo rt through  (HF)Host  File"_$S(X PDT=1:" or  (PM)PackM an: ",1:":  ")
  4819   "RTN","XPD T",55,0)
  4820    S DIR("?" )="Enter t he method  of transpo rt for the  package(s )."
  4821   "RTN","XPD T",56,0)
  4822    D ^DIR G: $D(DTOUT)! $D(DUOUT)  QUIT K DIR
  4823   "RTN","XPD T",57,0)
  4824    I Y="" W  !,"No Tran sport Meth od selecte d, will on ly write T ransport G lobal to ^ XTMP." S X PDH=""
  4825   "RTN","XPD T",58,0)
  4826    ;XPDTP =  transports  using Pac kman
  4827   "RTN","XPD T",59,0)
  4828    S:Y="PM"  XPDTP=1
  4829   "RTN","XPD T",60,0)
  4830    I $D(XPDG P),Y'="HF"  W !,"**Gl obal Packa ge can onl y be sent  with a Hos t File, Tr ansport AB ORTED**" Q
  4831   "RTN","XPD T",61,0)
  4832    I Y="HF"  D DEV G:PO P QUIT
  4833   "RTN","XPD T",62,0)
  4834    W !!
  4835   "RTN","XPD T",63,0)
  4836    F XPDT=1: 1:XPDT S X PDA=XPDT(X PDT),XPDNM =$P(XPDA,U ,2) D  G:$ D(XPDERR)  ABORT
  4837   "RTN","XPD T",64,0)
  4838    .W !?5,XP DNM,"..."  S XPDGREF= "^XTMP(""X PDT"","_+X PDA_",""TE MP"")"
  4839   "RTN","XPD T",65,0)
  4840    .;if usin g current  transport  global, ru n pre-tran sp routine  and quit
  4841   "RTN","XPD T",66,0)
  4842    .I $P(XPD A,U,3) S X PDA=+XPDA  D PRET Q
  4843   "RTN","XPD T",67,0)
  4844    .;if pack age file l ink then s et XPDVER= version nu mber^packa ge name
  4845   "RTN","XPD T",68,0)
  4846    .S XPDA=+ XPDA,XPDVE R=$S($P(^X PD(9.6,XPD A,0),U,2): $$VER^XPDU TL(XPDNM)_ U_$$PKG^XP DUTL(XPDNM ),1:"")
  4847   "RTN","XPD T",69,0)
  4848    .;Inc the  Build num ber
  4849   "RTN","XPD T",70,0)
  4850    .S $P(^XP D(9.6,XPDA ,6.3),U)=$ G(^XPD(9.6 ,XPDA,6.3) )+1
  4851   "RTN","XPD T",71,0)
  4852    .K ^XTMP( "XPDT",XPD A)
  4853   "RTN","XPD T",72,0)
  4854    .;GLOBAL  PACKAGE
  4855   "RTN","XPD T",73,0)
  4856    .I $D(XPD GP) D  S X PDT=1 Q
  4857   "RTN","XPD T",74,0)
  4858    ..;can't  send globa l package  in packman  message
  4859   "RTN","XPD T",75,0)
  4860    ..I $G(XP DTP) S XPD ERR=1 Q
  4861   "RTN","XPD T",76,0)
  4862    ..;verify  global pa ckage
  4863   "RTN","XPD T",77,0)
  4864    ..I '$$GL OPKG^XPDV( XPDA) S XP DERR=1 Q
  4865   "RTN","XPD T",78,0)
  4866    ..;get En vironment  check and  Post Insta ll routine s
  4867   "RTN","XPD T",79,0)
  4868    ..F Y="PR E","INIT"  I $G(^XPD( 9.6,XPDA,Y ))]"" S X= ^(Y) D
  4869   "RTN","XPD T",80,0)
  4870    ...S ^XTM P("XPDT",X PDA,Y)=X,X =$P(X,U,$L (X,U)),%=$ $LOAD^XPDT A(X,"0^")
  4871   "RTN","XPD T",81,0)
  4872    ..D BLD^X PDTC,PRET
  4873   "RTN","XPD T",82,0)
  4874    .F X="DD^ XPDTC","KR N^XPDTC"," QUES^XPDTC ","INT^XPD TC","BLD^X PDTC" D @X  Q:$D(XPDE RR)
  4875   "RTN","XPD T",83,0)
  4876    .D:'$D(XP DERR) PRET
  4877   "RTN","XPD T",84,0)
  4878    ;XPDTP -  call ^XPDT P to build  Packman m essage
  4879   "RTN","XPD T",85,0)
  4880    I $G(XPDT P) S XPDA= +XPDT(XPDT ) D ^XPDTP  G QUIT
  4881   "RTN","XPD T",86,0)
  4882    I $L(XPDH ) D GO G Q UIT
  4883   "RTN","XPD T",87,0)
  4884    ;if no de vice then  just creat e transpor t global
  4885   "RTN","XPD T",88,0)
  4886    W !! F XP DT=1:1:XPD T W "Trans port Globa l ^XTMP("" XPDT"","_+ XPDT(XPDT) _") create d for ",$P (XPDT(XPDT ),U,2),!
  4887   "RTN","XPD T",89,0)
  4888    Q
  4889   "RTN","XPD T",90,0)
  4890   DEV N FIL, DIR,IOP,X, Y,%ZIS W !
  4891   "RTN","XPD T",91,0)
  4892    D HOME^%Z IS
  4893   "RTN","XPD T",92,0)
  4894    S DIR(0)= "F^3:245", DIR("A")=" Enter a Ho st File",D IR("?")="E nter a fil ename and/ or path to  output pa ckage(s)." ,POP=0
  4895   "RTN","XPD T",93,0)
  4896    D ^DIR I  $D(DTOUT)! $D(DUOUT)  S POP=1 Q
  4897   "RTN","XPD T",94,0)
  4898    ;if no fi le, then q uit
  4899   "RTN","XPD T",95,0)
  4900    Q:Y=""  S  FIL=Y
  4901   "RTN","XPD T",96,0)
  4902    S DIR(0)= "F^3:80",D IR("A")="H eader Comm ent",DIR(" ?")="Enter  a comment  between 3  and 80 ch aracters."
  4903   "RTN","XPD T",97,0)
  4904    D ^DIR I  $D(DIRUT)  S POP=1 Q
  4905   "RTN","XPD T",98,0)
  4906    S XPDH=Y, %ZIS="",%Z IS("HFSNAM E")=FIL,%Z IS("HFSMOD E")="W",IO P="HFS",(X PDSIZ,XPDS IZA)=0,XPD SEQ=1
  4907   "RTN","XPD T",99,0)
  4908    D ^%ZIS I  POP W !!, "**Incorre ct Host Fi le name**" ,!,$C(7) Q
  4909   "RTN","XPD T",100,0)
  4910    ;write da te and com ment heade r
  4911   "RTN","XPD T",101,0)
  4912    S XPDHD=" KIDS Distr ibution sa ved on "_$ $HTE^XLFDT ($H)
  4913   "RTN","XPD T",102,0)
  4914    U IO W $$ SUM(XPDHD) ,!,$$SUM(X PDH),!
  4915   "RTN","XPD T",103,0)
  4916    S XPDFMSG =1 ;Send m ail to for um of rout ines in HF S.
  4917   "RTN","XPD T",104,0)
  4918    ;U IO(0)  is to insu re I am wr iting to t he termina l
  4919   "RTN","XPD T",105,0)
  4920    U IO(0) Q
  4921   "RTN","XPD T",106,0)
  4922    ;
  4923   "RTN","XPD T",107,0)
  4924   GO S I=1,Y ="",XPDH1= "**KIDS**: " U IO
  4925   "RTN","XPD T",108,0)
  4926    ;Global P ackage, he ader is di fferent an d there is  only 1 pa ckage
  4927   "RTN","XPD T",109,0)
  4928    I $D(XPDG P) W $$SUM ("**KIDS** GLOBALS:"_ $P(XPDT(1) ,U,2)_U_XP DGP),! G G O1
  4929   "RTN","XPD T",110,0)
  4930    ;write he ader that  maintains  package li st, keep l ess than 2 55 char
  4931   "RTN","XPD T",111,0)
  4932    F  D  W $ $SUM(XPDH1 _Y),! Q:I= XPDT  S Y= "",I=I+1,X PDH1="**KI DS**"
  4933   "RTN","XPD T",112,0)
  4934    .F I=I:1  S Y=Y_$P(X PDT(I),U,2 )_"^" Q:$L (Y)>200!(I =XPDT)
  4935   "RTN","XPD T",113,0)
  4936    ;after th e package  list write  an extra  line feed
  4937   "RTN","XPD T",114,0)
  4938   GO1 W ! S  XPDSIZA=XP DSIZA+2
  4939   "RTN","XPD T",115,0)
  4940    N XMSUB,X MY,XMTEXT
  4941   "RTN","XPD T",116,0)
  4942    ;loop thr u & write  global, do n't kill i f set to p ermanent,  set in XPD IU
  4943   "RTN","XPD T",117,0)
  4944    F XPDT=1: 1:XPDT S X PDA=+XPDT( XPDT),XPDN M=$P(XPDT( XPDT),U,2)  D GW,XM K :'$G(^XTMP ("XPDT",XP DA)) ^(XPD A)
  4945   "RTN","XPD T",118,0)
  4946    W "**END* *",!
  4947   "RTN","XPD T",119,0)
  4948    ;GLOBAL P ACKAGE the re could o nly be one  package,  write glob als
  4949   "RTN","XPD T",120,0)
  4950    I $D(XPDG P) D GPW W  "**END**" ,!
  4951   "RTN","XPD T",121,0)
  4952    ;we're do ne with de vice, clos e it
  4953   "RTN","XPD T",122,0)
  4954    W "**END* *",! D ^%Z ISC
  4955   "RTN","XPD T",123,0)
  4956    W !!,"Pac kage Trans ported Suc cessfully" ,!
  4957   "RTN","XPD T",124,0)
  4958    Q
  4959   "RTN","XPD T",125,0)
  4960   GW ;global  write
  4961   "RTN","XPD T",126,0)
  4962    N GR,GCK, GL
  4963   "RTN","XPD T",127,0)
  4964    S GCK="^X TMP(""XPDT "","_XPDA, GR=GCK_")" ,GCK=GCK_" ,",GL=$L(G CK)
  4965   "RTN","XPD T",128,0)
  4966    ;INSTALL  NAME line  will mark  the beginn ing of glo bal for al l lines un til
  4967   "RTN","XPD T",129,0)
  4968    ;the next  INSTALL N AME
  4969   "RTN","XPD T",130,0)
  4970    W $$SUM(" **INSTALL  NAME**",1) ,!,$$SUM(X PDNM),!
  4971   "RTN","XPD T",131,0)
  4972    F  Q:$D(D IRUT)  S G R=$Q(@GR)  Q:GR=""!($ E(GR,1,GL) '=GCK)  W  $$SUM($P(G R,GCK,2),1 ),!,$$SUM( @GR),!
  4973   "RTN","XPD T",132,0)
  4974    Q
  4975   "RTN","XPD T",133,0)
  4976   XM ;Send H FS checksu m message
  4977   "RTN","XPD T",134,0)
  4978    Q:'$G(XPD FMSG)
  4979   "RTN","XPD T",135,0)
  4980    N XMTEXT, C,RN,RN2,X ,X2
  4981   "RTN","XPD T",136,0)
  4982    K ^TMP($J )
  4983   "RTN","XPD T",137,0)
  4984    S XMSUB=" **KIDS** C hecksum fo r "_XPDNM, XMTEXT="^T MP($J)"
  4985   "RTN","XPD T",138,0)
  4986    I $G(^XMB ("NETNAME" ))[" DOM A IN . EXT " S XMY("S .A1AE HFS  CHKSUM SVR @ D O
M
A IN . EXT    ")=""
  4987   "RTN","XPD T",139,0)
  4988    E  S X=$$ GET^XPAR(" PKG","XPD  PATCH HFS  SERVER",1, "Q") S:$L( X) XMY(X)= ""
  4989   "RTN","XPD T",140,0)
  4990    I '$D(XMY ) Q  ;No o ne to send  it to.
  4991   "RTN","XPD T",141,0)
  4992    S C=1,@XM TEXT@(1,0) ="~~1:"_XP DNM
  4993   "RTN","XPD T",142,0)
  4994    I XPDT=1, $O(XPDT(1) ) D
  4995   "RTN","XPD T",143,0)
  4996    . S RN=1  F  S RN=$O (XPDT(RN))  Q:'RN  S  C=C+1,@XMT EXT@(C,0)= "~~2:"_$P( XPDT(RN)," ^",2)
  4997   "RTN","XPD T",144,0)
  4998    S (RN,RN2 )="" ;Send  full RTN  node
  4999   "RTN","XPD T",145,0)
  5000    F  S RN=$ O(^XTMP("X PDT",XPDA, "RTN",RN))  Q:'$L(RN)   S X=^(RN ),X2=$G(^( RN,2,0)) D
  5001   "RTN","XPD T",146,0)
  5002    . S C=C+1 ,@XMTEXT@( C,0)="~~3: "_RN_"^"_X _"^"_$P(X2 ,";",5)
  5003   "RTN","XPD T",147,0)
  5004    . I RN2=" ",$E(X2,1, 3)=" ;;" S  RN2=$P(X2 ,"**",1)_" **[Patch L ist]**"_$P (X2,"**",3 )
  5005   "RTN","XPD T",148,0)
  5006    S C=C+1,@ XMTEXT@(C, 0)="~~4:"_ RN2
  5007   "RTN","XPD T",149,0)
  5008    S C=C+1,@ XMTEXT@(C, 0)="~~8:"_ $G(^XMB("N ETNAME"))
  5009   "RTN","XPD T",150,0)
  5010    S C=C+1,@ XMTEXT@(C, 0)="~~9:Sa ve"
  5011   "RTN","XPD T",151,0)
  5012    S XMTEXT= "^TMP($J,"
  5013   "RTN","XPD T",152,0)
  5014    D ^XMD
  5015   "RTN","XPD T",153,0)
  5016    Q
  5017   "RTN","XPD T",154,0)
  5018   GPW ;globa l package  write
  5019   "RTN","XPD T",155,0)
  5020    N I,G,GR, GCK,GL
  5021   "RTN","XPD T",156,0)
  5022    W !
  5023   "RTN","XPD T",157,0)
  5024    F I=1:1 S  G=$P(XPDG P,U,I) Q:G =""  D
  5025   "RTN","XPD T",158,0)
  5026    .S GR="^" _$P(G,";", 2),GCK=$S( GR[")":$E( GR,1,$L(GR )-1)_",",1 :GR_"("),G L=$L(GCK)
  5027   "RTN","XPD T",159,0)
  5028    .;GLOBAL  line will  mark the b eginning o f global f or all lin es until
  5029   "RTN","XPD T",160,0)
  5030    .;the nex t GLOBAL
  5031   "RTN","XPD T",161,0)
  5032    .W $$SUM( "**GLOBAL* *",1),!,$$ SUM(GR),!
  5033   "RTN","XPD T",162,0)
  5034    .F  Q:$D( DIRUT)  S  GR=$Q(@GR)  Q:GR=""!( $E(GR,1,GL )'=GCK)  W  $$SUM($P( GR,GCK,2), 1),!,$$SUM (@GR),!
  5035   "RTN","XPD T",163,0)
  5036    Q
  5037   "RTN","XPD T",164,0)
  5038   QUIT F XPD T=1:1:XPDT  L -^XPD(9 .6,+XPDT(X PDT))
  5039   "RTN","XPD T",165,0)
  5040    Q
  5041   "RTN","XPD T",166,0)
  5042   ABORT W !! ,"**TRANSP ORT ABORTE D**",*7
  5043   "RTN","XPD T",167,0)
  5044    D QUIT
  5045   "RTN","XPD T",168,0)
  5046    F XPDT=1: 1:XPDT K ^ XTMP("XPDT ",+XPDT(XP DT))
  5047   "RTN","XPD T",169,0)
  5048    ;if HF, s ave file n ame IO int o XPDH
  5049   "RTN","XPD T",170,0)
  5050    S:$L(XPDH ) XPDH=IO
  5051   "RTN","XPD T",171,0)
  5052    D ^%ZISC
  5053   "RTN","XPD T",172,0)
  5054    ;if HF, t hen delete  file
  5055   "RTN","XPD T",173,0)
  5056    I $L(XPDH ),$$DEL1^% ZISH(XPDH)  W !,"File :  ",XPDH, "  (Delete d)"
  5057   "RTN","XPD T",174,0)
  5058    Q
  5059   "RTN","XPD T",175,0)
  5060    ;
  5061   "RTN","XPD T",176,0)
  5062   PCK(XPDA,X PDNM,XPDRE Q) ;XPDA=B uild ien,  XPDNM=Buil d name, XP DREQ=Requi red
  5063   "RTN","XPD T",177,0)
  5064    N Y
  5065   "RTN","XPD T",178,0)
  5066    S XPDT=XP DT+1,XPDT( XPDT)=XPDA _U_XPDNM,X PDT("DA",X PDA)=XPDT
  5067   "RTN","XPD T",179,0)
  5068    S:'$G(XPD REQ) XPDRE Q=0
  5069   "RTN","XPD T",180,0)
  5070    S $P(XPDT (XPDT),U,4 )=XPDREQ
  5071   "RTN","XPD T",181,0)
  5072    Q:'$D(^XT MP("XPDT", XPDA))  S  Y=$G(^(XPD A))
  5073   "RTN","XPD T",182,0)
  5074    W "     * *Transport  Global ex ists**"
  5075   "RTN","XPD T",183,0)
  5076    ;Y=1 if T G is perma nent
  5077   "RTN","XPD T",184,0)
  5078    I Y S $P( XPDT(XPDT) ,U,3)=1 Q
  5079   "RTN","XPD T",185,0)
  5080    ;ask if t hey want t o use TG
  5081   "RTN","XPD T",186,0)
  5082    D ^DIR S  $P(XPDT(XP DT),U,3)=Y
  5083   "RTN","XPD T",187,0)
  5084    Q
  5085   "RTN","XPD T",188,0)
  5086    ;
  5087   "RTN","XPD T",189,0)
  5088   SUM(X,Z) ; X=string t o write, Z  0=don't c heck size
  5089   "RTN","XPD T",190,0)
  5090    S XPDSIZA =XPDSIZA+$ L(X)+2
  5091   "RTN","XPD T",191,0)
  5092    Q X
  5093   "RTN","XPD T",192,0)
  5094    ;
  5095   "RTN","XPD T",193,0)
  5096   PAH(XPDA)  ;check for  PATCH APP LICATION H ISTORY in  Package fi le
  5097   "RTN","XPD T",194,0)
  5098    N Y,Z
  5099   "RTN","XPD T",195,0)
  5100    S Y=^XPD( 9.6,XPDA,0 ),Z=$$VER^ XPDUTL($P( Y,U))
  5101   "RTN","XPD T",196,0)
  5102    ;Single P ackage, Ve rsion mult iple, PAH  multiple
  5103   "RTN","XPD T",197,0)
  5104    I $P(Y,U, 3)=0,$D(^D IC(9.4,+$P (Y,U,2),22 )),Z S Z=$ O(^(22,"B" ,Z,0)) I Z ,$O(^DIC(9 .4,+$P(Y,U ,2),22,Z," PAH",0)) Q  1
  5105   "RTN","XPD T",198,0)
  5106    Q 0
  5107   "RTN","XPD T",199,0)
  5108    ;
  5109   "RTN","XPD T",200,0)
  5110   PRET ;Pre- Transport  Routine
  5111   "RTN","XPD T",201,0)
  5112    N Y,Z
  5113   "RTN","XPD T",202,0)
  5114    S Y=$G(^X PD(9.6,XPD A,"PRET"))  Q:Y=""
  5115   "RTN","XPD T",203,0)
  5116    I '$$RTN^ XPDV(Y,.Z)  W !!,"Pre -Transport ation Rout ine ",Y,Z, *7 Q
  5117   "RTN","XPD T",204,0)
  5118    S Y=$S(Y[ "^":Y,1:"^ "_Y) W !," Running Pr e-Transpor tation Rou tine ",Y
  5119   "RTN","XPD T",205,0)
  5120    D @Y
  5121   "RTN","XPD T",206,0)
  5122    Q
  5123   "RTN","XPD TA2")
  5124   0^9^B18380 713
  5125   "RTN","XPD TA2",1,0)
  5126   XPDTA2 ;SF ISC/RWF -   Build Act ions for K ernel File s Cont. ;0 8/09/2001   12:36
  5127   "RTN","XPD TA2",2,0)
  5128    ;;8.0;KER NEL;**201, 498,603,67 2**;Jul 10 , 1995;Bui ld 7
  5129   "RTN","XPD TA2",3,0)
  5130    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  5131   "RTN","XPD TA2",4,0)
  5132    Q
  5133   "RTN","XPD TA2",5,0)
  5134    ;^XTMP("X PDT",XPDA, "KRN",XPDF ILE,DA) is  the globa l root
  5135   "RTN","XPD TA2",6,0)
  5136    ;DA=ien i n ^XTMP,XP DNM=packag e name, XP DA=package  ien in ^X PD(9.6,
  5137   "RTN","XPD TA2",7,0)
  5138    ;
  5139   "RTN","XPD TA2",8,0)
  5140   PAR1E1 ;PA RAMETER DE FINITION f ile 8989.5 1: entry p ost
  5141   "RTN","XPD TA2",9,0)
  5142    N XP,XP1, XP2,XP3,XP 4,VP,PN,PT ,ROOT
  5143   "RTN","XPD TA2",10,0)
  5144    S ROOT=$N A(^XTMP("X PDT",XPDA, "KRN"))
  5145   "RTN","XPD TA2",11,0)
  5146    D PAR51(D A) ;Handle  the entry  from 8989 .51
  5147   "RTN","XPD TA2",12,0)
  5148    S PT=$S($ E($G(^XTV( 8989.51,DA ,1)))="P": $P(^(1),U, 2),1:"") ; Data Type  & Value -  check if p ointer in  for loop
  5149   "RTN","XPD TA2",13,0)
  5150    S:PT]"" P T=$S(PT:$$ GR^XPDTA(P T),1:"") ; PT=file #  of pointed  to file f rom parm d ef.
  5151   "RTN","XPD TA2",14,0)
  5152    ;Now find  any entry s in 8989. 5 to trans port, beca use we poi nt to them
  5153   "RTN","XPD TA2",15,0)
  5154    S XP=0,XP 3=$P(^XPD( 9.6,XPDA,0 ),U,2),VP= XP3_";DIC( 9.4,",PN=$ $PT^XPDTA( "^DIC(9.4) ",XP3)
  5155   "RTN","XPD TA2",16,0)
  5156    Q:'XP3  ; No package  file link
  5157   "RTN","XPD TA2",17,0)
  5158    F  S XP=$ O(^XTV(898 9.5,"AC",D A,VP,XP)), XP1=0 Q:'X P  D  ;Ins tance
  5159   "RTN","XPD TA2",18,0)
  5160    . F  S XP 1=$O(^XTV( 8989.5,"AC ",DA,VP,XP ,XP1)) Q:' XP1  D  ;e ntry
  5161   "RTN","XPD TA2",19,0)
  5162    . . M ^XT MP("XPDT", XPDA,"KRN" ,8989.5,XP 1)=^XTV(89 89.5,XP1)
  5163   "RTN","XPD TA2",20,0)
  5164    . . S XP3 =^XTV(8989 .5,XP1,0), XP4=$G(^(1 )) ;param  def.
  5165   "RTN","XPD TA2",21,0)
  5166    . . S $P( @ROOT@(898 9.5,XP1,0) ,U,2)=$$PT ^XPDTA("^X TV(8989.51 )",$P(XP3, U,2))
  5167   "RTN","XPD TA2",22,0)
  5168    . . I PT] "",XP4>0 S  $P(@ROOT@ (8989.5,XP 1,1),U)=$$ PT^XPDTA(P T,XP4) ;Da ta Type po inter - re solve
  5169   "RTN","XPD TA2",23,0)
  5170    . . Q  ;W ill redo t he ENT at  other end.
  5171   "RTN","XPD TA2",24,0)
  5172    Q
  5173   "RTN","XPD TA2",25,0)
  5174    ;
  5175   "RTN","XPD TA2",26,0)
  5176   PAR51(DA)  ;Fix one 8 989.51 ent ry in tran sport glob al
  5177   "RTN","XPD TA2",27,0)
  5178    ;Called f rom both P AR1E1 and  PAR2E1
  5179   "RTN","XPD TA2",28,0)
  5180    N XP,XP1, XP2,XP3,VP ,PN,ROOT
  5181   "RTN","XPD TA2",29,0)
  5182    S ROOT=$N A(^XTMP("X PDT",XPDA, "KRN"))
  5183   "RTN","XPD TA2",30,0)
  5184    ;Don't br ing X-ref
  5185   "RTN","XPD TA2",31,0)
  5186    K @ROOT@( 8989.51,DA ,30,"B"),^ ("AG")
  5187   "RTN","XPD TA2",32,0)
  5188    S XP=0
  5189   "RTN","XPD TA2",33,0)
  5190    ;Entries  in the fil e will be  maintained  by Toolki t patches.
  5191   "RTN","XPD TA2",34,0)
  5192    Q
  5193   "RTN","XPD TA2",35,0)
  5194    ;
  5195   "RTN","XPD TA2",36,0)
  5196   PAR2E1 ;PA RAMETER fi le 8989.52  entry pos t
  5197   "RTN","XPD TA2",37,0)
  5198    N XP1,XP2 ,XP3,ROOT
  5199   "RTN","XPD TA2",38,0)
  5200    S ROOT=$N A(^XTMP("X PDT",XPDA, "KRN"))
  5201   "RTN","XPD TA2",39,0)
  5202    ;Resolve  USE INSTAN CE OF
  5203   "RTN","XPD TA2",40,0)
  5204    S XP2=$P( ^XTV(8989. 52,DA,0),U ,4),XP3=""  I XP2 S X P3=$$PT^XP DTA($NA(^X TV(8989.51 )),XP2)
  5205   "RTN","XPD TA2",41,0)
  5206    I $L(XP3)  S $P(@ROO T@(8989.52 ,DA,0),U,4 )=XP3
  5207   "RTN","XPD TA2",42,0)
  5208    ;Resolve  PARAMETERS
  5209   "RTN","XPD TA2",43,0)
  5210    S XP1=0 K  ^XTMP("XP DT",XPDA," KRN",8989. 52,DA,10," B") ;Drop  X-ref
  5211   "RTN","XPD TA2",44,0)
  5212    F  S XP1= $O(^XTV(89 89.52,DA,1 0,XP1)),XP 3="" Q:'XP 1  D
  5213   "RTN","XPD TA2",45,0)
  5214    . S XP2=$ P(^XTV(898 9.52,DA,10 ,XP1,0),U, 2)
  5215   "RTN","XPD TA2",46,0)
  5216    . I XP2 S  XP3=$$PT^ XPDTA($NA( ^XTV(8989. 51)),XP2)
  5217   "RTN","XPD TA2",47,0)
  5218    . I '$L(X P3) K @ROO T@(8989.52 ,DA,10,XP1 )
  5219   "RTN","XPD TA2",48,0)
  5220    . S $P(^X TMP("XPDT" ,XPDA,"KRN ",8989.52, DA,10,XP1, 0),U,2)=XP 3
  5221   "RTN","XPD TA2",49,0)
  5222    . ;Now to  move the  entries th is points  to.
  5223   "RTN","XPD TA2",50,0)
  5224    . I '$D(@ ROOT@(8989 .51,XP2))  M @ROOT@(8 989.51,XP2 )=^XTV(898 9.51,XP2)  D PAR51(XP 2)
  5225   "RTN","XPD TA2",51,0)
  5226    . Q
  5227   "RTN","XPD TA2",52,0)
  5228    Q
  5229   "RTN","XPD TA2",53,0)
  5230   XULM ;XULM  LOCK DICT IONARY fil e 8993
  5231   "RTN","XPD TA2",54,0)
  5232    N XP1,XP2
  5233   "RTN","XPD TA2",55,0)
  5234    ;resolve  PACKAGE
  5235   "RTN","XPD TA2",56,0)
  5236    S XP1=$P( $G(^XTMP(" XPDT",XPDA ,"KRN",899 3,DA,1)),U )
  5237   "RTN","XPD TA2",57,0)
  5238    S:XP1 $P( ^XTMP("XPD T",XPDA,"K RN",8993,D A,1),U)=$$ PT^XPDTA(" ^DIC(9.4)" ,XP1)
  5239   "RTN","XPD TA2",58,0)
  5240    ;kill X-r ef
  5241   "RTN","XPD TA2",59,0)
  5242    K ^XTMP(" XPDT",XPDA ,"KRN",899 3,2,"B"),^ XTMP("XPDT ",XPDA,"KR N",8993,3, "B"),^("C" )
  5243   "RTN","XPD TA2",60,0)
  5244    Q
  5245   "RTN","XPD TA2",61,0)
  5246    ;
  5247   "RTN","XPD TA2",62,0)
  5248   ENT ;ENTIT Y file 1.5
  5249   "RTN","XPD TA2",63,0)
  5250    N %,%1
  5251   "RTN","XPD TA2",64,0)
  5252    ;Loop thr u ITEM mul tiple and  resolve EN TITY (0;8)
  5253   "RTN","XPD TA2",65,0)
  5254    S %1=0 F   S %1=$O(^ XTMP("XPDT ",XPDA,"KR N",1.5,DA, 1,%1)) Q:' %1  S %=$G (^(%1,0))  D:$P(%,U,8 )
  5255   "RTN","XPD TA2",66,0)
  5256    . S $P(%, U,8)=$$PT^ XPDTA("^DD E",$P(%,U, 8)),^XTMP( "XPDT",XPD A,"KRN",1. 5,DA,1,%1, 0)=%
  5257   "RTN","XPD TA2",67,0)
  5258    Q
  5259   "RTN","XPD TA2",68,0)
  5260    ;
  5261   "RTN","XPD TA2",69,0)
  5262   POL ;POLIC Y file 1.6
  5263   "RTN","XPD TA2",70,0)
  5264    N %,%1,%2
  5265   "RTN","XPD TA2",71,0)
  5266    ;if link,  kill ever ything and  just proc ess the ME MBERS(10)
  5267   "RTN","XPD TA2",72,0)
  5268    I XPDFL=2  D  G POLM
  5269   "RTN","XPD TA2",73,0)
  5270    .S %1=0 F   S %1=$O( ^XTMP("XPD T",XPDA,"K RN",1.6,DA ,%1)) Q:'% 1  K:%1'=1 0 ^(%)
  5271   "RTN","XPD TA2",74,0)
  5272    .Q
  5273   "RTN","XPD TA2",75,0)
  5274    ;resolve  ATTRIBUTE  FUNCTION ( 0;4) and R ESULT FUNC TION (0;7)
  5275   "RTN","XPD TA2",76,0)
  5276    S %=^XTMP ("XPDT",XP DA,"KRN",1 .6,DA,0) D   S ^XTMP( "XPDT",XPD A,"KRN",1. 6,DA,0)=%
  5277   "RTN","XPD TA2",77,0)
  5278    .F %1=4,7  S %2=$P(% ,U,%1),$P( %,U,%1)=$$ PT^XPDTA(" ^DIAC(1.62 )",%2)
  5279   "RTN","XPD TA2",78,0)
  5280    .Q
  5281   "RTN","XPD TA2",79,0)
  5282    ;resolve  DENY OBLIG ATION (7)  and PERMIT  OBLIGATIO N (8)
  5283   "RTN","XPD TA2",80,0)
  5284    F %1=7,8  S %=$G(^XT MP("XPDT", XPDA,"KRN" ,1.6,DA,%1 )) D:$L(%)
  5285   "RTN","XPD TA2",81,0)
  5286    .S %2=$P( %,U),$P(%, U)=$$PT^XP DTA("^DIAC (1.62)",%2 )
  5287   "RTN","XPD TA2",82,0)
  5288    .S ^XTMP( "XPDT",XPD A,"KRN",1. 6,DA,%1)=%
  5289   "RTN","XPD TA2",83,0)
  5290    .Q
  5291   "RTN","XPD TA2",84,0)
  5292    ;kill und er TAGETS  (2) ^("B") ,^("AKEY")
  5293   "RTN","XPD TA2",85,0)
  5294    I $O(^XTM P("XPDT",X PDA,"KRN", 1.6,DA,2,0 )) K ^("B" ),^("AKEY" )
  5295   "RTN","XPD TA2",86,0)
  5296    ;check if  CONDITION S (3) are  sent, if y es then ki ll ^("B")  and proces s
  5297   "RTN","XPD TA2",87,0)
  5298    I $O(^XTM P("XPDT",X PDA,"KRN", 1.6,DA,3,0 )) K ^("B" ) D
  5299   "RTN","XPD TA2",88,0)
  5300    .;loop th ru and res olve FUNCT ION (0;2)
  5301   "RTN","XPD TA2",89,0)
  5302    .S %1=0 F   S %1=$O( ^XTMP("XPD T",XPDA,"K RN",1.6,DA ,3,%1)) Q: '%1  S %=$ G(^(%1,0))  D
  5303   "RTN","XPD TA2",90,0)
  5304    ..S %2=$P (%,U,2) Q: '%2
  5305   "RTN","XPD TA2",91,0)
  5306    ..S $P(%, U,2)=$$PT^ XPDTA("^DI AC(1.62)", %2)
  5307   "RTN","XPD TA2",92,0)
  5308    ..S ^XTMP ("XPDT",XP DA,"KRN",1 .6,DA,3,%1 ,0)=%
  5309   "RTN","XPD TA2",93,0)
  5310    .Q
  5311   "RTN","XPD TA2",94,0)
  5312   POLM ;loop  thru 10=M EMEBERS an d resolve  MEMBER (0; 1), kill i f it doesn 't resolve
  5313   "RTN","XPD TA2",95,0)
  5314    Q:'$O(^XT MP("XPDT", XPDA,"KRN" ,1.6,DA,10 ,0))
  5315   "RTN","XPD TA2",96,0)
  5316    ;kill und er MEMBERS  (10), "B" =name, "AC "=SEQUENCE
  5317   "RTN","XPD TA2",97,0)
  5318    K ^XTMP(" XPDT",XPDA ,"KRN",1.6 ,DA,10,"B" ),^("AC")
  5319   "RTN","XPD TA2",98,0)
  5320    S %1=0 F   S %1=$O(^ XTMP("XPDT ",XPDA,"KR N",1.6,DA, 10,%1)) Q: '%1  S %=$ G(^(%1,0))  D
  5321   "RTN","XPD TA2",99,0)
  5322    .S %2=$$P T^XPDTA("^ DIAC(1.6)" ,+%)
  5323   "RTN","XPD TA2",100,0 )
  5324    .;MEMBER  must also  be sent by  itself, c heck "B" x -ref, save  text on U  node
  5325   "RTN","XPD TA2",101,0 )
  5326    .I $L(%2) ,$D(^XPD(9 .6,XPDA,"K RN",1.6,"N M","B",%2) ) S ^XTMP( "XPDT",XPD A,"KRN",1. 6,DA,10,%1 ,U)=%2 Q
  5327   "RTN","XPD TA2",102,0 )
  5328    .K ^XTMP( "XPDT",XPD A,"KRN",1. 6,DA,10,%1 )
  5329   "RTN","XPD TA2",103,0 )
  5330    .Q
  5331   "RTN","XPD TA2",104,0 )
  5332    Q
  5333   "RTN","XPD TA2",105,0 )
  5334    ;
  5335   "RTN","XPD TA2",106,0 )
  5336   POLE ;EVEN T #1.61
  5337   "RTN","XPD TA2",107,0 )
  5338    N %,%1,%2
  5339   "RTN","XPD TA2",108,0 )
  5340    S %=^XTMP ("XPDT",XP DA,"KRN",1 .61,DA,0)
  5341   "RTN","XPD TA2",109,0 )
  5342    ;resolve  POLICY (0; 5)
  5343   "RTN","XPD TA2",110,0 )
  5344    S %1=$P(% ,U,5) Q:'% 1
  5345   "RTN","XPD TA2",111,0 )
  5346    S %2=$$PT ^XPDTA("^D IAC(1.6)", %1),$P(%,U ,5)=%2,^XT MP("XPDT", XPDA,"KRN" ,1.61,DA,0 )=%
  5347   "RTN","XPD TA2",112,0 )
  5348    Q
  5349   "RTN","XPD TA2",113,0 )
  5350    ;
  5351   "RTN","XPD TA2",114,0 )
  5352   POLF ;FUNC TION #1.62
  5353   "RTN","XPD TA2",115,0 )
  5354    Q
  5355   "RTN","XPD TC")
  5356   0^7^B46881 298
  5357   "RTN","XPD TC",1,0)
  5358   XPDTC ;SFI SC/RSD - T ransport c alls ;10/1 5/2008
  5359   "RTN","XPD TC",2,0)
  5360    ;;8.0;KER NEL;**10,1 5,21,39,41 ,44,58,83, 92,95,100, 108,124,13 1,463,511, 517,559,60 3,672**;Ju l 10, 1995 ;Build 7
  5361   "RTN","XPD TC",3,0)
  5362    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  5363   "RTN","XPD TC",4,0)
  5364    Q
  5365   "RTN","XPD TC",5,0)
  5366    ;^XTMP("X PDT",XPDA, data type, file #,
  5367   "RTN","XPD TC",6,0)
  5368    ;XPDA=ien  of File 9 .6, XPDNM= .01 field
  5369   "RTN","XPD TC",7,0)
  5370   DD ;build  DD
  5371   "RTN","XPD TC",8,0)
  5372    N FILE,FG R,FNAM,Z2, Z3,Z4
  5373   "RTN","XPD TC",9,0)
  5374    S FILE=0, FGR="^XTMP (""XPDT"", XPDA)",FNA M=$NA(^XPD (9.6,XPDA, 4,"APDD"))
  5375   "RTN","XPD TC",10,0)
  5376    F  S FILE =$O(^XPD(9 .6,XPDA,4, FILE)) Q:' FILE  D
  5377   "RTN","XPD TC",11,0)
  5378    .S Z2=$G( ^XPD(9.6,X PDA,4,FILE ,222)),Z3= $G(^(223)) ,Z4=$G(^(2 24))
  5379   "RTN","XPD TC",12,0)
  5380    .Q:'$$DAT A^XPDV(FIL E,Z2)
  5381   "RTN","XPD TC",13,0)
  5382    .D FIA^DI FROMSU(FIL E,"",FNAM, FGR,Z2,Z3, Z4,XPDVER) ,DIERR:$D( DIERR)
  5383   "RTN","XPD TC",14,0)
  5384    Q:'$D(^XT MP("XPDT", XPDA,"FIA" ))
  5385   "RTN","XPD TC",15,0)
  5386    ;send DD  and Data
  5387   "RTN","XPD TC",16,0)
  5388    D DDOUT^D IFROMS("", "","",FGR) ,DIERR:$D( DIERR),DAT AOUT^DIFRO MS("",""," ",FGR),DIE RR:$D(DIER R)
  5389   "RTN","XPD TC",17,0)
  5390    Q
  5391   "RTN","XPD TC",18,0)
  5392    ;XPDERR i s checked  in XPDT an d will abo rt transpo rt
  5393   "RTN","XPD TC",19,0)
  5394   DIERR ;rec ord error
  5395   "RTN","XPD TC",20,0)
  5396    D MSG^DIA LOG("EW",. XPD) S XPD ERR=1
  5397   "RTN","XPD TC",21,0)
  5398    Q
  5399   "RTN","XPD TC",22,0)
  5400   KRN ;build  Kernel Fi les
  5401   "RTN","XPD TC",23,0)
  5402    ;XPDFILE= file #, XP DOLDA=ien  in Build f ile
  5403   "RTN","XPD TC",24,0)
  5404    N %,%1,%2 ,DA,EACT,F ACT,FGR,XP DFILE,XPDF L,XPDOLDA, XPDI
  5405   "RTN","XPD TC",25,0)
  5406    F XPDFILE =1:1 S Y0= $P($T(FILE S+XPDFILE^ XPDE),";;" ,2,99) Q:Y 0=""  S XP DI(+Y0)=Y0
  5407   "RTN","XPD TC",26,0)
  5408    ;XPDI(XPD FILE)=file ;order;x-r ef;fact;ea ct;fpre;ep re;fpos;ep os;fdel
  5409   "RTN","XPD TC",27,0)
  5410    S XPDFILE =0
  5411   "RTN","XPD TC",28,0)
  5412    ;check we  are sendi ng somethi ng and hav e the exec utes
  5413   "RTN","XPD TC",29,0)
  5414    F  S XPDF ILE=$O(^XP D(9.6,XPDA ,"KRN",XPD FILE)) Q:' XPDFILE  S  XPDI=$G(X PDI(XPDFIL E)) I $O(^ (XPDFILE," NM",0)),XP DI D  Q:$D (XPDERR)   D:FACT]""  ACT(FACT)
  5415   "RTN","XPD TC",30,0)
  5416    .S FACT=$ P(XPDI,";" ,4),EACT=$ P(XPDI,";" ,5)
  5417   "RTN","XPD TC",31,0)
  5418    .;need to  add code  to check i f File and  data is a lready bei ng sent in  the File
  5419   "RTN","XPD TC",32,0)
  5420    .;mult. I f it is, d on't bothe r sending  it again.   DTL(XPDFI LE)
  5421   "RTN","XPD TC",33,0)
  5422    .S XPDOLD A=0,FGR=$$ FILE^XPDV( XPDFILE) I  FGR="" S  XPDERR=1 Q
  5423   "RTN","XPD TC",34,0)
  5424    .K ^TMP($ J,"XPD")
  5425   "RTN","XPD TC",35,0)
  5426    .F  S XPD OLDA=$O(^X PD(9.6,XPD A,"KRN",XP DFILE,"NM" ,XPDOLDA))  Q:'XPDOLD A  S Y0=$G (^(XPDOLDA ,0)) D
  5427   "RTN","XPD TC",36,0)
  5428    ..;XPDFL=  0-send,1- delete,2-l ink,3-merg e,4-attach ,5-disable
  5429   "RTN","XPD TC",37,0)
  5430    ..S XPDFL =$P(Y0,U,3 )
  5431   "RTN","XPD TC",38,0)
  5432    ..;If del eting at s ite get an  unused DA
  5433   "RTN","XPD TC",39,0)
  5434    ..I XPDFL =1 S DA=$O (@FGR@(" " ),-1)+1 F  DA=DA:1 Q: '$D(^XTMP( "XPDT",XPD A,"KRN",XP DFILE,DA))
  5435   "RTN","XPD TC",40,0)
  5436    ..;$P(Y0, U,2) is fi le # for t his templa te, reset  Y0 before  getting DA
  5437   "RTN","XPD TC",41,0)
  5438    ..E  S:$P (Y0,U,2) $ P(Y0,U)=$P (Y0,"    F ILE #") S  DA=$$ENTRY ^XPDV(Y0)
  5439   "RTN","XPD TC",42,0)
  5440    ..I 'DA S  XPDERR=1  Q
  5441   "RTN","XPD TC",43,0)
  5442    ..;(-1)=a ction ^ ie n in Build  file
  5443   "RTN","XPD TC",44,0)
  5444    ..S ^XTMP ("XPDT",XP DA,"KRN",X PDFILE,DA, -1)=+XPDFL _"^"_XPDOL DA
  5445   "RTN","XPD TC",45,0)
  5446    ..;action  2 - verif y children , 4 - veri fy parent
  5447   "RTN","XPD TC",46,0)
  5448    ..I XPDFL =2!(XPDFL= 4),'$$MENU ^XPDV(XPDF ILE,DA,XPD FL) S XPDE RR=1 Q
  5449   "RTN","XPD TC",47,0)
  5450    ..;if act ion is 1,4  or 5 then  only send  .01 field  and set c hecksum to  ""
  5451   "RTN","XPD TC",48,0)
  5452    ..I XPDFL =1!(XPDFL> 3) S ^XTMP ("XPDT",XP DA,"KRN",X PDFILE,DA, 0)=$P(Y0,U ),$P(^XPD( 9.6,XPDA," KRN",XPDFI LE,"NM",XP DOLDA,0),U ,4)="" Q
  5453   "RTN","XPD TC",49,0)
  5454    ..M ^XTMP ("XPDT",XP DA,"KRN",X PDFILE,DA) =@FGR@(DA)
  5455   "RTN","XPD TC",50,0)
  5456    ..;execut e entry bu ild action
  5457   "RTN","XPD TC",51,0)
  5458    ..D:EACT] "" ACT(EAC T)
  5459   "RTN","XPD TC",52,0)
  5460    .;quit if  no entrie s were sav ed
  5461   "RTN","XPD TC",53,0)
  5462    .Q:'$O(^X TMP("XPDT" ,XPDA,"KRN ",XPDFILE, 0))
  5463   "RTN","XPD TC",54,0)
  5464    .;XPDI=XP DI(XPDFILE ), build x -ref of or der to ins tall
  5465   "RTN","XPD TC",55,0)
  5466    .S %=$P(^ DIC(XPDFIL E,0),U),^X TMP("XPDT" ,XPDA,"ORD ",+$P(XPDI ,";",2),XP DFILE)=XPD I,^(XPDFIL E,0)=%
  5467   "RTN","XPD TC",56,0)
  5468    .Q
  5469   "RTN","XPD TC",57,0)
  5470    Q
  5471   "RTN","XPD TC",58,0)
  5472   QUES ;buil d from Ins tall Quest ions multi ple
  5473   "RTN","XPD TC",59,0)
  5474    N I,J,K,X ,%
  5475   "RTN","XPD TC",60,0)
  5476    S X=""
  5477   "RTN","XPD TC",61,0)
  5478    ;the "B"  x-ref will  give me t he order o f the ques tions
  5479   "RTN","XPD TC",62,0)
  5480    F  S X=$O (^XPD(9.6, XPDA,"QUES ","B",X))  Q:X=""  S  I=$$QUES^X PDV(X) S:' I XPDERR=1  D:I
  5481   "RTN","XPD TC",63,0)
  5482    .S J=0 F   S J=$O(^X PD(9.6,XPD A,"QUES",I ,J)) Q:J=" "  D
  5483   "RTN","XPD TC",64,0)
  5484    ..;tranfo rm J to DI R subscrip ts
  5485   "RTN","XPD TC",65,0)
  5486    ..I $L(J) =1!(J="QQ" ) S ^XTMP( "XPDT",XPD A,"QUES",X ,$TR(J,"1A BQ","0AB?" ))=^(J) Q   ;^(J) ref  to ^XPD(9 .6,XPDA,"Q UES",I,J)
  5487   "RTN","XPD TC",66,0)
  5488    ..;set th e word pro cessing fi elds into  DIR("?",#)  structure
  5489   "RTN","XPD TC",67,0)
  5490    ..F %=1:1  Q:'$D(^XP D(9.6,XPDA ,"QUES",I, J,%,0))  S  ^XTMP("XP DT",XPDA," QUES",X,$T R(J,"AQ10" ,"A?"),%)= ^(0)
  5491   "RTN","XPD TC",68,0)
  5492    ;send the  File ques tions
  5493   "RTN","XPD TC",69,0)
  5494    S K=$G(^X PD(9.6,XPD A,"QDEF"))  ;Develope r Defaults  for Quest ions
  5495   "RTN","XPD TC",70,0)
  5496    F I=1:2 S  X=$P($T(Q UESTION+I) ,";;",2,99 ) Q:X=""   S Y=$P($T( QUESTION+I +1),";;",2 ) D
  5497   "RTN","XPD TC",71,0)
  5498    .S ^XTMP( "XPDT",XPD A,"QUES",$ P(X,";"),0 )=$P(X,";" ,2),^("A") =$P(X,";", 3),^("B")= $S($L($P(K ,U,I)):$P( K,U,I),1:$ P(X,";",4) ),^("??")= $P(X,";",5 ) S:Y]"" ^ ("M")=Y
  5499   "RTN","XPD TC",72,0)
  5500    Q
  5501   "RTN","XPD TC",73,0)
  5502   INT ;build  pre,post,  & envirom ent init r outines
  5503   "RTN","XPD TC",74,0)
  5504    N %,I,R,X ,Z
  5505   "RTN","XPD TC",75,0)
  5506    F I="PRE" ,"INI","IN IT" I $G(^ XPD(9.6,XP DA,I))]""  S X=^(I) D
  5507   "RTN","XPD TC",76,0)
  5508    .;remove  parameters  and seper ate routin e name fro m tag^rout ine
  5509   "RTN","XPD TC",77,0)
  5510    .S ^XTMP( "XPDT",XPD A,I)=X,X=$ P(X,"("),R =$P(X,U,$L (X,U)) Q:$ D(^("RTN", R))
  5511   "RTN","XPD TC",78,0)
  5512    .I '$$RTN ^XPDV(X,.Z ) W !,"Rou tine ",X,Z  S XPDERR= 1 Q
  5513   "RTN","XPD TC",79,0)
  5514    .S %=$$LO AD^XPDTA(R ,"0^")
  5515   "RTN","XPD TC",80,0)
  5516    Q
  5517   "RTN","XPD TC",81,0)
  5518   BLD ;build  Build fil e, Package  file and  Order Para meter file
  5519   "RTN","XPD TC",82,0)
  5520    N %,DIC,X ,XPD,XPDI, XPDV,Y
  5521   "RTN","XPD TC",83,0)
  5522    ;Update t he 'Date D istributed ' field
  5523   "RTN","XPD TC",84,0)
  5524    S XPD(9.6 ,XPDA_",", .02)=$$DT^ XLFDT()
  5525   "RTN","XPD TC",85,0)
  5526    D FILE^DI E("","XPD" ) K XPD
  5527   "RTN","XPD TC",86,0)
  5528    ;save ver sion of ke rnel and f m
  5529   "RTN","XPD TC",87,0)
  5530    S ^XTMP(" XPDT",XPDA ,"VER")=$$ VERSION^XP DUTL("XU") _U_$$VERSI ON^XPDUTL( "VA FILEMA N")
  5531   "RTN","XPD TC",88,0)
  5532    S ^XTMP(" XPDT",XPDA ,"MBREQ")= $P($G(XPDT (XPDT)),U, 4)
  5533   "RTN","XPD TC",89,0)
  5534    M ^XTMP(" XPDT",XPDA ,"BLD",XPD A)=^XPD(9. 6,XPDA)
  5535   "RTN","XPD TC",90,0)
  5536    ;check na tional pac kage file  pointer
  5537   "RTN","XPD TC",91,0)
  5538    S XPDI=$P (^XPD(9.6, XPDA,0),U, 2)
  5539   "RTN","XPD TC",92,0)
  5540    I XPDI=""  W !,"No P ackage Fil e Link" Q
  5541   "RTN","XPD TC",93,0)
  5542    S $P(^XTM P("XPDT",X PDA,"BLD", XPDA,0),U, 2)=$$PT^XP DTA("^DIC( 9.4)",XPDI )
  5543   "RTN","XPD TC",94,0)
  5544    ;quit if  no pointer  to packag e file
  5545   "RTN","XPD TC",95,0)
  5546    I '$D(^DI C(9.4,XPDI )) W !,"Pa ckage File  Link is c orrupted"  S XPDERR=1  Q
  5547   "RTN","XPD TC",96,0)
  5548    ;update v ersion mul tiple in p ackage fil e,XPD=vers ion^date d istributed
  5549   "RTN","XPD TC",97,0)
  5550    S XPD=$$V ER^XPDUTL( XPDNM)_U_$ P(^XTMP("X PDT",XPDA, "BLD",XPDA ,0),U,4)
  5551   "RTN","XPD TC",98,0)
  5552    ;XPD(1)=r oot of des cription f ield
  5553   "RTN","XPD TC",99,0)
  5554    S:$D(^XTM P("XPDT",X PDA,"BLD", XPDA,1)) X PD(1)=$NA( ^(1))
  5555   "RTN","XPD TC",100,0)
  5556    S ^XTMP(" XPDT",XPDA ,"PKG",XPD I,0)=^DIC( 9.4,XPDI,0 ),^XTMP("X PDT",XPDA, "PKG",XPDI ,22,0)="^" _$P(^DD(9. 4,22,0),U, 2)_"^1^1"
  5557   "RTN","XPD TC",101,0)
  5558    ;XPDNM'[" *" is a ve rsion rele ase
  5559   "RTN","XPD TC",102,0)
  5560    I XPDNM'[ "*" D
  5561   "RTN","XPD TC",103,0)
  5562    .S XPDV=$ $PKGVER^XP DIP(XPDI,. XPD)
  5563   "RTN","XPD TC",104,0)
  5564    .;Merge i s used to  set single  nodes and  merge mul tiples
  5565   "RTN","XPD TC",105,0)
  5566    .F %=1,5, 7,"DEV","V ERSION" M  ^XTMP("XPD T",XPDA,"P KG",XPDI,% )=^DIC(9.4 ,XPDI,%)
  5567   "RTN","XPD TC",106,0)
  5568    .;XPDV=ie n of Versi on Multipl e
  5569   "RTN","XPD TC",107,0)
  5570    .I $D(^DI C(9.4,XPDI ,22,XPDV)) '>9 W !!," **Version  multiple i n Package  file wasn' t updated* *",!! S XP DERR=1 Q
  5571   "RTN","XPD TC",108,0)
  5572    .;get jus t the curr ent versio n multiple  and make  it the fir st entry i n version  multiple
  5573   "RTN","XPD TC",109,0)
  5574    .M ^XTMP( "XPDT",XPD A,"PKG",XP DI,22,1)=^ DIC(9.4,XP DI,22,XPDV )
  5575   "RTN","XPD TC",110,0)
  5576    .;check i f SEND PAT CH HISTORY  is NO, ki ll PAH
  5577   "RTN","XPD TC",111,0)
  5578    .I $P(XPD T(XPDT),U, 5) K ^XTMP ("XPDT",XP DA,"PKG",X PDI,22,1," PAH")
  5579   "RTN","XPD TC",112,0)
  5580    ;this is  a patch, % =version n umber, $P( XPD,U)=pat ch number
  5581   "RTN","XPD TC",113,0)
  5582    E  D
  5583   "RTN","XPD TC",114,0)
  5584    .S %=$P(X PD,U),$P(X PD,U)=$P(X PDNM,"*",3 ),XPDV=$$P KGPAT^XPDI P(XPDI,%,. XPD)
  5585   "RTN","XPD TC",115,0)
  5586    .S ^XTMP( "XPDT",XPD A,"PKG",XP DI,22,1,0) =^DIC(9.4, XPDI,22,+X PDV,0)
  5587   "RTN","XPD TC",116,0)
  5588    .I $D(^DI C(9.4,XPDI ,22,+XPDV, "PAH",+$P( XPDV,U,2)) )'>9 W !!, "**Patch m ultiple in  Package f ile wasn't  updated** ",!! S XPD ERR=1 Q
  5589   "RTN","XPD TC",117,0)
  5590    .M ^XTMP( "XPDT",XPD A,"PKG",XP DI,22,1,"P AH",1)=^DI C(9.4,XPDI ,22,+XPDV, "PAH",+$P( XPDV,U,2))
  5591   "RTN","XPD TC",118,0)
  5592    .;if CURR ENT VERSIO N was upda ted in $$P KGPAT, sav e to TG
  5593   "RTN","XPD TC",119,0)
  5594    .I $P(XPD V,U,3) S ^ XTMP("XPDT ",XPDA,"PK G",XPDI,"V ERSION")=$ P(XPDV,U,3 )
  5595   "RTN","XPD TC",120,0)
  5596    ;save the  version i en^patch i en on -1 n ode
  5597   "RTN","XPD TC",121,0)
  5598    S ^XTMP(" XPDT",XPDA ,"PKG",XPD I,-1)="1^1 "
  5599   "RTN","XPD TC",122,0)
  5600    ;resolve  Primary He lp Frame ( 0;4)
  5601   "RTN","XPD TC",123,0)
  5602    S %=+$P(^ DIC(9.4,XP DI,0),U,4)  S:% $P(^X TMP("XPDT" ,XPDA,"PKG ",XPDI,0), U,4)=$$PT^ XPDTA("^DI C(9.2)",%)
  5603   "RTN","XPD TC",124,0)
  5604    Q
  5605   "RTN","XPD TC",125,0)
  5606    ;
  5607   "RTN","XPD TC",126,0)
  5608   ACT(%) ;ex ecute acti on
  5609   "RTN","XPD TC",127,0)
  5610    ;user can  count on  DA,XPDFILE ,XPDFL,XPD NM,XPDOLDA  being aro und
  5611   "RTN","XPD TC",128,0)
  5612    ;DA=ien i n ^XTMP("X PDT",XPDA, "KRN",XPDF ILE,DA)
  5613   "RTN","XPD TC",129,0)
  5614    ;XPDOLDA= ien in ^XP D(9.6,XPDA ,"KRN",XPD IFLE,"NM", XPDOLDA)
  5615   "RTN","XPD TC",130,0)
  5616    N EACT,FA CT,FGR,K0, Y0
  5617   "RTN","XPD TC",131,0)
  5618    S:%'["^"  %="^"_%
  5619   "RTN","XPD TC",132,0)
  5620    D @% Q
  5621   "RTN","XPD TC",133,0)
  5622    ;
  5623   "RTN","XPD TC",134,0)
  5624    ;the foll owing are  the defaul t question s for the  INSTALL QU ESTIONS
  5625   "RTN","XPD TC",135,0)
  5626    ;in file  9.6, the f ormat is:
  5627   "RTN","XPD TC",136,0)
  5628    ;;field . 01;field 1 ;field 2;f ield 4;fie ld 7
  5629   "RTN","XPD TC",137,0)
  5630    ;;field 1 0
  5631   "RTN","XPD TC",138,0)
  5632   QUESTION ; package in stall ques tions
  5633   "RTN","XPD TC",139,0)
  5634    ;;XPF1;Y; Shall I wr ite over y our |FLAG|  File;YES; ^D REP^XPD H
  5635   "RTN","XPD TC",140,0)
  5636    ;;D XPF1^ XPDIQ
  5637   "RTN","XPD TC",141,0)
  5638    ;;XPF2;Y; Want my da ta |FLAG|  yours;YES; ^D DTA^XPD H
  5639   "RTN","XPD TC",142,0)
  5640    ;;D XPF2^ XPDIQ
  5641   "RTN","XPD TC",143,0)
  5642    ;;XPI1;YO ;Want KIDS  to INHIBI T LOGONs d uring the  install;NO ;^D INHIBI T^XPDH
  5643   "RTN","XPD TC",144,0)
  5644    ;;D XPI1^ XPDIQ
  5645   "RTN","XPD TC",145,0)
  5646    ;;XPM1;PO ^VA(200,:E M;Enter th e Coordina tor for Ma il Group ' |FLAG|';;^ D MG^XPDH
  5647   "RTN","XPD TC",146,0)
  5648    ;;D XPM1^ XPDIQ
  5649   "RTN","XPD TC",147,0)
  5650    ;;XPO1;Y; Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install;N O;^D MENU^ XPDH
  5651   "RTN","XPD TC",148,0)
  5652    ;;D XPO1^ XPDIQ
  5653   "RTN","XPD TC",149,0)
  5654    ;;XPZ1;Y; Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls;NO;^D O PT^XPDH
  5655   "RTN","XPD TC",150,0)
  5656    ;;D XPZ1^ XPDIQ
  5657   "RTN","XPD TC",151,0)
  5658    ;;XPZ2;Y; Want to MO VE routine s to other  CPUs;NO;^ D RTN^XPDH
  5659   "RTN","XPD TC",152,0)
  5660    ;;D XPZ2^ XPDIQ
  5661   "RTN","XPD UTL")
  5662   0^13^B2408 6795
  5663   "RTN","XPD UTL",1,0)
  5664   XPDUTL ;SF ISC/RSD -  KIDS utili ties ;10/1 5/2008
  5665   "RTN","XPD UTL",2,0)
  5666    ;;8.0;KER NEL;**21,2 8,39,81,10 0,108,137, 181,275,49 1,511,559, 672**;Jul  10, 1995;B uild 7
  5667   "RTN","XPD UTL",3,0)
  5668    ;Per VHA  Directive  2004-038,  this routi ne should  not be mod ified.
  5669   "RTN","XPD UTL",4,0)
  5670    Q
  5671   "RTN","XPD UTL",5,0)
  5672   VERSION(X)  ;Get curr ent versio n from Pac kage file,  X=package  name or
  5673   "RTN","XPD UTL",6,0)
  5674    ;package  namespace
  5675   "RTN","XPD UTL",7,0)
  5676    N I
  5677   "RTN","XPD UTL",8,0)
  5678    S I=$$LKP KG(X) Q:'I  ""
  5679   "RTN","XPD UTL",9,0)
  5680    Q $P($G(^ DIC(9.4,+I ,"VERSION" )),"^")
  5681   "RTN","XPD UTL",10,0)
  5682    ;
  5683   "RTN","XPD UTL",11,0)
  5684   VER(X) ;re turns vers ion number  from Buil d file, X= build name
  5685   "RTN","XPD UTL",12,0)
  5686    Q:X["*" $ P(X,"*",2)
  5687   "RTN","XPD UTL",13,0)
  5688    Q $P(X,"  ",$L(X," " ))
  5689   "RTN","XPD UTL",14,0)
  5690    ;
  5691   "RTN","XPD UTL",15,0)
  5692   STATUS(IEN ) ;returns  status fr om Install  File, IEN =Install F ile IEN
  5693   "RTN","XPD UTL",16,0)
  5694    I '$D(^XP D(9.7,IEN, 0)) Q -1
  5695   "RTN","XPD UTL",17,0)
  5696    Q $P(^XPD (9.7,IEN,0 ),U,9)
  5697   "RTN","XPD UTL",18,0)
  5698    ;
  5699   "RTN","XPD UTL",19,0)
  5700   PKG(X) ;re turns pack age name f rom Build  file, X=bu ild name
  5701   "RTN","XPD UTL",20,0)
  5702    Q $S(X["* ":$P(X,"*" ),1:$P(X,"  ",1,$L(X, " ")-1))
  5703   "RTN","XPD UTL",21,0)
  5704    ;
  5705   "RTN","XPD UTL",22,0)
  5706   LAST(PKG,V ER,REL) ;r eturns las t patch ap plied for  a Package,  PATCH^DAT E
  5707   "RTN","XPD UTL",23,0)
  5708    ;PKG=pack age name,  VER=versio n number,  REL[option al]=1 if y ou want re leased pat ches only
  5709   "RTN","XPD UTL",24,0)
  5710    ;Patch in cludes Seq  # if Rele ased
  5711   "RTN","XPD UTL",25,0)
  5712    N PKGIEN, VERIEN,LAT EST,PATCH, SUBIEN,Y
  5713   "RTN","XPD UTL",26,0)
  5714    S PKGIEN= $$LKPKG($G (PKG)) Q:' PKGIEN -1
  5715   "RTN","XPD UTL",27,0)
  5716    I $G(VER) ="" S VER= $P($G(^DIC (9.4,PKGIE N,"VERSION ")),"^") Q :'VER -1
  5717   "RTN","XPD UTL",28,0)
  5718    S VERIEN= $O(^DIC(9. 4,PKGIEN,2 2,"B",VER, "")) Q:'VE RIEN -1
  5719   "RTN","XPD UTL",29,0)
  5720    S LATEST= -1,PATCH=- 1,SUBIEN=0
  5721   "RTN","XPD UTL",30,0)
  5722    F  S SUBI EN=$O(^DIC (9.4,PKGIE N,22,VERIE N,"PAH",SU BIEN)) Q:S UBIEN'>0   S Y=$G(^(S UBIEN,0))  D:$P(Y,U,2 )>LATEST
  5723   "RTN","XPD UTL",31,0)
  5724    . I $G(RE L),$P(Y,U) '["SEQ #"  Q  ;releas ed only, m ust contai n SEQ
  5725   "RTN","XPD UTL",32,0)
  5726    . S LATES T=$P(Y,U,2 ),PATCH=$P (Y,U)
  5727   "RTN","XPD UTL",33,0)
  5728    Q PATCH_U _LATEST
  5729   "RTN","XPD UTL",34,0)
  5730    ;
  5731   "RTN","XPD UTL",35,0)
  5732   PATCH(X) ; return 1 i f patch X  was instal led, X=aaa a*nn.nn*nn nn ; p672  change 1.3 N to 1.4N
  5733   "RTN","XPD UTL",36,0)
  5734    Q:X'?1.4U N1"*"1.2N1 "."1.2N.1( 1"V",1"T") .2N1"*"1.4 N 0
  5735   "RTN","XPD UTL",37,0)
  5736    N %,I,J
  5737   "RTN","XPD UTL",38,0)
  5738    S I=$$LKP KG($P(X,"* ")) Q:'I 0
  5739   "RTN","XPD UTL",39,0)
  5740    S J=$O(^D IC(9.4,I,2 2,"B",$P(X ,"*",2),0) ),X=$P(X," *",3) Q:'J  0
  5741   "RTN","XPD UTL",40,0)
  5742    ;check if  patch is  just a num ber
  5743   "RTN","XPD UTL",41,0)
  5744    Q:$O(^DIC (9.4,I,22, J,"PAH","B ",X,0)) 1
  5745   "RTN","XPD UTL",42,0)
  5746    S %=$O(^D IC(9.4,I,2 2,J,"PAH", "B",X_" SE Q"))
  5747   "RTN","XPD UTL",43,0)
  5748    Q $S(%="" :0,1:(X=+% ))
  5749   "RTN","XPD UTL",44,0)
  5750    ;
  5751   "RTN","XPD UTL",45,0)
  5752   INSTALDT(I NSTALL,RES ULT) ;retu rns number  of instal ls, 0 if n ot install ed or does n't exist
  5753   "RTN","XPD UTL",46,0)
  5754    ;input: I NSTALL=req uired, Ins tall name;  RESULT=re quired, pa ssed by re ference
  5755   "RTN","XPD UTL",47,0)
  5756    ;output:  RESULT=num ber in RES ULT array;  RESULT(FM  date/time )=TEST# ^  SEQ#
  5757   "RTN","XPD UTL",48,0)
  5758    N CNT,DAT E,IEN
  5759   "RTN","XPD UTL",49,0)
  5760    K RESULT
  5761   "RTN","XPD UTL",50,0)
  5762    S (IEN,CN T,RESULT)= 0
  5763   "RTN","XPD UTL",51,0)
  5764    I $G(INST ALL)="" Q  0
  5765   "RTN","XPD UTL",52,0)
  5766    F  S IEN= $O(^XPD(9. 7,"B",INST ALL,IEN))  Q:'IEN  D
  5767   "RTN","XPD UTL",53,0)
  5768    .S DATE=$ P($G(^XPD( 9.7,IEN,1) ),U,3) Q:' DATE
  5769   "RTN","XPD UTL",54,0)
  5770    .S RESULT (DATE)=$G( ^XPD(9.7,I EN,6)),CNT =CNT+1
  5771   "RTN","XPD UTL",55,0)
  5772    S RESULT= CNT
  5773   "RTN","XPD UTL",56,0)
  5774    Q CNT
  5775   "RTN","XPD UTL",57,0)
  5776    ;
  5777   "RTN","XPD UTL",58,0)
  5778   NEWCP(XPD, XPDC,XPDP)  ;create n ew check p oint, retu rns 0=erro r or ien
  5779   "RTN","XPD UTL",59,0)
  5780    ;XPD=name , XPDC=cal l back, XP DP=paramet ers
  5781   "RTN","XPD UTL",60,0)
  5782    Q:$G(XPD) ="" 0
  5783   "RTN","XPD UTL",61,0)
  5784    N %,XPDI, XPDJ,XPDF, XPDY
  5785   "RTN","XPD UTL",62,0)
  5786    ;XPDCP="I NI"=Pre-in it, "INIT" =Post-init
  5787   "RTN","XPD UTL",63,0)
  5788    S XPDI=$S (XPDCP="IN IT":9.716, 1:9.713)
  5789   "RTN","XPD UTL",64,0)
  5790    S %=$$FIN D1^DIC(XPD I,","_XPDA _",","X",X PD) Q:% %
  5791   "RTN","XPD UTL",65,0)
  5792    S XPDF="+ 1,"_XPDA_" ,",XPDJ(XP DI,XPDF,.0 1)=XPD
  5793   "RTN","XPD UTL",66,0)
  5794    S:$D(XPDC ) XPDJ(XPD I,XPDF,2)= XPDC
  5795   "RTN","XPD UTL",67,0)
  5796    S:$D(XPDP ) XPDJ(XPD I,XPDF,3)= XPDP
  5797   "RTN","XPD UTL",68,0)
  5798    D UPDATE^ DIE("","XP DJ","XPDY" )
  5799   "RTN","XPD UTL",69,0)
  5800    Q $G(XPDY (1))
  5801   "RTN","XPD UTL",70,0)
  5802    ;
  5803   "RTN","XPD UTL",71,0)
  5804   UPCP(XPD,X PDP) ;upda te check p oint, retu rns 0=erro r or ien
  5805   "RTN","XPD UTL",72,0)
  5806    ;XPD=name , XPDP=par ameters
  5807   "RTN","XPD UTL",73,0)
  5808    N XPDI,XP DJ,XPDF,XP DY
  5809   "RTN","XPD UTL",74,0)
  5810    ;XPDCP="I NI"=Pre-in it, "INIT" =Post-init
  5811   "RTN","XPD UTL",75,0)
  5812    S XPDI=$S (XPDCP="IN IT":9.716, 1:9.713),X PDY=$$DICC P($G(XPD))
  5813   "RTN","XPD UTL",76,0)
  5814    Q:'XPDY 0
  5815   "RTN","XPD UTL",77,0)
  5816    S XPDF=XP DY_","_XPD A_","
  5817   "RTN","XPD UTL",78,0)
  5818    S:$D(XPDP ) XPDJ(XPD I,XPDF,3)= XPDP
  5819   "RTN","XPD UTL",79,0)
  5820    D FILE^DI E("","XPDJ ")
  5821   "RTN","XPD UTL",80,0)
  5822    Q XPDY
  5823   "RTN","XPD UTL",81,0)
  5824    ;
  5825   "RTN","XPD UTL",82,0)
  5826   COMCP(XPD)  ;complete  check poi nt, return s 0=error  or date/ti me
  5827   "RTN","XPD UTL",83,0)
  5828    ;XPD=name
  5829   "RTN","XPD UTL",84,0)
  5830    N XPDD,XP DI,XPDJ,XP DY
  5831   "RTN","XPD UTL",85,0)
  5832    S XPDI=$S (XPDCP="IN IT":9.716, 1:9.713),X PDY=$$DICC P($G(XPD))
  5833   "RTN","XPD UTL",86,0)
  5834    Q:'XPDY 0
  5835   "RTN","XPD UTL",87,0)
  5836    S XPDD=$$ NOW^XLFDT, XPDJ(XPDI, XPDY_","_X PDA_",",1) =XPDD
  5837   "RTN","XPD UTL",88,0)
  5838    D FILE^DI E("","XPDJ ")
  5839   "RTN","XPD UTL",89,0)
  5840    Q XPDD
  5841   "RTN","XPD UTL",90,0)
  5842    ;
  5843   "RTN","XPD UTL",91,0)
  5844   VERCP(XPD)  ;verify c heck point , returns  1=complete d, 0=not
  5845   "RTN","XPD UTL",92,0)
  5846    ;-1=doesn 't exist
  5847   "RTN","XPD UTL",93,0)
  5848    ;XPD=name
  5849   "RTN","XPD UTL",94,0)
  5850    N XPDI,XP DY
  5851   "RTN","XPD UTL",95,0)
  5852    S XPDI=$S (XPDCP="IN IT":9.716, 1:9.713),X PDY=$$DICC P($G(XPD))
  5853   "RTN","XPD UTL",96,0)
  5854    Q:'XPDY - 1
  5855   "RTN","XPD UTL",97,0)
  5856    Q ''$$GET 1^DIQ(XPDI ,XPDY_","_ XPDA_",",1 ,"I")
  5857   "RTN","XPD UTL",98,0)
  5858    ;
  5859   "RTN","XPD UTL",99,0)
  5860   PARCP(XPD, XPDF) ;ret urns param eters of c heck point
  5861   "RTN","XPD UTL",100,0 )
  5862    ;XPD=name , XPDF="PR E"
  5863   "RTN","XPD UTL",101,0 )
  5864    N XPDI,XP DY
  5865   "RTN","XPD UTL",102,0 )
  5866    I $G(XPDF )="PRE" N  XPDCP S XP DCP="INI"
  5867   "RTN","XPD UTL",103,0 )
  5868    S XPDI=$S (XPDCP="IN IT":9.716, 1:9.713),X PDY=$$DICC P($G(XPD))
  5869   "RTN","XPD UTL",104,0 )
  5870    Q:'XPDY 0
  5871   "RTN","XPD UTL",105,0 )
  5872    Q $$GET1^ DIQ(XPDI,X PDY_","_XP DA_",",3," I")
  5873   "RTN","XPD UTL",106,0 )
  5874    ;
  5875   "RTN","XPD UTL",107,0 )
  5876   CURCP(XPDF ) ;returns  current c heck point
  5877   "RTN","XPD UTL",108,0 )
  5878    ;XPDF fla g - 0=exte rnel, 1=in ternal
  5879   "RTN","XPD UTL",109,0 )
  5880    Q $S($G(X PDF):XPDCH ECK,1:XPDC HECK(0))
  5881   "RTN","XPD UTL",110,0 )
  5882    ;
  5883   "RTN","XPD UTL",111,0 )
  5884   WP(X) ;X=g lobal ref
  5885   "RTN","XPD UTL",112,0 )
  5886    N %
  5887   "RTN","XPD UTL",113,0 )
  5888    Q:'$D(@X)
  5889   "RTN","XPD UTL",114,0 )
  5890    F %=1:1 Q :'$D(@X@(% ))  W !,@X @(%)
  5891   "RTN","XPD UTL",115,0 )
  5892    Q:'$G(XPD A)  D WP^D IE(9.7,XPD A_",",20," A",X)
  5893   "RTN","XPD UTL",116,0 )
  5894    Q
  5895   "RTN","XPD UTL",117,0 )
  5896   MES(X) ;re cord messa ge, X=mess age or an  array pass ed by refe rence
  5897   "RTN","XPD UTL",118,0 )
  5898    N %
  5899   "RTN","XPD UTL",119,0 )
  5900    I $D(X)#2  S %=X K X  S X(1)=%
  5901   "RTN","XPD UTL",120,0 )
  5902    ;write me ssage
  5903   "RTN","XPD UTL",121,0 )
  5904    F %=1:1 Q :'$D(X(%))   W !,X(%)
  5905   "RTN","XPD UTL",122,0 )
  5906    Q:'$G(XPD A)  D WP^D IE(9.7,XPD A_",",20," A","X")
  5907   "RTN","XPD UTL",123,0 )
  5908    Q
  5909   "RTN","XPD UTL",124,0 )
  5910   BMES(X) ;a dd blank l ine before  message
  5911   "RTN","XPD UTL",125,0 )
  5912    N %
  5913   "RTN","XPD UTL",126,0 )
  5914    I $D(X)#2  S %=X K X  S X(1)="  ",X(2)=%
  5915   "RTN","XPD UTL",127,0 )
  5916    D MES(.X)
  5917   "RTN","XPD UTL",128,0 )
  5918    Q
  5919   "RTN","XPD UTL",129,0 )
  5920   RTNUP(X,Y)  ;update r outine act ion, X=rou tine, Y=ac tion
  5921   "RTN","XPD UTL",130,0 )
  5922    ;actions:   1=delete , 2=skip
  5923   "RTN","XPD UTL",131,0 )
  5924    N %
  5925   "RTN","XPD UTL",132,0 )
  5926    ;set acti on to Y
  5927   "RTN","XPD UTL",133,0 )
  5928    Q:'$G(Y)! '$D(^XTMP( "XPDI",$G( XPDA),"RTN ",X)) 0 S  $P(^(X),U) =+Y
  5929   "RTN","XPD UTL",134,0 )
  5930    Q 1
  5931   "RTN","XPD UTL",135,0 )
  5932    ;get Buil d ien
  5933   "RTN","XPD UTL",136,0 )
  5934    S Y=$O(^X TMP("XPDI" ,XPDA,"BLD ",0))
  5935   "RTN","XPD UTL",137,0 )
  5936    ;remove c hecksum wh en updatin g action,  since acti on can onl y be
  5937   "RTN","XPD UTL",138,0 )
  5938    ;delete o r skip, no t sure if  we want to  do this
  5939   "RTN","XPD UTL",139,0 )
  5940    S:$P(%,U, 2) $P(^XTM P("XPDI",X PDA,"BLD", Y,"KRN",9. 8,"NM",$P( %,U,2),0), U,4)=""
  5941   "RTN","XPD UTL",140,0 )
  5942    Q 1
  5943   "RTN","XPD UTL",141,0 )
  5944    ;
  5945   "RTN","XPD UTL",142,0 )
  5946   RTNLOG(X)  ;Enter/Upd ate routin e in the R outine Fil e
  5947   "RTN","XPD UTL",143,0 )
  5948    N Y,FDA,I EN
  5949   "RTN","XPD UTL",144,0 )
  5950    S Y=$O(^D IC(9.8,"B" ,X,0))
  5951   "RTN","XPD UTL",145,0 )
  5952    I Y'>0 S  IEN="?+1," ,FDA(9.8,I EN,1)="R"
  5953   "RTN","XPD UTL",146,0 )
  5954    I Y>0 S I EN=(+Y)_", "
  5955   "RTN","XPD UTL",147,0 )
  5956    S FDA(9.8 ,IEN,.01)= X,FDA(9.8, IEN,7.4)=$ $NOW^XLFDT
  5957   "RTN","XPD UTL",148,0 )
  5958    D UPDATE^ DIE("","FD A","IEN")
  5959   "RTN","XPD UTL",149,0 )
  5960    Q
  5961   "RTN","XPD UTL",150,0 )
  5962    ;
  5963   "RTN","XPD UTL",151,0 )
  5964   DICCP(X) ; lookup che ck point,  returns ie n or 0
  5965   "RTN","XPD UTL",152,0 )
  5966    Q:$G(X)=" " 0
  5967   "RTN","XPD UTL",153,0 )
  5968    ;if they  pass ien,  fail if ca n't find
  5969   "RTN","XPD UTL",154,0 )
  5970    I X=+X S  Y=X Q:'$D( ^XPD(9.7,X PDA,XPDCP, Y,0)) 0
  5971   "RTN","XPD UTL",155,0 )
  5972    E  S Y=$$ FIND1^DIC( XPDI,","_X PDA_",","X ",X)
  5973   "RTN","XPD UTL",156,0 )
  5974    Q Y
  5975   "RTN","XPD UTL",157,0 )
  5976    ;
  5977   "RTN","XPD UTL",158,0 )
  5978   PRODE(XPDN ,XPD) ;ena ble/disabl e protocol s, return  1 for succ ess
  5979   "RTN","XPD UTL",159,0 )
  5980    ;XPDN=pro tocol name , XPD=1-en able, 0-di sable
  5981   "RTN","XPD UTL",160,0 )
  5982    Q:$G(XPDN )="" 0
  5983   "RTN","XPD UTL",161,0 )
  5984    S XPD=+$G (XPD)
  5985   "RTN","XPD UTL",162,0 )
  5986    D KIDS^XQ OO1($P(XPD SET,U,2),1 01,XPDN,.X PD)
  5987   "RTN","XPD UTL",163,0 )
  5988    Q $S(XPD< 0:0,1:1)
  5989   "RTN","XPD UTL",164,0 )
  5990    ;
  5991   "RTN","XPD UTL",165,0 )
  5992   OPTDE(XPDN ,XPD) ;ena ble/disabl e options,  return 1  for succes s
  5993   "RTN","XPD UTL",166,0 )
  5994    ;XPDN=pro tocol name , XPD=1-en able, 0-di sable
  5995   "RTN","XPD UTL",167,0 )
  5996    Q:$G(XPDN )="" 0
  5997   "RTN","XPD UTL",168,0 )
  5998    S XPD=+$G (XPD)
  5999   "RTN","XPD UTL",169,0 )
  6000    D KIDS^XQ OO1($P(XPD SET,U,2),1 9,XPDN,.XP D)
  6001   "RTN","XPD UTL",170,0 )
  6002    Q $S(XPD< 0:0,1:1)
  6003   "RTN","XPD UTL",171,0 )
  6004    ;
  6005   "RTN","XPD UTL",172,0 )
  6006   BUILD(XPDN ,XPD) ;che ck if a bu ild exists , return 1  for succe ss
  6007   "RTN","XPD UTL",173,0 )
  6008    ;XPDN=bui ld name, X PD=1-exist , 0-been r emoved
  6009   "RTN","XPD UTL",174,0 )
  6010    S XPD=$D( XPDT("NM", XPDN))
  6011   "RTN","XPD UTL",175,0 )
  6012    Q XPD
  6013   "RTN","XPD UTL",176,0 )
  6014    ;
  6015   "RTN","XPD UTL",177,0 )
  6016   MAILGRP(X)  ;Return m ail group  for packag e, X=packa ge name or  namespace
  6017   "RTN","XPD UTL",178,0 )
  6018    N XD,DIC, DR,DA,DIQ
  6019   "RTN","XPD UTL",179,0 )
  6020    S DA=$$LK PKG(X) Q:' DA ""
  6021   "RTN","XPD UTL",180,0 )
  6022    S DIC="^D IC(9.4,",D R=1938,DIQ ="XD" D EN ^DIQ1
  6023   "RTN","XPD UTL",181,0 )
  6024    Q $S($G(X D(9.4,DA,1 938))="":" ",1:"G."_X D(9.4,DA,1 938))
  6025   "RTN","XPD UTL",182,0 )
  6026    ;
  6027   "RTN","XPD UTL",183,0 )
  6028   LKPKG(X) ; Return Pac kage ien,   X=package  name or n amespace
  6029   "RTN","XPD UTL",184,0 )
  6030    Q:$G(X)=" " 0
  6031   "RTN","XPD UTL",185,0 )
  6032    N DA
  6033   "RTN","XPD UTL",186,0 )
  6034    I $L(X)<5  D  Q:DA + DA
  6035   "RTN","XPD UTL",187,0 )
  6036    .S DA=$O( ^DIC(9.4," C",X,0))
  6037   "RTN","XPD UTL",188,0 )
  6038    .S:'DA DA =$O(^DIC(9 .4,"C2",X, 0))
  6039   "RTN","XPD UTL",189,0 )
  6040    I $L(X)>3  S DA=$O(^ DIC(9.4,"B ",X,0))
  6041   "RTN","XPD UTL",190,0 )
  6042    Q +DA
  6043   "RTN","XU8 P672")
  6044   0^^B214919 9
  6045   "RTN","XU8 P672",1,0)
  6046   XU8P672 ;S FIRMFO/MAF  -POST-ins tall;04/22 /2015  14: 20
  6047   "RTN","XU8 P672",2,0)
  6048    ;;8.0;KER NEL;**672* *;APR 22,  2015;Build  7
  6049   "RTN","XU8 P672",3,0)
  6050    D BMES^XP DUTL("                      ***  Running po st-init fo r patch XU *8.0*672 * **")
  6051   "RTN","XU8 P672",4,0)
  6052    N XUPKGID ,XUPKGFL,D A,X,XUFLG
  6053   "RTN","XU8 P672",5,0)
  6054    S XUPKGID =$O(^DIC(9 .4,"B","KE RNEL",0))  I $D(^DIC( 9.4,+XUPKG ID,0)) D
  6055   "RTN","XU8 P672",6,0)
  6056    .D BMES^X PDUTL("Che cking syst em for pac kage file  entry for  KERNEL tha t is assoc iated")
  6057   "RTN","XU8 P672",7,0)
  6058    .D MES^XP DUTL("with  patient m erge - del ete entry" )
  6059   "RTN","XU8 P672",8,0)
  6060    .S X=0,XU FLG=0
  6061   "RTN","XU8 P672",9,0)
  6062    .F X=0:0  S X=$O(^DI C(9.4,XUPK GID,20,X))  Q:X'>0  I  $D(^DIC(9 .4,XUPKGID ,20,X,0)), $P($G(^DIC (9.4,XUPKG ID,20,X,0) ),"^",1)=2  S XUPKGFL =X D
  6063   "RTN","XU8 P672",10,0 )
  6064    . .S DA(1 )=XUPKGID, DA=XUPKGFL  S DIK="^D IC(9.4,"_D A(1)_",20, "
  6065   "RTN","XU8 P672",11,0 )
  6066    . .D ^DIK  D BMES^XP DUTL("***  Entry foun d and dele ted!") S X UFLG=1
  6067   "RTN","XU8 P672",12,0 )
  6068    . .K DIK, DA
  6069   "RTN","XU8 P672",13,0 )
  6070    . . Q
  6071   "RTN","XU8 P672",14,0 )
  6072    .Q
  6073   "RTN","XU8 P672",15,0 )
  6074    I 'XUFLG  D BMES^XPD UTL("*** N o entry fo und!")
  6075   "RTN","XU8 P672",16,0 )
  6076    D BMES^XP DUTL(" ")
  6077   "RTN","XU8 P672",17,0 )
  6078    Q
  6079   "VER")
  6080   8.0^22.2
  6081   "^DD",9.4, 9.4,.01,0)
  6082   NAME^RFJ50 ^^0;1^K:$L (X)>50!($L (X)<4)!'(X '?1P.E) X
  6083   "^DD",9.4, 9.4,.01,1, 0)
  6084   ^.1
  6085   "^DD",9.4, 9.4,.01,1, 1,0)
  6086   9.4^B
  6087   "^DD",9.4, 9.4,.01,1, 1,1)
  6088   S ^DIC(9.4 ,"B",X,DA) =""
  6089   "^DD",9.4, 9.4,.01,1, 1,2)
  6090   K ^DIC(9.4 ,"B",X,DA)
  6091   "^DD",9.4, 9.4,.01,3)
  6092   Answer mus t be 4-50  characters  in length .
  6093   "^DD",9.4, 9.4,.01,21 ,0)
  6094   ^^1^1^2940 627^^^^
  6095   "^DD",9.4, 9.4,.01,21 ,1,0)
  6096   The name o f this Pac kage.
  6097   "^DD",9.4, 9.4,.01,"D T")
  6098   3161219
  6099   "^DD",9.6, 9.6,0)
  6100   FIELD^NL^1 ^34
  6101   "^DD",9.6, 9.6,0,"DT" )
  6102   3180307
  6103   "^DD",9.6, 9.6,0,"ID" ,"W1")
  6104   D:$P(^(0), U,2) EN^DD IOL("   "_ $$EXTERNAL ^DILFD(9.6 ,1,"",$P(^ (0),U,2)), "","?0")
  6105   "^DD",9.6, 9.6,0,"IX" ,"B",9.6,. 01)
  6106  
  6107   "^DD",9.6, 9.6,0,"IX" ,"C",9.6,1 )
  6108  
  6109   "^DD",9.6, 9.6,0,"NM" ,"BUILD")
  6110  
  6111   "^DD",9.6, 9.6,0,"PTC ",.4,21400 )
  6112  
  6113   "^DD",9.6, 9.6,0,"PTC ",.401,214 00)
  6114  
  6115   "^DD",9.6, 9.6,0,"PTC ",.402,214 00)
  6116  
  6117   "^DD",9.6, 9.6,0,"PTC ",.403,214 00)
  6118  
  6119   "^DD",9.6, 9.6,0,"PTC ",1,21400)
  6120  
  6121   "^DD",9.6, 9.6,0,"VRP K")
  6122   XU
  6123   "^DD",9.6, 9.6,.01,0)
  6124   NAME^FX^^0 ;1^D INPUT B^XPDET(.X )
  6125   "^DD",9.6, 9.6,.01,1, 0)
  6126   ^.1^^-1
  6127   "^DD",9.6, 9.6,.01,1, 1,0)
  6128   9.6^B
  6129   "^DD",9.6, 9.6,.01,1, 1,1)
  6130   S ^XPD(9.6 ,"B",$E(X, 1,50),DA)= ""
  6131   "^DD",9.6, 9.6,.01,1, 1,2)
  6132   K ^XPD(9.6 ,"B",$E(X, 1,50),DA)
  6133   "^DD",9.6, 9.6,.01,3)
  6134   Enter Pack age or Pat ch Name an d version  in the for mat 'PACKA GE nn.n[V| T]n' or 'P ATCH*nn.n* nn'.
  6135   "^DD",9.6, 9.6,.01,21 ,0)
  6136   ^^2^2^2950 105^^^^
  6137   "^DD",9.6, 9.6,.01,21 ,1,0)
  6138   The name a nd version  number of  this Pack age or Pat ch.
  6139   "^DD",9.6, 9.6,.01,21 ,2,0)
  6140    i.e. KERN EL 8.0T1   or XU*8.0* 1
  6141   "^DD",9.6, 9.6,.01,"D T")
  6142   2950105
  6143   "^DD",9.6, 9.6,.02,0)
  6144   DATE DISTR IBUTED^D^^ 0;4^S %DT= "EX" D ^%D T S X=Y K: Y<1 X
  6145   "^DD",9.6, 9.6,.02,21 ,0)
  6146   ^^1^1^2940 608^
  6147   "^DD",9.6, 9.6,.02,21 ,1,0)
  6148   The date t his Build  is distrib uted to th e sites.
  6149   "^DD",9.6, 9.6,.02,"D T")
  6150   2940608
  6151   "^DD",9.6, 9.6,1,0)
  6152   PACKAGE FI LE LINK^*P 9.4'^DIC(9 .4,^0;2^S  DIC("S")=" I $$PCK^XP DET(Y)" D  ^DIC K DIC  S DIC=DIE ,X=+Y K:Y< 0 X
  6153   "^DD",9.6, 9.6,1,1,0)
  6154   ^.1
  6155   "^DD",9.6, 9.6,1,1,1, 0)
  6156   9.6^C
  6157   "^DD",9.6, 9.6,1,1,1, 1)
  6158   S ^XPD(9.6 ,"C",$E(X, 1,30),DA)= ""
  6159   "^DD",9.6, 9.6,1,1,1, 2)
  6160   K ^XPD(9.6 ,"C",$E(X, 1,30),DA)
  6161   "^DD",9.6, 9.6,1,1,1, "DT")
  6162   2930820
  6163   "^DD",9.6, 9.6,1,3)
  6164  
  6165   "^DD",9.6, 9.6,1,12)
  6166   Must be th e same Pac kage Name  or Namespa ce
  6167   "^DD",9.6, 9.6,1,12.1 )
  6168   S DIC("S") ="I $$PCK^ XPDET(Y)"
  6169   "^DD",9.6, 9.6,1,21,0 )
  6170   ^^4^4^2950 113^^^^
  6171   "^DD",9.6, 9.6,1,21,1 ,0)
  6172   Enter this  field onl y if you w ant to upd ate the Pa ckage file  when this
  6173   "^DD",9.6, 9.6,1,21,2 ,0)
  6174   package is  installed  at the re cipient's  site.  You  can only  reference
  6175   "^DD",9.6, 9.6,1,21,3 ,0)
  6176   a Package  with the s ame Name a s your Bui ld. If thi s is a pat ch, you ca n
  6177   "^DD",9.6, 9.6,1,21,4 ,0)
  6178   only refer ence a Pac kage with  the same N amespace a s your Bui ld.
  6179   "^DD",9.6, 9.6,1,"DT" )
  6180   2940425
  6181   "^DD",9.6, 9.6,2,0)
  6182   TYPE^S^0:S INGLE PACK AGE;1:MULT I-PACKAGE; 2:GLOBAL P ACKAGE;^0; 3^Q
  6183   "^DD",9.6, 9.6,2,3)
  6184  
  6185   "^DD",9.6, 9.6,2,21,0 )
  6186   ^.001^5^5^ 3080528^^^ ^
  6187   "^DD",9.6, 9.6,2,21,1 ,0)
  6188   This field  controls  what can b e sent as  part of th is Build.
  6189   "^DD",9.6, 9.6,2,21,2 ,0)
  6190    SINGLE PA CKAGE can  contain al l Routines  and all B uild Compo nents.
  6191   "^DD",9.6, 9.6,2,21,3 ,0)
  6192    MULTI-PAC KAGE conta ins only a  list of o ther Build s.
  6193   "^DD",9.6, 9.6,2,21,4 ,0)
  6194    GLOBAL PA CKAGE can  contain En vironment  Check and  Post-Insta ll
  6195   "^DD",9.6, 9.6,2,21,5 ,0)
  6196    Routines  and a list  of Global s.
  6197   "^DD",9.6, 9.6,2,"DT" )
  6198   2950105
  6199   "^DD",9.6, 9.6,3,0)
  6200   DESCRIPTIO N OF ENHAN CEMENTS^9. 61A^^1;0
  6201   "^DD",9.6, 9.6,3,21,0 )
  6202   ^.001^2^2^ 3150304^^^ ^
  6203   "^DD",9.6, 9.6,3,21,1 ,0)
  6204   A complete  and detai led descri ption of t he Package 's or Patc h's
  6205   "^DD",9.6, 9.6,3,21,2 ,0)
  6206   enhancemen ts and cap abilities.
  6207   "^DD",9.6, 9.6,3,"DT" )
  6208   2940607
  6209   "^DD",9.6, 9.6,4,0)
  6210   VERSION^CJ 8^^ ; ^S X =$$VER^XPD UTL($P($G( ^XPD(9.6,D 0,0)),U))
  6211   "^DD",9.6, 9.6,4,9)
  6212   ^
  6213   "^DD",9.6, 9.6,4,9.01 )
  6214  
  6215   "^DD",9.6, 9.6,4,9.1)
  6216   S X=$$VER^ XPDUTL($P( $G(^XPD(9. 6,D0,0)),U ))
  6217   "^DD",9.6, 9.6,4,21,0 )
  6218   ^^1^1^2940 914^^
  6219   "^DD",9.6, 9.6,4,21,1 ,0)
  6220   This field  returns t he version  number fo r this pac kage.
  6221   "^DD",9.6, 9.6,5,0)
  6222   TRACK PACK AGE NATION ALLY^S^y:Y ES;n:NO;^0 ;5^Q
  6223   "^DD",9.6, 9.6,5,21,0 )
  6224   ^^4^4^2941 108^^^
  6225   "^DD",9.6, 9.6,5,21,1 ,0)
  6226   YES means  you want t o send a m essage to  the Nation al Package  File on
  6227   "^DD",9.6, 9.6,5,21,2 ,0)
  6228   FORUM to t rack this  package wh en it is i nstalled a t an insta lling site .
  6229   "^DD",9.6, 9.6,5,21,3 ,0)
  6230    
  6231   "^DD",9.6, 9.6,5,21,4 ,0)
  6232   NO means y ou don't w ant to gen erate a me ssage.
  6233   "^DD",9.6, 9.6,5,"DT" )
  6234   2940422
  6235   "^DD",9.6, 9.6,6,0)
  6236   FILE^9.64P A^^4;0
  6237   "^DD",9.6, 9.6,6,21,0 )
  6238   ^^3^3^2940 502^^^^
  6239   "^DD",9.6, 9.6,6,21,1 ,0)
  6240   Any FileMa n files wh ich are pa rt of this  Package a re documen ted
  6241   "^DD",9.6, 9.6,6,21,2 ,0)
  6242   here.  Thi s multiple  controls  what files  (Data Dic tionaries  and
  6243   "^DD",9.6, 9.6,6,21,3 ,0)
  6244   Data) are  distribute d from thi s Package  entry.
  6245   "^DD",9.6, 9.6,7,0)
  6246   BUILD COMP ONENTS^9.6 7PA^^KRN;0
  6247   "^DD",9.6, 9.6,7,21,0 )
  6248   ^^1^1^2940 503^^
  6249   "^DD",9.6, 9.6,7,21,1 ,0)
  6250   The list o f the comp onents tha t make up  a package.
  6251   "^DD",9.6, 9.6,7,"DT" )
  6252   2940519
  6253   "^DD",9.6, 9.6,10,0)
  6254   MULTIPLE B UILD^9.63^ ^10;0
  6255   "^DD",9.6, 9.6,10,21, 0)
  6256   ^^4^4^2990 217^^^^
  6257   "^DD",9.6, 9.6,10,21, 1,0)
  6258   This multi ple contai ns other B uilds that  will be s ent with t his packag e
  6259   "^DD",9.6, 9.6,10,21, 2,0)
  6260   for a mult i-package  distributi on. It can  also cont ain a list  of patche s
  6261   "^DD",9.6, 9.6,10,21, 3,0)
  6262   that was r olled up i nto this B uild.  The  Type fiel d is used  to disting uish
  6263   "^DD",9.6, 9.6,10,21, 4,0)
  6264   the differ ence in it s use.
  6265   "^DD",9.6, 9.6,10,"DT ")
  6266   2960904
  6267   "^DD",9.6, 9.6,11,0)
  6268   REQUIRED B UILD^9.611 ^^REQB;0
  6269   "^DD",9.6, 9.6,20,0)
  6270   ALPHA/BETA  TESTING^S ^y:YES;n:N O;^ABPKG;1 ^Q
  6271   "^DD",9.6, 9.6,20,21, 0)
  6272   ^^5^5^2940 502^^^^
  6273   "^DD",9.6, 9.6,20,21, 1,0)
  6274   YES means  this packa ge is curr ently in a lpha or be ta test an d that you  want
  6275   "^DD",9.6, 9.6,20,21, 2,0)
  6276   to track o ption usag e and erro rs relatin g to this  package at  the sites .
  6277   "^DD",9.6, 9.6,20,21, 3,0)
  6278    
  6279   "^DD",9.6, 9.6,20,21, 4,0)
  6280   NO means t hat you wa nt to disc ontinue tr acking of  alpha or b eta testin g
  6281   "^DD",9.6, 9.6,20,21, 5,0)
  6282   at sites.
  6283   "^DD",9.6, 9.6,20,"DT ")
  6284   2940307
  6285   "^DD",9.6, 9.6,21,0)
  6286   INSTALLATI ON MESSAGE ^S^y:YES;n :NO;^ABPKG ;2^Q
  6287   "^DD",9.6, 9.6,21,21, 0)
  6288   ^^3^3^2940 307^^
  6289   "^DD",9.6, 9.6,21,21, 1,0)
  6290   YES means  you want a  Installat ion Messag e sent whe n this pac kage is
  6291   "^DD",9.6, 9.6,21,21, 2,0)
  6292   installed  at a site.   The mess age will b e sent to  the mailgr oup in the  
  6293   "^DD",9.6, 9.6,21,21, 3,0)
  6294   'ADDRESS F OR USAGE R EPORTING'  field.
  6295   "^DD",9.6, 9.6,21,"DT ")
  6296   2940307
  6297   "^DD",9.6, 9.6,22,0)
  6298   ADDRESS FO R USAGE RE PORTING^FX ^^ABPKG;3^ K:$L(X)>60 !($L(X)<5) !(X'?1"G." 1U.E1"@"1U .E) X I $D (X) N DIC, XPD S DIC= 4.2,DIC(0) ="QEM",XPD =X,X=$P(X, "@",2) D ^ DIC S:Y>0  X=$P(XPD," @")_"@"_$P (Y,U,2) K: Y<0 X
  6299   "^DD",9.6, 9.6,22,3)
  6300   Answer sho uld be a g roup addre ssee netwo rk mail fo rmat (e.g. , G.PKG-TE ST@ISC-ANY WHERE)
  6301   "^DD",9.6, 9.6,22,21, 0)
  6302   ^^4^4^2940 307^
  6303   "^DD",9.6, 9.6,22,21, 1,0)
  6304   This field  contains  a mail gro up at a do main to wh ich
  6305   "^DD",9.6, 9.6,22,21, 2,0)
  6306   installati on, option  usage, an d error me ssages are  sent.
  6307   "^DD",9.6, 9.6,22,21, 3,0)
  6308   This is us ually a ma il group c ontaining  one or mor e of
  6309   "^DD",9.6, 9.6,22,21, 4,0)
  6310   the develo pers of th e package  at the dev eloping IS C.
  6311   "^DD",9.6, 9.6,22,"DT ")
  6312   2940308
  6313   "^DD",9.6, 9.6,23,0)
  6314   PACKAGE NA MESPACE OR  PREFIX^9. 66A^^ABNS; 0
  6315   "^DD",9.6, 9.6,23,21, 0)
  6316   ^.001^3^3^ 3080604^^
  6317   "^DD",9.6, 9.6,23,21, 1,0)
  6318   This multi ple field  is used to  identify  the namesp ace or
  6319   "^DD",9.6, 9.6,23,21, 2,0)
  6320   prefixes u sed to ide ntify the  options an d routines
  6321   "^DD",9.6, 9.6,23,21, 3,0)
  6322   associated  with the  alpha or b eta test p ackage.
  6323   "^DD",9.6, 9.6,30,0)
  6324   GLOBAL^9.6 5^^GLO;0
  6325   "^DD",9.6, 9.6,30,21, 0)
  6326   ^^1^1^2950 105^^
  6327   "^DD",9.6, 9.6,30,21, 1,0)
  6328   This multi ple contai ns the glo bals to tr ansport wi th KIDS.
  6329   "^DD",9.6, 9.6,50,0)
  6330   INSTALL QU ESTIONS^9. 62^^QUES;0
  6331   "^DD",9.6, 9.6,50,21, 0)
  6332   ^^4^4^2940 502^^^
  6333   "^DD",9.6, 9.6,50,21, 1,0)
  6334   These are  the Instal l question s that wil l be asked  at the in stalling s ite.
  6335   "^DD",9.6, 9.6,50,21, 2,0)
  6336   All questi ons will u se the VA  Fileman Re ader (DIR)  and all v ariables n eed
  6337   "^DD",9.6, 9.6,50,21, 3,0)
  6338   to be defi ned in thi s multiple . Only the  ENVIROMEN T CHECK RO UTINE will  be
  6339   "^DD",9.6, 9.6,50,21, 4,0)
  6340   loaded at  the instal ling site  when these  questions  are asked .
  6341   "^DD",9.6, 9.6,51.01, 0)
  6342   XPF1^S^YES :YES;NO:NO ;^QDEF;1^Q
  6343   "^DD",9.6, 9.6,51.01, 21,0)
  6344   ^^1^1^3070 619^
  6345   "^DD",9.6, 9.6,51.01, 21,1,0)
  6346   Place hold er for dev eloper def ault answe r. Not use d at this  time.
  6347   "^DD",9.6, 9.6,51.01, "DT")
  6348   3070619
  6349   "^DD",9.6, 9.6,51.03, 0)
  6350   XPF2^S^YES :YES;NO:NO ;^QDEF;3^Q
  6351   "^DD",9.6, 9.6,51.03, 21,0)
  6352   ^^1^1^3070 621^
  6353   "^DD",9.6, 9.6,51.03, 21,1,0)
  6354   Place hold er for dev eloper def ault answe r. Not use d at this  time.
  6355   "^DD",9.6, 9.6,51.03, 23,0)
  6356   ^^2^2^3070 621^
  6357   "^DD",9.6, 9.6,51.03, 23,1,0)
  6358   The order  and locati on of thes e fields a re setup t o match th e order an
  6359   "^DD",9.6, 9.6,51.03, 23,2,0)
  6360   index in Q UESTION^XP DTC.
  6361   "^DD",9.6, 9.6,51.03, "DT")
  6362   3070621
  6363   "^DD",9.6, 9.6,51.05, 0)
  6364   XPI1^S^YES :YES;NO:NO ;^QDEF;5^Q
  6365   "^DD",9.6, 9.6,51.05, 21,0)
  6366   ^^1^1^3070 619^
  6367   "^DD",9.6, 9.6,51.05, 21,1,0)
  6368   This field  holds the  developer  default f or the Ins tall quest ion XPI1.
  6369   "^DD",9.6, 9.6,51.05, "DT")
  6370   3070619
  6371   "^DD",9.6, 9.6,51.07, 0)
  6372   XPM1^S^YES :YES;NO:NO ;^QDEF;7^Q
  6373   "^DD",9.6, 9.6,51.07, 21,0)
  6374   ^^1^1^3070 621^
  6375   "^DD",9.6, 9.6,51.07, 21,1,0)
  6376   Place hold er for dev eloper def ault answe r. Not use d at this  time.
  6377   "^DD",9.6, 9.6,51.07, "DT")
  6378   3070621
  6379   "^DD",9.6, 9.6,51.09, 0)
  6380   XPO1^S^YES :YES;NO:NO ;^QDEF;9^Q
  6381   "^DD",9.6, 9.6,51.09, 21,0)
  6382   ^^1^1^3070 619^
  6383   "^DD",9.6, 9.6,51.09, 21,1,0)
  6384   This field  holds the  developer  default f or the Ins tall quest ion XPO1.
  6385   "^DD",9.6, 9.6,51.09, "DT")
  6386   3070619
  6387   "^DD",9.6, 9.6,51.11, 0)
  6388   XPZ1^S^YES :YES;NO:NO ;^QDEF;11^ Q
  6389   "^DD",9.6, 9.6,51.11, 21,0)
  6390   ^^1^1^3070 619^
  6391   "^DD",9.6, 9.6,51.11, 21,1,0)
  6392   This field  holds the  developer  default f or the Ins tall quest ion XPZ1.
  6393   "^DD",9.6, 9.6,51.11, "DT")
  6394   3070619
  6395   "^DD",9.6, 9.6,51.13, 0)
  6396   XPZ2^S^YES :YES;NO:NO ;^QDEF;13^ Q
  6397   "^DD",9.6, 9.6,51.13, 21,0)
  6398   ^^1^1^3070 619^
  6399   "^DD",9.6, 9.6,51.13, 21,1,0)
  6400   Place hold er for dev eloper def ault answe r. Not use d at this  time.
  6401   "^DD",9.6, 9.6,51.13, "DT")
  6402   3070619
  6403   "^DD",9.6, 9.6,61,0)
  6404   TEST#^NJ3, 0^^6;1^K:+ X'=X!(X>99 9)!(X<1)!( X?.E1"."1N .N) X
  6405   "^DD",9.6, 9.6,61,3)
  6406   Type a Num ber betwee n 1 and 99 9, 0 Decim al Digits
  6407   "^DD",9.6, 9.6,61,21, 0)
  6408   ^^2^2^3050 609^
  6409   "^DD",9.6, 9.6,61,21, 1,0)
  6410   This is ju st a place  holder to  reserve t he databas e location  in the 
  6411   "^DD",9.6, 9.6,61,21, 2,0)
  6412   INSTALL fi le.
  6413   "^DD",9.6, 9.6,61,"DT ")
  6414   3050609
  6415   "^DD",9.6, 9.6,62,0)
  6416   SEQ#^NJ3,0 ^^6;2^K:+X '=X!(X>999 )!(X<1)!(X ?.E1"."1N. N) X
  6417   "^DD",9.6, 9.6,62,3)
  6418   Type a Num ber betwee n 1 and 99 9, 0 Decim al Digits
  6419   "^DD",9.6, 9.6,62,21, 0)
  6420   ^^2^2^3050 609^
  6421   "^DD",9.6, 9.6,62,21, 1,0)
  6422   This is ju st a place  holder to  reserve t he databas e location  in the 
  6423   "^DD",9.6, 9.6,62,21, 2,0)
  6424   INSTALL fi le.
  6425   "^DD",9.6, 9.6,62,"DT ")
  6426   3050609
  6427   "^DD",9.6, 9.6,63,0)
  6428   TRANSPORT  BUILD NUMB ER^NJ3,0^^ 6.3;1^K:+X '=X!(X>999 )!(X<0)!(X ?.E1"."1.N ) X
  6429   "^DD",9.6, 9.6,63,.1)
  6430   Transport  Build Numb er
  6431   "^DD",9.6, 9.6,63,3)
  6432   Type a num ber betwee n 0 and 99 9, 0 Decim al Digits
  6433   "^DD",9.6, 9.6,63,21, 0)
  6434   ^^6^6^3051 206^
  6435   "^DD",9.6, 9.6,63,21, 1,0)
  6436   This field  holds the  Transport  Build Num ber for th is package  or patch.  It
  6437   "^DD",9.6, 9.6,63,21, 2,0)
  6438   is increme nted by on e every ti me there i s a KIDS t ransport d one. It sh ould
  6439   "^DD",9.6, 9.6,63,21, 3,0)
  6440   not be edi ted. Durin g the KIDS  transport  this buil d number w ill be 
  6441   "^DD",9.6, 9.6,63,21, 4,0)
  6442   inserted i nto the 7t h piece of  the secon d line. Du ring the t esting of 
  6443   "^DD",9.6, 9.6,63,21, 5,0)
  6444   package or  patch thi s gives a  way for su pport to k now if the  most 
  6445   "^DD",9.6, 9.6,63,21, 6,0)
  6446   current ro utines are  loaded.
  6447   "^DD",9.6, 9.6,63,"DT ")
  6448   3060619
  6449   "^DD",9.6, 9.6,900,0)
  6450   PRE-TRANSP ORTATION R OUTINE^FJ3 3X^^PRET;E 1,240^K:$L (X)>33!($L (X)<3)!'(X ?.1UP.15UN .1"^"1UP.1 5UN) X
  6451   "^DD",9.6, 9.6,900,3)
  6452   Enter a ro utine, [TA G^]ROUTINE , up to 33  character s.
  6453   "^DD",9.6, 9.6,900,21 ,0)
  6454   ^.001^6^6^ 3160307^^^ ^
  6455   "^DD",9.6, 9.6,900,21 ,1,0)
  6456   The name o f the rout ine which  is run bef ore the Tr ansport Gl obal
  6457   "^DD",9.6, 9.6,900,21 ,2,0)
  6458   is sent. Y ou can use  this rout ine to add  nodes to  the Transp ort
  6459   "^DD",9.6, 9.6,900,21 ,3,0)
  6460   Global.  T he variabl e XPDGREF  will be de fined to a  closed gl obal
  6461   "^DD",9.6, 9.6,900,21 ,4,0)
  6462   root that  could be u sed to set  the nodes .
  6463   "^DD",9.6, 9.6,900,21 ,5,0)
  6464    example:  S @XPDGREF @("mydata" ,1,0)="nod e one of d ata"
  6465   "^DD",9.6, 9.6,900,21 ,6,0)
  6466  
  6467   "^DD",9.6, 9.6,900,"D T")
  6468   3160307
  6469   "^DD",9.6, 9.6,913,0)
  6470   ENVIRONMEN T CHECK RO UTINE^FXJ1 6^^PRE;1^K :$L(X)<3!( X'?1U.15UN ) X
  6471   "^DD",9.6, 9.6,913,.1 )
  6472   DEVELOPERS  ROUTINE R UN BEFORE  'INIT' QUE STIONS ASK ED
  6473   "^DD",9.6, 9.6,913,3)
  6474   Enter name  of develo per's envi ronment ch eck routin e (3-16 ch aracters)  that runs  before any  user ques tions are  asked.  Th is routine  should be  used for  environmen t check on ly and sho uld not al ter data.
  6475   "^DD",9.6, 9.6,913,21 ,0)
  6476   ^.001^8^8^ 3160307^^^ ^
  6477   "^DD",9.6, 9.6,913,21 ,1,0)
  6478   The name o f the deve loper's ro utine whic h is run a t the begi nning of
  6479   "^DD",9.6, 9.6,913,21 ,2,0)
  6480   the instal l process.   This sho uld just c heck the e nvironment
  6481   "^DD",9.6, 9.6,913,21 ,3,0)
  6482   and should  not alter  any data,  since the  user has  no way to  exit out o f
  6483   "^DD",9.6, 9.6,913,21 ,4,0)
  6484   the instal l process  until this  program r uns to com pletion.
  6485   "^DD",9.6, 9.6,913,21 ,5,0)
  6486   This routi ne can int eract with  the user.  If the va riable XPD QUIT is se t,
  6487   "^DD",9.6, 9.6,913,21 ,6,0)
  6488   the instal l process  will termi nate.
  6489   "^DD",9.6, 9.6,913,21 ,7,0)
  6490    Note: Thi s routine  must be se lf-contain ed, since  it will be  the only
  6491   "^DD",9.6, 9.6,913,21 ,8,0)
  6492   routine in stalled fr om this pa ckage at t his time.
  6493   "^DD",9.6, 9.6,913,"D T")
  6494   3160307
  6495   "^DD",9.6, 9.6,913.1, 0)
  6496   DELETE ENV  ROUTINE^S ^y:Yes;n:N o;^INID;1^ Q
  6497   "^DD",9.6, 9.6,913.1, 3)
  6498   Enter 'Yes ' if you w ant the En vironment  Check Rout ine delete d at the e nd of the  install.
  6499   "^DD",9.6, 9.6,913.1, 21,0)
  6500   ^.001^3^3^ 3160307^^^
  6501   "^DD",9.6, 9.6,913.1, 21,1,0)
  6502   Setting th is field t o YES will  instruct  KIDS to de lete the E nvironment
  6503   "^DD",9.6, 9.6,913.1, 21,2,0)
  6504   Check Rout ine at the  end of th e install.
  6505   "^DD",9.6, 9.6,913.1, 21,3,0)
  6506  
  6507   "^DD",9.6, 9.6,913.1, "DT")
  6508   3160307
  6509   "^DD",9.6, 9.6,914,0)
  6510   POST-INSTA LL ROUTINE ^FXJ33^^IN IT;E1,240^ K:$L(X)>33 !(X'?.1UP. 15UN.1"^"1 UP.15UN) X
  6511   "^DD",9.6, 9.6,914,.1 )
  6512  
  6513   "^DD",9.6, 9.6,914,3)
  6514   Enter the  name of th e develope r's post-i nitializat ion [TAG^] ROUTINE, u p to 33 ch aracters. 
  6515   "^DD",9.6, 9.6,914,21 ,0)
  6516   ^.001^3^3^ 3160307^^^ ^
  6517   "^DD",9.6, 9.6,914,21 ,1,0)
  6518   The name o f the deve loper's ro utine whic h is run i mmediately  after the
  6519   "^DD",9.6, 9.6,914,21 ,2,0)
  6520   installati on of the  package.   This routi ne cannot  be interac tive with
  6521   "^DD",9.6, 9.6,914,21 ,3,0)
  6522   the user,  it might b e queued t o run at a  later tim e.
  6523   "^DD",9.6, 9.6,914,"D T")
  6524   3160307
  6525   "^DD",9.6, 9.6,914.1, 0)
  6526   DELETE POS T-INIT ROU TINE^S^y:Y es;n:No;^I NID;2^Q
  6527   "^DD",9.6, 9.6,914.1, 3)
  6528  
  6529   "^DD",9.6, 9.6,914.1, 21,0)
  6530   ^^2^2^2990 607^
  6531   "^DD",9.6, 9.6,914.1, 21,1,0)
  6532   Setting th is field t o YES will  instruct  KIDS to de lete the P ost-INIT
  6533   "^DD",9.6, 9.6,914.1, 21,2,0)
  6534   Routine at  the end o f the inst all.
  6535   "^DD",9.6, 9.6,914.1, "DT")
  6536   2990415
  6537   "^DD",9.6, 9.6,916,0)
  6538   PRE-INSTAL L ROUTINE^ FXJ33^^INI ;E1,240^K: $L(X)>33!( X'?.1UP.15 UN.1"^".1U P.15UN) X
  6539   "^DD",9.6, 9.6,916,.1 )
  6540  
  6541   "^DD",9.6, 9.6,916,3)
  6542   Enter name  of develo per's pre- init [TAG^ ]ROUTINE,  up to 33 c haracters.
  6543   "^DD",9.6, 9.6,916,21 ,0)
  6544   ^^6^6^2940 518^^^^
  6545   "^DD",9.6, 9.6,916,21 ,1,0)
  6546   Name of th e develope r's routin e that run s after th e user has  answered  all
  6547   "^DD",9.6, 9.6,916,21 ,2,0)
  6548   of the que stions, bu t before a ny data or  DD has be en install ed. All of
  6549   "^DD",9.6, 9.6,916,21 ,3,0)
  6550   the routin es for thi s package  will alrea dy be inst alled. Use d for data
  6551   "^DD",9.6, 9.6,916,21 ,4,0)
  6552   conversion s, etc. th at the dev eloper nee ds to do b efore brin ging in ne w
  6553   "^DD",9.6, 9.6,916,21 ,5,0)
  6554   data.  Thi s routine  cannot be  interactiv e with the  user, it  might
  6555   "^DD",9.6, 9.6,916,21 ,6,0)
  6556   be queued  to run at  a later ti me.
  6557   "^DD",9.6, 9.6,916,"D T")
  6558   3160307
  6559   "^DD",9.6, 9.6,916.1, 0)
  6560   DELETE PRE -INIT ROUT INE^S^y:Ye s;n:No;^IN ID;3^Q
  6561   "^DD",9.6, 9.6,916.1, 3)
  6562  
  6563   "^DD",9.6, 9.6,916.1, 21,0)
  6564   ^^2^2^2990 607^
  6565   "^DD",9.6, 9.6,916.1, 21,1,0)
  6566   Setting th is field t o YES will  instruct  KIDS to de lete the P re-INIT
  6567   "^DD",9.6, 9.6,916.1, 21,2,0)
  6568   Routine at  the end o f the inst all.
  6569   "^DD",9.6, 9.6,916.1, "DT")
  6570   2990415
  6571   "^DD",9.6, 9.61,0)
  6572   DESCRIPTIO N OF ENHAN CEMENTS SU B-FIELD^NL ^.01^1
  6573   "^DD",9.6, 9.61,0,"NM ","DESCRIP TION OF EN HANCEMENTS ")
  6574  
  6575   "^DD",9.6, 9.61,0,"UP ")
  6576   9.6
  6577   "^DD",9.6, 9.61,.01,0 )
  6578   DESCRIPTIO N^W^^0;1^Q
  6579   "^DD",9.6, 9.61,.01,3 )
  6580   Please ent er a compl ete and de tailed des cription o f the Pack age.
  6581   "^DD",9.6, 9.61,.01,2 1,0)
  6582   ^.001^2^2^ 3150304^^^ ^
  6583   "^DD",9.6, 9.61,.01,2 1,1,0)
  6584   This is a  complete a nd detaile d descript ion of the  Package's  functions
  6585   "^DD",9.6, 9.61,.01,2 1,2,0)
  6586   and capabi lities.
  6587   "^DD",9.6, 9.61,.01," DT")
  6588   2851007
  6589   "^DD",9.6, 9.611,0)
  6590   REQUIRED B UILD SUB-F IELD^^1^2
  6591   "^DD",9.6, 9.611,0,"D T")
  6592   2960905
  6593   "^DD",9.6, 9.611,0,"I X","B",9.6 11,.01)
  6594  
  6595   "^DD",9.6, 9.611,0,"N M","REQUIR ED BUILD")
  6596  
  6597   "^DD",9.6, 9.611,0,"U P")
  6598   9.6
  6599   "^DD",9.6, 9.611,.01, 0)
  6600   REQUIRED B UILD^MFX^^ 0;1^K:$L(X )>50!($L(X )<3) X I $ D(X) D INP UTMB^XPDET (.X)
  6601   "^DD",9.6, 9.611,.01, 1,0)
  6602   ^.1
  6603   "^DD",9.6, 9.611,.01, 1,1,0)
  6604   9.611^B
  6605   "^DD",9.6, 9.611,.01, 1,1,1)
  6606   S ^XPD(9.6 ,DA(1),"RE QB","B",X, DA)=""
  6607   "^DD",9.6, 9.611,.01, 1,1,2)
  6608   K ^XPD(9.6 ,DA(1),"RE QB","B",X, DA)
  6609   "^DD",9.6, 9.611,.01, 3)
  6610   Enter a Bu ild name
  6611   "^DD",9.6, 9.611,.01, 4)
  6612   D HELPMB^X PDET
  6613   "^DD",9.6, 9.611,.01, 21,0)
  6614   ^^4^4^2960 904^^
  6615   "^DD",9.6, 9.611,.01, 21,1,0)
  6616   Enter a Bu ild name,  a patch or  package,  that is re quired to  be
  6617   "^DD",9.6, 9.611,.01, 21,2,0)
  6618   installed  before thi s Build is  installed .  KIDS wi ll check t he
  6619   "^DD",9.6, 9.611,.01, 21,3,0)
  6620   Package fi le, Versio n multiple  and Patch  Applicati on History  multiple,
  6621   "^DD",9.6, 9.611,.01, 21,4,0)
  6622   to verify  that the R equired Bu ild has be en install ed.
  6623   "^DD",9.6, 9.611,.01, "DT")
  6624   2960904
  6625   "^DD",9.6, 9.611,1,0)
  6626   ACTION^RS^ 0:Warning  only;1:Don 't install , remove g lobal;2:Do n't instal l, leave g lobal;^0;2 ^Q
  6627   "^DD",9.6, 9.611,1,21 ,0)
  6628   ^^2^2^2960 819^
  6629   "^DD",9.6, 9.611,1,21 ,1,0)
  6630   This is th e action y ou want to  happen wh en install ing this B uild and t he
  6631   "^DD",9.6, 9.611,1,21 ,2,0)
  6632   Required B uild has n ot been in stalled at  the site.
  6633   "^DD",9.6, 9.611,1,"D T")
  6634   2960905
  6635   "^DD",9.6, 9.62,0)
  6636   INSTALL QU ESTIONS SU B-FIELD^^1 0^9
  6637   "^DD",9.6, 9.62,0,"DT ")
  6638   2931129
  6639   "^DD",9.6, 9.62,0,"IX ","B",9.62 ,.01)
  6640  
  6641   "^DD",9.6, 9.62,0,"NM ","INSTALL  QUESTIONS ")
  6642  
  6643   "^DD",9.6, 9.62,0,"UP ")
  6644   9.6
  6645   "^DD",9.6, 9.62,.01,0 )
  6646   SUBSCRIPT^ MFX^^0;1^K :$L(X)>30! '(X?1"PRE" .E!(X?1"PO S".E)) X
  6647   "^DD",9.6, 9.62,.01,1 ,0)
  6648   ^.1
  6649   "^DD",9.6, 9.62,.01,1 ,1,0)
  6650   9.62^B
  6651   "^DD",9.6, 9.62,.01,1 ,1,1)
  6652   S ^XPD(9.6 ,DA(1),"QU ES","B",$E (X,1,30),D A)=""
  6653   "^DD",9.6, 9.62,.01,1 ,1,2)
  6654   K ^XPD(9.6 ,DA(1),"QU ES","B",$E (X,1,30),D A)
  6655   "^DD",9.6, 9.62,.01,3 )
  6656   Answer mus t begin wi th "PRE" o r "POS" an d can be u p to 30 ch aracters i n length.
  6657   "^DD",9.6, 9.62,.01,2 1,0)
  6658   ^^8^8^2940 607^^^^
  6659   "^DD",9.6, 9.62,.01,2 1,1,0)
  6660   This field  will be u sed as the  subscript  of the us ers answer  to the
  6661   "^DD",9.6, 9.62,.01,2 1,2,0)
  6662   Install Qu estions.   The first  3 characte r should b e either " PRE" or "P OS"
  6663   "^DD",9.6, 9.62,.01,2 1,3,0)
  6664   to indicat e whether  the questi on should  be asked d uring the  pre-init o r
  6665   "^DD",9.6, 9.62,.01,2 1,4,0)
  6666   during the  post-init .   The an swers will  be in the  XPDQUES a rray, exam ple:
  6667   "^DD",9.6, 9.62,.01,2 1,5,0)
  6668    If this f ield was s et to 'PRE 1 QUESTION ' then
  6669   "^DD",9.6, 9.62,.01,2 1,6,0)
  6670    XPDQUES(" PRE1 QUEST ION") = us er respons e.
  6671   "^DD",9.6, 9.62,.01,2 1,7,0)
  6672    
  6673   "^DD",9.6, 9.62,.01,2 1,8,0)
  6674   This field  is also u sed to det ermine the  order of  the questi ons.
  6675   "^DD",9.6, 9.62,.01," DT")
  6676   2931129
  6677   "^DD",9.6, 9.62,1,0)
  6678   DIR(0)^RF^ ^1;E1,245^ K:$L(X)>24 0!($L(X)<1 ) X
  6679   "^DD",9.6, 9.62,1,3)
  6680   Answer mus t be 1-240  character s in lengt h.
  6681   "^DD",9.6, 9.62,1,21, 0)
  6682   ^^1^1^2940 414^
  6683   "^DD",9.6, 9.62,1,21, 1,0)
  6684   This is th e DIR(0) v ariable fo r the VA F ileman DIR  routine.
  6685   "^DD",9.6, 9.62,1,"DT ")
  6686   2931123
  6687   "^DD",9.6, 9.62,2,0)
  6688   DIR(A)^F^^ A;E1,245^K :$L(X)>240 !($L(X)<1)  X
  6689   "^DD",9.6, 9.62,2,3)
  6690   Answer mus t be 1-240  character s in lengt h.
  6691   "^DD",9.6, 9.62,2,21, 0)
  6692   ^^1^1^2940 414^^
  6693   "^DD",9.6, 9.62,2,21, 1,0)
  6694   This is th e DIR("A")  variable  for the VA  Fileman D IR routine .
  6695   "^DD",9.6, 9.62,2,"DT ")
  6696   2931122
  6697   "^DD",9.6, 9.62,3,0)
  6698   DIR(A,#)^9 .623^^A1;0
  6699   "^DD",9.6, 9.62,3,21, 0)
  6700   ^^1^1^2940 414^^
  6701   "^DD",9.6, 9.62,3,21, 1,0)
  6702   This is th e DIR("A", #) array f or the VA  Fileman DI R routine.
  6703   "^DD",9.6, 9.62,4,0)
  6704   DIR(B)^F^^ B;1^K:$L(X )>79!($L(X )<1) X
  6705   "^DD",9.6, 9.62,4,3)
  6706   Answer mus t be 1-79  characters  in length .
  6707   "^DD",9.6, 9.62,4,21, 0)
  6708   ^^1^1^2940 414^^
  6709   "^DD",9.6, 9.62,4,21, 1,0)
  6710   This is th e DIR("B")  variable  for the VA  Fileman D IR routine .
  6711   "^DD",9.6, 9.62,4,"DT ")
  6712   2931122
  6713   "^DD",9.6, 9.62,5,0)
  6714   DIR(?)^F^^ Q;E1,245^K :$L(X)>240 !($L(X)<1)  X
  6715   "^DD",9.6, 9.62,5,3)
  6716   Answer mus t be 1-240  character s in lengt h.
  6717   "^DD",9.6, 9.62,5,21, 0)
  6718   ^^1^1^2940 414^^
  6719   "^DD",9.6, 9.62,5,21, 1,0)
  6720   This is th e DIR("?")  variable  for the VA  Fileman D IR routine .
  6721   "^DD",9.6, 9.62,5,"DT ")
  6722   2931122
  6723   "^DD",9.6, 9.62,6,0)
  6724   DIR(?,#)^9 .626^^Q1;0
  6725   "^DD",9.6, 9.62,6,21, 0)
  6726   ^^1^1^2940 414^^
  6727   "^DD",9.6, 9.62,6,21, 1,0)
  6728   This is th e DIR("?", #) array f or the VA  Fileman DI R routine.
  6729   "^DD",9.6, 9.62,7,0)
  6730   DIR(??)^F^ ^QQ;E1,245 ^K:$L(X)>2 40!($L(X)< 3) X
  6731   "^DD",9.6, 9.62,7,3)
  6732   Answer mus t be 3-240  character s in lengt h.
  6733   "^DD",9.6, 9.62,7,21, 0)
  6734   ^^1^1^2940 414^^
  6735   "^DD",9.6, 9.62,7,21, 1,0)
  6736   This is th e DIR("??" ) variable  for the V A Fileman  DIR routin e.
  6737   "^DD",9.6, 9.62,7,"DT ")
  6738   2931122
  6739   "^DD",9.6, 9.62,10,0)
  6740   M CODE^K^^ M;E1,245^K :$L(X)>245  X D:$D(X)  ^DIM
  6741   "^DD",9.6, 9.62,10,3)
  6742   This is St andard MUM PS code.
  6743   "^DD",9.6, 9.62,10,9)
  6744   @
  6745   "^DD",9.6, 9.62,10,21 ,0)
  6746   ^^6^6^2940 110^^
  6747   "^DD",9.6, 9.62,10,21 ,1,0)
  6748   This field  contains  standard M  code whic h will be  executed a fter the D IR
  6749   "^DD",9.6, 9.62,10,21 ,2,0)
  6750   array has  been set f rom the pr evious fie lds, but b efore the  call to th e DIR
  6751   "^DD",9.6, 9.62,10,21 ,3,0)
  6752   routine. I f the deve loper does n't want t o ask a qu estion, ki ll the DIR
  6753   "^DD",9.6, 9.62,10,21 ,4,0)
  6754   array.  Th e array XP DQUES(SUBS CRIPT)=int ernal answ er will be  defined f or all
  6755   "^DD",9.6, 9.62,10,21 ,5,0)
  6756   questions  asked.  Th is code ca n only mak e referenc es to the  ENVIORMENT  CHECK
  6757   "^DD",9.6, 9.62,10,21 ,6,0)
  6758   ROUTINE, s ince it wi ll be the  only routi ne loaded  at this ti me.
  6759   "^DD",9.6, 9.62,10,"D T")
  6760   2931129
  6761   "^DD",9.6, 9.623,0)
  6762   DIR(A,#) S UB-FIELD^^ .01^1
  6763   "^DD",9.6, 9.623,0,"D T")
  6764   2931122
  6765   "^DD",9.6, 9.623,0,"N M","DIR(A, #)")
  6766  
  6767   "^DD",9.6, 9.623,0,"U P")
  6768   9.62
  6769   "^DD",9.6, 9.623,.01, 0)
  6770   DIR(A,#)^W L^^0;1^Q
  6771   "^DD",9.6, 9.623,.01, "DT")
  6772   2931122
  6773   "^DD",9.6, 9.626,0)
  6774   DIR(?,#) S UB-FIELD^^ .01^1
  6775   "^DD",9.6, 9.626,0,"D T")
  6776   2931122
  6777   "^DD",9.6, 9.626,0,"N M","DIR(?, #)")
  6778  
  6779   "^DD",9.6, 9.626,0,"U P")
  6780   9.62
  6781   "^DD",9.6, 9.626,.01, 0)
  6782   DIR(?,#)^W L^^0;1^Q
  6783   "^DD",9.6, 9.626,.01, "DT")
  6784   2931122
  6785   "^DD",9.6, 9.63,0)
  6786   MULTIPLE B UILD SUB-F IELD^^.02^ 3
  6787   "^DD",9.6, 9.63,0,"DT ")
  6788   2981117
  6789   "^DD",9.6, 9.63,0,"IX ","B",9.63 ,.01)
  6790  
  6791   "^DD",9.6, 9.63,0,"NM ","MULTIPL E BUILD")
  6792  
  6793   "^DD",9.6, 9.63,0,"UP ")
  6794   9.6
  6795   "^DD",9.6, 9.63,.001, 0)
  6796   INSTALL OR DER^NJ6,2^ ^ ^K:+X'=X !(X>999)!( X<1)!(X?.E 1"."3N.N)  X
  6797   "^DD",9.6, 9.63,.001, 3)
  6798   Type a Num ber betwee n 1 and 99 9, 2 Decim al Digits
  6799   "^DD",9.6, 9.63,.001, 21,0)
  6800   ^^1^1^2940 503^
  6801   "^DD",9.6, 9.63,.001, 21,1,0)
  6802   This is th e order in  which thi s package  will be in stalled.
  6803   "^DD",9.6, 9.63,.001, "DT")
  6804   2981117
  6805   "^DD",9.6, 9.63,.01,0 )
  6806   MULTIPLE B UILD^MFX^^ 0;1^K:$L(X )>50!($L(X )<3) X I $ D(X) D INP UTMB^XPDET (.X)
  6807   "^DD",9.6, 9.63,.01,1 ,0)
  6808   ^.1
  6809   "^DD",9.6, 9.63,.01,1 ,1,0)
  6810   9.63^B
  6811   "^DD",9.6, 9.63,.01,1 ,1,1)
  6812   S ^XPD(9.6 ,DA(1),10, "B",X,DA)= ""
  6813   "^DD",9.6, 9.63,.01,1 ,1,2)
  6814   K ^XPD(9.6 ,DA(1),10, "B",X,DA)
  6815   "^DD",9.6, 9.63,.01,3 )
  6816   Enter a Bu ild name
  6817   "^DD",9.6, 9.63,.01,4 )
  6818   D HELPMB^X PDET
  6819   "^DD",9.6, 9.63,.01,2 1,0)
  6820   ^^2^2^2960 904^^
  6821   "^DD",9.6, 9.63,.01,2 1,1,0)
  6822   Name of Bu ild that w ill be par t of this  multi-pack age distri bution or  a
  6823   "^DD",9.6, 9.63,.01,2 1,2,0)
  6824   patch that  is part o f this Bui ld definit ion.
  6825   "^DD",9.6, 9.63,.01," DT")
  6826   2960904
  6827   "^DD",9.6, 9.63,.02,0 )
  6828   REQUIRED T O CONTINUE ^S^1:YES;0 :NO;^0;2^Q
  6829   "^DD",9.6, 9.63,.02,2 1,0)
  6830   ^^6^6^2990 217^^^^
  6831   "^DD",9.6, 9.63,.02,2 1,1,0)
  6832   YES: If th is distrib ution fail s KID's in ternal che cks it wil l be unloa ded 
  6833   "^DD",9.6, 9.63,.02,2 1,2,0)
  6834   automatica lly along  with all o ther distr ibutions i n this mul ti-build.   No user 
  6835   "^DD",9.6, 9.63,.02,2 1,3,0)
  6836   interactio n will tak e place.
  6837   "^DD",9.6, 9.63,.02,2 1,4,0)
  6838  
  6839   "^DD",9.6, 9.63,.02,2 1,5,0)
  6840   NO: If thi s distribu tuion fail s KID's in ternal che cks the us er will ch oose to 
  6841   "^DD",9.6, 9.63,.02,2 1,6,0)
  6842   either 'lo ad it' or  'skip it'  and contin ue with th e other di stribution s.
  6843   "^DD",9.6, 9.63,.02," DT")
  6844   2981118
  6845   "^DD",9.6, 9.64,0)
  6846   FILE SUB-F IELD^NL^22 4^13
  6847   "^DD",9.6, 9.64,0,"DT ")
  6848   2950330
  6849   "^DD",9.6, 9.64,0,"IX ","AC",9.6 4,222.3)
  6850  
  6851   "^DD",9.6, 9.64,0,"IX ","APDD",9 .6411,.01)
  6852  
  6853   "^DD",9.6, 9.64,0,"IX ","B",9.64 ,.01)
  6854  
  6855   "^DD",9.6, 9.64,0,"NM ","FILE")
  6856  
  6857   "^DD",9.6, 9.64,0,"UP ")
  6858   9.6
  6859   "^DD",9.6, 9.64,.01,0 )
  6860   FILE^M*P1' X^DIC(^0;1 ^S DIC("S" )="I Y>1.9 999" D ^DI C K DIC S  DIC=DIE,X= +Y K:Y<0 X  I $D(X) S  DINUM=X
  6861   "^DD",9.6, 9.64,.01,. 1)
  6862   REQUIRED F ILES FOR T HIS PACKAG E
  6863   "^DD",9.6, 9.64,.01,1 ,0)
  6864   ^.1^^-1
  6865   "^DD",9.6, 9.64,.01,1 ,1,0)
  6866   9.64^B
  6867   "^DD",9.6, 9.64,.01,1 ,1,1)
  6868   S ^XPD(9.6 ,DA(1),4," B",X,DA)=" "
  6869   "^DD",9.6, 9.64,.01,1 ,1,2)
  6870   K ^XPD(9.6 ,DA(1),4," B",X,DA)
  6871   "^DD",9.6, 9.64,.01,3 )
  6872   Please ent er the nam e of a FIL E that is  known to V A FileMan.
  6873   "^DD",9.6, 9.64,.01,1 2)
  6874   Select a f ile which  is used by  this pack age.
  6875   "^DD",9.6, 9.64,.01,1 2.1)
  6876   S DIC("S") ="I Y>1.99 99"
  6877   "^DD",9.6, 9.64,.01,2 1,0)
  6878   ^^2^2^2920 513^^^^
  6879   "^DD",9.6, 9.64,.01,2 1,1,0)
  6880   The name o f a VA Fil eMan file  which you  wish to tr ansport wi th
  6881   "^DD",9.6, 9.64,.01,2 1,2,0)
  6882   this packa ge.  This  may be any  file whos e number i s 2 or gre ater.
  6883   "^DD",9.6, 9.64,.01," DT")
  6884   2931104
  6885   "^DD",9.6, 9.64,.02,0 )
  6886   CHECKSUM^F ^^0;2^K:$L (X)>30!($L (X)<3) X
  6887   "^DD",9.6, 9.64,.02,3 )
  6888   Answer mus t be 3-30  characters  in length .
  6889   "^DD",9.6, 9.64,.02,2 1,0)
  6890   ^^1^1^2950 330^
  6891   "^DD",9.6, 9.64,.02,2 1,1,0)
  6892   This field  contains  the checks um for thi s Data Dic tionary
  6893   "^DD",9.6, 9.64,.02," DT")
  6894   2950330
  6895   "^DD",9.6, 9.64,1,0)
  6896   DD NUMBER^ 9.641^^2;0
  6897   "^DD",9.6, 9.64,1,21, 0)
  6898   ^^2^2^2940 903^
  6899   "^DD",9.6, 9.64,1,21, 1,0)
  6900   DD NUMBER  pertains t o the top  level of t he file, f ile number , or a
  6901   "^DD",9.6, 9.64,1,21, 2,0)
  6902   sub-file s uch as a m ultiple fi eld.
  6903   "^DD",9.6, 9.64,222.1 ,0)
  6904   UPDATE THE  DATA DICT IONARY^S^y :YES;n:NO; ^222;1^Q
  6905   "^DD",9.6, 9.64,222.1 ,21,0)
  6906   8^^7^7^294 0503^
  6907   "^DD",9.6, 9.64,222.1 ,21,1,0)
  6908   YES means  that the D ata Dictio nary for t his file s hould be u pdated whe n
  6909   "^DD",9.6, 9.64,222.1 ,21,2,0)
  6910   this versi on of the  package is  installed .
  6911   "^DD",9.6, 9.64,222.1 ,21,3,0)
  6912    
  6913   "^DD",9.6, 9.64,222.1 ,21,4,0)
  6914   NO means t hat this D ata Dictio nary has n ot changed  since the  last vers ion,
  6915   "^DD",9.6, 9.64,222.1 ,21,5,0)
  6916    
  6917   "^DD",9.6, 9.64,222.1 ,21,6,0)
  6918   If the Dat a Dictiona ry does no t exist at  the insta lling site , then thi s
  6919   "^DD",9.6, 9.64,222.1 ,21,7,0)
  6920   field does  not apply .  The DD  will be pu t in place .
  6921   "^DD",9.6, 9.64,222.1 ,"DT")
  6922   2890627
  6923   "^DD",9.6, 9.64,222.2 ,0)
  6924   SEND SECUR ITY CODE^S ^y:YES;n:N O;^222;2^Q
  6925   "^DD",9.6, 9.64,222.2 ,21,0)
  6926   ^^5^5^2940 503^^^
  6927   "^DD",9.6, 9.64,222.2 ,21,1,0)
  6928   YES means  you want t o include  the securi ty protect ion curren tly
  6929   "^DD",9.6, 9.64,222.2 ,21,2,0)
  6930   on this fi le when it  is distri buted. The  security  protection  will
  6931   "^DD",9.6, 9.64,222.2 ,21,3,0)
  6932   only be in stalled if  the file  is new at  the instal ling site.
  6933   "^DD",9.6, 9.64,222.2 ,21,4,0)
  6934    
  6935   "^DD",9.6, 9.64,222.2 ,21,5,0)
  6936   NO means y ou do not  want to in clude secu rity codes .
  6937   "^DD",9.6, 9.64,222.2 ,"DT")
  6938   2940211
  6939   "^DD",9.6, 9.64,222.3 ,0)
  6940   SEND FULL  OR PARTIAL  DD^S^f:FU LL;p:PARTI AL;^222;3^ Q
  6941   "^DD",9.6, 9.64,222.3 ,1,0)
  6942   ^.1
  6943   "^DD",9.6, 9.64,222.3 ,1,1,0)
  6944   ^^TRIGGER^ 9.64^222.7
  6945   "^DD",9.6, 9.64,222.3 ,1,1,1)
  6946   X ^DD(9.64 ,222.3,1,1 ,1.3) I X  S X=DIV S  Y(1)=$S($D (^XPD(9.6, D0,4,D1,22 2)):^(222) ,1:"") S X =$P(Y(1),U ,7),X=X S  DIU=X K Y  S X=DIV S  X="n" X ^D D(9.64,222 .3,1,1,1.4 )
  6947   "^DD",9.6, 9.64,222.3 ,1,1,1.3)
  6948   K DIV S DI V=X,D0=DA( 1),DIV(0)= D0,D1=DA,D IV(1)=D1 S  Y(0)=X S  Y(1)=$C(59 )_$S($D(^D D(9.64,222 .3,0)):$P( ^(0),U,3), 1:"") S X= $P($P(Y(1) ,$C(59)_Y( 0)_":",2), $C(59),1)= "PARTIAL"
  6949   "^DD",9.6, 9.64,222.3 ,1,1,1.4)
  6950   S DIH=$S($ D(^XPD(9.6 ,DIV(0),4, DIV(1),222 )):^(222), 1:""),DIV= X S $P(^(2 22),U,7)=D IV,DIH=9.6 4,DIG=222. 7 D ^DICR
  6951   "^DD",9.6, 9.64,222.3 ,1,1,2)
  6952   Q
  6953   "^DD",9.6, 9.64,222.3 ,1,1,"%D", 0)
  6954   ^^2^2^2941 220^
  6955   "^DD",9.6, 9.64,222.3 ,1,1,"%D", 1,0)
  6956   This cross -reference  sets the  DATA COMES  WITH FILE  field to  'NO' if th e
  6957   "^DD",9.6, 9.64,222.3 ,1,1,"%D", 2,0)
  6958   Data Dicti onary is a  PARTIAL.
  6959   "^DD",9.6, 9.64,222.3 ,1,1,"CREA TE CONDITI ON")
  6960   SEND FULL  OR PARTIAL  DD="PARTI AL"
  6961   "^DD",9.6, 9.64,222.3 ,1,1,"CREA TE VALUE")
  6962   "n"
  6963   "^DD",9.6, 9.64,222.3 ,1,1,"DELE TE VALUE")
  6964   NO EFFECT
  6965   "^DD",9.6, 9.64,222.3 ,1,1,"DT")
  6966   2941220
  6967   "^DD",9.6, 9.64,222.3 ,1,1,"FIEL D")
  6968   #222.7
  6969   "^DD",9.6, 9.64,222.3 ,1,2,0)
  6970   9.64^AC^MU MPS
  6971   "^DD",9.6, 9.64,222.3 ,1,2,1)
  6972   K:X="f" ^X PD(9.6,DA( 1),4,DA,2) ,^XPD(9.6, DA(1),4,"A PDD",DA)
  6973   "^DD",9.6, 9.64,222.3 ,1,2,2)
  6974   Q
  6975   "^DD",9.6, 9.64,222.3 ,1,2,"%D", 0)
  6976   ^^2^2^2941 220^
  6977   "^DD",9.6, 9.64,222.3 ,1,2,"%D", 1,0)
  6978   This cross -reference  is to cle an up the  partial DD  informati on when
  6979   "^DD",9.6, 9.64,222.3 ,1,2,"%D", 2,0)
  6980   you send a  Full DD.
  6981   "^DD",9.6, 9.64,222.3 ,1,2,"DT")
  6982   2941220
  6983   "^DD",9.6, 9.64,222.3 ,"DT")
  6984   3030522
  6985   "^DD",9.6, 9.64,222.5 ,0)
  6986   RESOLVE PO INTERS^S^y :YES;n:NO; ^222;5^Q
  6987   "^DD",9.6, 9.64,222.5 ,21,0)
  6988   ^^4^4^3030 521^^
  6989   "^DD",9.6, 9.64,222.5 ,21,1,0)
  6990   YES means  you want t o have all  pointer t ype field  values res olved
  6991   "^DD",9.6, 9.64,222.5 ,21,2,0)
  6992   at the ins talling si te.
  6993   "^DD",9.6, 9.64,222.5 ,21,3,0)
  6994    
  6995   "^DD",9.6, 9.64,222.5 ,21,4,0)
  6996   NO means y ou do not  want any p ointer typ e field va lues resol ved.
  6997   "^DD",9.6, 9.64,222.5 ,"DT")
  6998   3030521
  6999   "^DD",9.6, 9.64,222.6 ,0)
  7000   DATA LIST^ FX^^222;6^ S X=$$SEL^ DIFROMSS(D 1,X) K:X=" " X
  7001   "^DD",9.6, 9.64,222.6 ,3)
  7002   Select Sor t Template  containin g the list  of record s to trans port, for  this file.
  7003   "^DD",9.6, 9.64,222.6 ,4)
  7004   D HELP^DIF ROMSS(D1)
  7005   "^DD",9.6, 9.64,222.6 ,12)
  7006   Must be a  sort list
  7007   "^DD",9.6, 9.64,222.6 ,12.1)
  7008   S DIC("S") ="I $P(^(0 ),U,4)=D1, $D(^(1))>9 "
  7009   "^DD",9.6, 9.64,222.6 ,21,0)
  7010   ^^2^2^2940 720^^^^
  7011   "^DD",9.6, 9.64,222.6 ,21,1,0)
  7012   This is th e results  of a searc h, which i s stored i n a Sort t emplate.   This
  7013   "^DD",9.6, 9.64,222.6 ,21,2,0)
  7014   Sort list  will conta in the rec ords to be  transport ed.
  7015   "^DD",9.6, 9.64,222.6 ,"DT")
  7016   2940720
  7017   "^DD",9.6, 9.64,222.7 ,0)
  7018   DATA COMES  WITH FILE ^S^y:YES;n :NO;^222;7 ^Q
  7019   "^DD",9.6, 9.64,222.7 ,1,0)
  7020   ^.1^^0
  7021   "^DD",9.6, 9.64,222.7 ,5,1,0)
  7022   9.64^222.3 ^1
  7023   "^DD",9.6, 9.64,222.7 ,21,0)
  7024   ^^4^4^2920 513^^^^
  7025   "^DD",9.6, 9.64,222.7 ,21,1,0)
  7026   YES means  that the d ata should  be includ ed in the  initializa tion
  7027   "^DD",9.6, 9.64,222.7 ,21,2,0)
  7028   routines.
  7029   "^DD",9.6, 9.64,222.7 ,21,3,0)
  7030    
  7031   "^DD",9.6, 9.64,222.7 ,21,4,0)
  7032   NO means t hat the da ta should  be left ou t.
  7033   "^DD",9.6, 9.64,222.7 ,"DT")
  7034   3030522
  7035   "^DD",9.6, 9.64,222.8 ,0)
  7036   SITE'S DAT A^S^a:ADD  ONLY IF NE W FILE;m:M ERGE;o:OVE RWRITE;r:R EPLACE;^22 2;8^Q
  7037   "^DD",9.6, 9.64,222.8 ,3)
  7038  
  7039   "^DD",9.6, 9.64,222.8 ,21,0)
  7040   7^^9^9^294 1108^^^^
  7041   "^DD",9.6, 9.64,222.8 ,21,1,0)
  7042   ADD ONLY I F NEW will  install d ata at the  installin g site onl y if this
  7043   "^DD",9.6, 9.64,222.8 ,21,2,0)
  7044   file is ne w to the s ite or the re is no d ata in thi s file at  the site.
  7045   "^DD",9.6, 9.64,222.8 ,21,3,0)
  7046   MERGE data  will only  bring in  data which  is not al ready on f ile at
  7047   "^DD",9.6, 9.64,222.8 ,21,4,0)
  7048   the instal ling site.
  7049   "^DD",9.6, 9.64,222.8 ,21,5,0)
  7050   OVERWRITE  data will  be put in  place rega rdless of  what is on  file
  7051   "^DD",9.6, 9.64,222.8 ,21,6,0)
  7052   at the ins talling si te.
  7053   "^DD",9.6, 9.64,222.8 ,21,7,0)
  7054   REPLACE wi ll delete  the instal ling site' s data bef ore instal ling data  for
  7055   "^DD",9.6, 9.64,222.8 ,21,8,0)
  7056   this file.  It will p reserve lo cally deve loped fiel ds, if the y were cre ated
  7057   "^DD",9.6, 9.64,222.8 ,21,9,0)
  7058   within the  VA Progra mming Stan dards and  Convention s.
  7059   "^DD",9.6, 9.64,222.8 ,"DT")
  7060   3030522
  7061   "^DD",9.6, 9.64,222.9 ,0)
  7062   MAY USER O VERRIDE DA TA UPDATE^ S^y:YES;n: NO;^222;9^ Q
  7063   "^DD",9.6, 9.64,222.9 ,3)
  7064  
  7065   "^DD",9.6, 9.64,222.9 ,21,0)
  7066   7^^7^7^294 0414^^^
  7067   "^DD",9.6, 9.64,222.9 ,21,1,0)
  7068   YES means  that the u ser has th e option t o determin e whether  or not
  7069   "^DD",9.6, 9.64,222.9 ,21,2,0)
  7070   to bring i n the data  that has  been sent  with this  package.   However,
  7071   "^DD",9.6, 9.64,222.9 ,21,3,0)
  7072   the user d oes not ge t the abil ity to cha nge how to  install t he SITE'S  DATA,
  7073   "^DD",9.6, 9.64,222.9 ,21,4,0)
  7074   i.e. MERGE  to REPLAC E.
  7075   "^DD",9.6, 9.64,222.9 ,21,5,0)
  7076    
  7077   "^DD",9.6, 9.64,222.9 ,21,6,0)
  7078   NO means t hat the de veloper of  this pack age will c ontrol whe ther the d ata
  7079   "^DD",9.6, 9.64,222.9 ,21,7,0)
  7080   will be in stalled at  the targe t site.
  7081   "^DD",9.6, 9.64,222.9 ,"DT")
  7082   2940502
  7083   "^DD",9.6, 9.64,223,0 )
  7084   SCREEN TO  DETERMINE  DD UPDATE^ KX^^223;E1 ,245^K:$L( X)>240 X I  $D(X) D ^ DIM
  7085   "^DD",9.6, 9.64,223,3 )
  7086   This is St andard MUM PS code fr om 1 to 24 0 characte rs in leng th.
  7087   "^DD",9.6, 9.64,223,9 )
  7088   @
  7089   "^DD",9.6, 9.64,223,2 1,0)
  7090   ^^5^5^2940 915^^^^
  7091   "^DD",9.6, 9.64,223,2 1,1,0)
  7092   This field  contains  standard M UMPS code  which is u sed to det ermine
  7093   "^DD",9.6, 9.64,223,2 1,2,0)
  7094   whether or  not a dat a dictiona ry should  be updated .  This co de must
  7095   "^DD",9.6, 9.64,223,2 1,3,0)
  7096   set $T.  I f $T=1, th e DD will  be updated .  If $T=0 , it will  not.
  7097   "^DD",9.6, 9.64,223,2 1,4,0)
  7098    
  7099   "^DD",9.6, 9.64,223,2 1,5,0)
  7100   Namespace  your varia bles.
  7101   "^DD",9.6, 9.64,223," DT")
  7102   2890927
  7103   "^DD",9.6, 9.64,224,0 )
  7104   SCREEN TO  SELECT DAT A^K^^224;E 1,245^K:$L (X)>245 X  D:$D(X) ^D IM
  7105   "^DD",9.6, 9.64,224,3 )
  7106   This is St andard MUM PS code.
  7107   "^DD",9.6, 9.64,224,9 )
  7108   @
  7109   "^DD",9.6, 9.64,224,2 1,0)
  7110   ^^5^5^2950 512^^^^
  7111   "^DD",9.6, 9.64,224,2 1,1,0)
  7112   This field  contains  standard M  code whic h is used  to determi ne
  7113   "^DD",9.6, 9.64,224,2 1,2,0)
  7114   whether a  record in  a file sho uld be exp orted in t his packag e.
  7115   "^DD",9.6, 9.64,224,2 1,3,0)
  7116   The variab le Y will  be equal t o the inte rnal entry  number of  the
  7117   "^DD",9.6, 9.64,224,2 1,4,0)
  7118   current re cord.  Thi s code mus t set $T,  if $T=1 th en the rec ord will
  7119   "^DD",9.6, 9.64,224,2 1,5,0)
  7120   be sent. I f $T=0 it  will not.
  7121   "^DD",9.6, 9.64,224," DT")
  7122   2940119
  7123   "^DD",9.6, 9.641,0)
  7124   DD NUMBER  SUB-FIELD^ ^1^3
  7125   "^DD",9.6, 9.641,0,"D T")
  7126   2950330
  7127   "^DD",9.6, 9.641,0,"I X","APDD", 9.641,.01)
  7128  
  7129   "^DD",9.6, 9.641,0,"N M","DD NUM BER")
  7130  
  7131   "^DD",9.6, 9.641,0,"U P")
  7132   9.64
  7133   "^DD",9.6, 9.641,.01, 0)
  7134   DD NUMBER^ MFX^^0;1^K :X[""""!($ A(X)=45) X  I $D(X) S  X=$$CHKDD ^DIFROMSD( D1,+$G(X), "N") K:X'> 0 X S:$D(X ) DINUM=+X ,X=$P(X,"^ ",2)
  7135   "^DD",9.6, 9.641,.01, 1,0)
  7136   ^.1
  7137   "^DD",9.6, 9.641,.01, 1,1,0)
  7138   9.641^APDD ^MUMPS
  7139   "^DD",9.6, 9.641,.01, 1,1,1)
  7140   S ^XPD(9.6 ,DA(2),4," APDD",DA(1 ),DA)=""
  7141   "^DD",9.6, 9.641,.01, 1,1,2)
  7142   K ^XPD(9.6 ,DA(2),4," APDD",DA(1 ),DA)
  7143   "^DD",9.6, 9.641,.01, 1,1,"%D",0 )
  7144   ^^2^2^2950 117^
  7145   "^DD",9.6, 9.641,.01, 1,1,"%D",1 ,0)
  7146   Used to cr eate an ar ray struct ure contai ning Parti al DDs.  T his array
  7147   "^DD",9.6, 9.641,.01, 1,1,"%D",2 ,0)
  7148   is passed  to FIA^DIF ROMSU as a  list of D D numbers  and fields  to transp ort.
  7149   "^DD",9.6, 9.641,.01, 1,1,"DT")
  7150   2940829
  7151   "^DD",9.6, 9.641,.01, 3)
  7152   Enter a va lid DD num ber for th is file.
  7153   "^DD",9.6, 9.641,.01, 4)
  7154   D DDIOLDD^ DIFROMSD(D 1)
  7155   "^DD",9.6, 9.641,.01, 21,0)
  7156   ^^17^17^29 40903^
  7157   "^DD",9.6, 9.641,.01, 21,1,0)
  7158    
  7159   "^DD",9.6, 9.641,.01, 21,2,0)
  7160   DD NUMBER  pertains t o the file 's number  or any mul tiple fiel d containe d
  7161   "^DD",9.6, 9.641,.01, 21,3,0)
  7162   within the  file.
  7163   "^DD",9.6, 9.641,.01, 21,4,0)
  7164    
  7165   "^DD",9.6, 9.641,.01, 21,5,0)
  7166   This list  starts wit h the file 's top lev el number  followed b y a list o f
  7167   "^DD",9.6, 9.641,.01, 21,6,0)
  7168   multiple f ields cont ained with in the fil e, if any.   These DO  NOT repre sent
  7169   "^DD",9.6, 9.641,.01, 21,7,0)
  7170   Field Numb er(s).
  7171   "^DD",9.6, 9.641,.01, 21,8,0)
  7172    
  7173   "^DD",9.6, 9.641,.01, 21,9,0)
  7174   The nestin g levels a re not rep resented.   All the D D NUMBERs,  file numb er
  7175   "^DD",9.6, 9.641,.01, 21,10,0)
  7176   and multip le fields,  have been  flatten t o a single  list.
  7177   "^DD",9.6, 9.641,.01, 21,11,0)
  7178    
  7179   "^DD",9.6, 9.641,.01, 21,12,0)
  7180   After sele cting a va lid DD NUM BER you wi ll then be  prompted  to select
  7181   "^DD",9.6, 9.641,.01, 21,13,0)
  7182   field numb er(s).
  7183   "^DD",9.6, 9.641,.01, 21,14,0)
  7184    
  7185   "^DD",9.6, 9.641,.01, 21,15,0)
  7186   If a DD NU MBER is se lected and  no fields  are selec ted, KIDS  will send  all
  7187   "^DD",9.6, 9.641,.01, 21,16,0)
  7188   the fields  contained  within, i ncluding m ultiple fi elds below  the selec ted
  7189   "^DD",9.6, 9.641,.01, 21,17,0)
  7190   level.
  7191   "^DD",9.6, 9.641,.01, "DT")
  7192   2940829
  7193   "^DD",9.6, 9.641,.02, 0)
  7194   CHECKSUM^F ^^0;2^K:$L (X)>30!($L (X)<3) X
  7195   "^DD",9.6, 9.641,.02, 3)
  7196   Answer mus t be 3-30  characters  in length .
  7197   "^DD",9.6, 9.641,.02, 21,0)
  7198   ^^1^1^2950 330^
  7199   "^DD",9.6, 9.641,.02, 21,1,0)
  7200   This field  contains  the checks um for thi s subDD
  7201   "^DD",9.6, 9.641,.02, "DT")
  7202   2950330
  7203   "^DD",9.6, 9.641,1,0)
  7204   FIELD NUMB ER^9.6411^ ^1;0
  7205   "^DD",9.6, 9.641,1,"D T")
  7206   2940525
  7207   "^DD",9.6, 9.6411,0)
  7208   FIELD NUMB ER SUB-FIE LD^^.02^2
  7209   "^DD",9.6, 9.6411,0," DT")
  7210   2950330
  7211   "^DD",9.6, 9.6411,0," NM","FIELD  NUMBER")
  7212  
  7213   "^DD",9.6, 9.6411,0," UP")
  7214   9.641
  7215   "^DD",9.6, 9.6411,.01 ,0)
  7216   FIELD NUMB ER^MFX^^0; 1^K:X["""" !($A(X)=45 ) X I $D(X ) S X=$$FL DCHK^DIFRO MSD(D2,+$G (X),"MN")  K:X'>0 X S :$D(X) DIN UM=+X,X=$P (X,"^",2)
  7217   "^DD",9.6, 9.6411,.01 ,1,0)
  7218   ^.1
  7219   "^DD",9.6, 9.6411,.01 ,1,1,0)
  7220   9.64^APDD^ MUMPS
  7221   "^DD",9.6, 9.6411,.01 ,1,1,1)
  7222   S ^XPD(9.6 ,DA(3),4," APDD",DA(2 ),DA(1),DA )=""
  7223   "^DD",9.6, 9.6411,.01 ,1,1,2)
  7224   K ^XPD(9.6 ,DA(3),4," APDD",DA(2 ),DA(1),DA )
  7225   "^DD",9.6, 9.6411,.01 ,1,1,"%D", 0)
  7226   ^^2^2^2950 117^
  7227   "^DD",9.6, 9.6411,.01 ,1,1,"%D", 1,0)
  7228   Used to cr eate an ar ray struct ure contai ning Parti al DDs.  T his array
  7229   "^DD",9.6, 9.6411,.01 ,1,1,"%D", 2,0)
  7230   is passed  to FIA^DIF ROMSU as a  list of D D numbers  and fields  to transp ort.
  7231   "^DD",9.6, 9.6411,.01 ,1,1,"DT")
  7232   2940525
  7233   "^DD",9.6, 9.6411,.01 ,3)
  7234   Enter a va lid field  NUMBER.
  7235   "^DD",9.6, 9.6411,.01 ,4)
  7236   D DDIOLFLD ^DIFROMSD( D2,"M")
  7237   "^DD",9.6, 9.6411,.01 ,21,0)
  7238   ^^13^13^29 40903^
  7239   "^DD",9.6, 9.6411,.01 ,21,1,0)
  7240    
  7241   "^DD",9.6, 9.6411,.01 ,21,2,0)
  7242   Select fie ld(s) to b e sent for  this Part ial Data D ictionary.
  7243   "^DD",9.6, 9.6411,.01 ,21,3,0)
  7244    
  7245   "^DD",9.6, 9.6411,.01 ,21,4,0)
  7246   Only the a ttributes  for the fi eld(s) sel ected are  sent.  Att ributes su ch
  7247   "^DD",9.6, 9.6411,.01 ,21,5,0)
  7248   as identif ers, "ID"  nodes for  a field, a re not sen t when sen ding a
  7249   "^DD",9.6, 9.6411,.01 ,21,6,0)
  7250   partial. S ome attrib utes are c onsidered  file attri butes, suc h as
  7251   "^DD",9.6, 9.6411,.01 ,21,7,0)
  7252   identifier s, and are  only sent  with a Fu ll Data Di ctionary.
  7253   "^DD",9.6, 9.6411,.01 ,21,8,0)
  7254    
  7255   "^DD",9.6, 9.6411,.01 ,21,9,0)
  7256   If the .01  field for  a sub-fil e, multipl e, is sele cted, the  field at t he
  7257   "^DD",9.6, 9.6411,.01 ,21,10,0)
  7258   level abov e, which p oints to t he multipl e, is auto matically  sent.
  7259   "^DD",9.6, 9.6411,.01 ,21,11,0)
  7260    
  7261   "^DD",9.6, 9.6411,.01 ,21,12,0)
  7262   If no fiel d is selec ted, all f ields will  be sent,  as well as  the multi ple
  7263   "^DD",9.6, 9.6411,.01 ,21,13,0)
  7264   fields bel ow this le vel.
  7265   "^DD",9.6, 9.6411,.01 ,"DT")
  7266   2940906
  7267   "^DD",9.6, 9.6411,.02 ,0)
  7268   CHECKSUM^F ^^0;2^K:$L (X)>30!($L (X)<3) X
  7269   "^DD",9.6, 9.6411,.02 ,3)
  7270   Answer mus t be 3-30  characters  in length .
  7271   "^DD",9.6, 9.6411,.02 ,21,0)
  7272   ^^1^1^2950 330^
  7273   "^DD",9.6, 9.6411,.02 ,21,1,0)
  7274   This field  contains  the checks um for thi s field.
  7275   "^DD",9.6, 9.6411,.02 ,"DT")
  7276   2950330
  7277   "^DD",9.6, 9.65,0)
  7278   GLOBAL SUB -FIELD^^1^ 2
  7279   "^DD",9.6, 9.65,0,"DT ")
  7280   2950105
  7281   "^DD",9.6, 9.65,0,"IX ","B",9.65 ,.01)
  7282  
  7283   "^DD",9.6, 9.65,0,"NM ","GLOBAL" )
  7284  
  7285   "^DD",9.6, 9.65,0,"UP ")
  7286   9.6
  7287   "^DD",9.6, 9.65,.01,0 )
  7288   GLOBAL^MFX O^^0;1^D G LOBALE^XPD ET(.X)
  7289   "^DD",9.6, 9.65,.01,1 ,0)
  7290   ^.1
  7291   "^DD",9.6, 9.65,.01,1 ,1,0)
  7292   9.65^B
  7293   "^DD",9.6, 9.65,.01,1 ,1,1)
  7294   S ^XPD(9.6 ,DA(1),"GL O","B",$E( X,1,30),DA )=""
  7295   "^DD",9.6, 9.65,.01,1 ,1,2)
  7296   K ^XPD(9.6 ,DA(1),"GL O","B",$E( X,1,30),DA )
  7297   "^DD",9.6, 9.65,.01,2 )
  7298   S Y(0)=Y S  Y=$TR(Y," '","""")
  7299   "^DD",9.6, 9.65,.01,2 .1)
  7300   S Y=$TR(Y, "'","""")
  7301   "^DD",9.6, 9.65,.01,3 )
  7302   Answer mus t be 2-30  characters  in length  and not b egining wi th "^".
  7303   "^DD",9.6, 9.65,.01,7 .5)
  7304   S X=$TR(X, """","'")
  7305   "^DD",9.6, 9.65,.01,2 1,0)
  7306   ^^2^2^2950 105^^^
  7307   "^DD",9.6, 9.65,.01,2 1,1,0)
  7308   Enter a gl obal name  or a close d global r oot you wa nt to tran sport.
  7309   "^DD",9.6, 9.65,.01,2 1,2,0)
  7310   The global  should no t begin wi th a "^".  i.e.  %ZIS (2).
  7311   "^DD",9.6, 9.65,.01," DT")
  7312   2950106
  7313   "^DD",9.6, 9.65,1,0)
  7314   KILL GLOBA L BEFORE I NSTALL^S^y :YES;n:NO; ^0;2^Q
  7315   "^DD",9.6, 9.65,1,21, 0)
  7316   ^^5^5^2950 105^
  7317   "^DD",9.6, 9.65,1,21, 1,0)
  7318   YES means  that you w ant this g lobal kill ed before  it is inst alled
  7319   "^DD",9.6, 9.65,1,21, 2,0)
  7320   at the ins talling si te.
  7321   "^DD",9.6, 9.65,1,21, 3,0)
  7322    
  7323   "^DD",9.6, 9.65,1,21, 4,0)
  7324   NO means y ou want th is global  install on  top of th e existing  global
  7325   "^DD",9.6, 9.65,1,21, 5,0)
  7326   at the ins talling si te.
  7327   "^DD",9.6, 9.65,1,"DT ")
  7328   2950105
  7329   "^DD",9.6, 9.66,0)
  7330   PACKAGE NA MESPACE OR  PREFIX SU B-FIELD^^1 ^2
  7331   "^DD",9.6, 9.66,0,"DT ")
  7332   2940307
  7333   "^DD",9.6, 9.66,0,"IX ","B",9.66 ,.01)
  7334  
  7335   "^DD",9.6, 9.66,0,"NM ","PACKAGE  NAMESPACE  OR PREFIX ")
  7336  
  7337   "^DD",9.6, 9.66,0,"UP ")
  7338   9.6
  7339   "^DD",9.6, 9.66,.01,0 )
  7340   PACKAGE NA MESPACE OR  PREFIX^MF ^^0;1^K:$L (X)>4!($L( X)<2) X
  7341   "^DD",9.6, 9.66,.01,1 ,0)
  7342   ^.1
  7343   "^DD",9.6, 9.66,.01,1 ,1,0)
  7344   9.66^B
  7345   "^DD",9.6, 9.66,.01,1 ,1,1)
  7346   S ^XPD(9.6 ,DA(1),"AB NS","B",$E (X,1,30),D A)=""
  7347   "^DD",9.6, 9.66,.01,1 ,1,2)
  7348   K ^XPD(9.6 ,DA(1),"AB NS","B",$E (X,1,30),D A)
  7349   "^DD",9.6, 9.66,.01,3 )
  7350   This is (o ne of) the  2 to 4 ch aracter na mespaces o r prefixes  associate d with the  test pack age
  7351   "^DD",9.6, 9.66,.01,2 1,0)
  7352   ^^1^1^2940 307^
  7353   "^DD",9.6, 9.66,.01,2 1,1,0)
  7354   This field  identifie s on of th e alpha/be ta package  namespace s.
  7355   "^DD",9.6, 9.66,.01," DT")
  7356   2940307
  7357   "^DD",9.6, 9.66,1,0)
  7358   EXCLUDE NA MESPACE OR  PREFIX^9. 661A^^1;0
  7359   "^DD",9.6, 9.66,1,21, 0)
  7360   ^^5^5^2940 502^^^
  7361   "^DD",9.6, 9.66,1,21, 1,0)
  7362   This multi ple field  is used to  indicate  any specif ic namespa ces
  7363   "^DD",9.6, 9.66,1,21, 2,0)
  7364   or prefixe s which be gin with t he current  namespace  or prefix
  7365   "^DD",9.6, 9.66,1,21, 3,0)
  7366   which shou ld be excl uded from  analyses f or the alp ha/beta
  7367   "^DD",9.6, 9.66,1,21, 4,0)
  7368   package.   Generally  those name spaces whi ch are imm ediately
  7369   "^DD",9.6, 9.66,1,21, 5,0)
  7370   followed b y the lett er 'Z' are  excluded.
  7371   "^DD",9.6, 9.661,0)
  7372   EXCLUDE NA MESPACE OR  PREFIX SU B-FIELD^^. 01^1
  7373   "^DD",9.6, 9.661,0,"D T")
  7374   2940307
  7375   "^DD",9.6, 9.661,0,"I X","B",9.6 61,.01)
  7376  
  7377   "^DD",9.6, 9.661,0,"N M","EXCLUD E NAMESPAC E OR PREFI X")
  7378  
  7379   "^DD",9.6, 9.661,0,"U P")
  7380   9.66
  7381   "^DD",9.6, 9.661,.01, 0)
  7382   EXCLUDE NA MESPACE OR  PREFIX^MF ^^0;1^K:$L (X)>4!($L( X)<2) X
  7383   "^DD",9.6, 9.661,.01, 1,0)
  7384   ^.1
  7385   "^DD",9.6, 9.661,.01, 1,1,0)
  7386   9.661^B
  7387   "^DD",9.6, 9.661,.01, 1,1,1)
  7388   S ^XPD(9.6 ,DA(2),"AB NS",DA(1), 1,"B",$E(X ,1,30),DA) =""
  7389   "^DD",9.6, 9.661,.01, 1,1,2)
  7390   K ^XPD(9.6 ,DA(2),"AB NS",DA(1), 1,"B",$E(X ,1,30),DA)
  7391   "^DD",9.6, 9.661,.01, 3)
  7392   Answer mus t be 2-4 c haracters  in length.
  7393   "^DD",9.6, 9.661,.01, 21,0)
  7394   ^^4^4^2940 307^
  7395   "^DD",9.6, 9.661,.01, 21,1,0)
  7396   This is a  specific n amespace o r prefix w hich would  normally  be
  7397   "^DD",9.6, 9.661,.01, 21,2,0)
  7398   included a s a part o f the alph a/beta pac kage based  on the
  7399   "^DD",9.6, 9.661,.01, 21,3,0)
  7400   prefix spe cified for  the packa ge, but is  be exclud ed from
  7401   "^DD",9.6, 9.661,.01, 21,4,0)
  7402   considerat ion as par t of the a lpha/beta  package. 
  7403   "^DD",9.6, 9.661,.01, "DT")
  7404   2940307
  7405   "^DD",9.6, 9.67,0)
  7406   BUILD COMP ONENTS SUB -FIELD^^10 ^2
  7407   "^DD",9.6, 9.67,0,"DT ")
  7408   3090520
  7409   "^DD",9.6, 9.67,0,"IX ","B",9.67 ,.01)
  7410  
  7411   "^DD",9.6, 9.67,0,"NM ","BUILD C OMPONENTS" )
  7412  
  7413   "^DD",9.6, 9.67,0,"UP ")
  7414   9.6
  7415   "^DD",9.6, 9.67,.01,0 )
  7416   BUILD COMP ONENT^MP1' XI^DIC(^0; 1^S DINUM= +X K:'$G(X PDNEWF) X, DINUM
  7417   "^DD",9.6, 9.67,.01,1 ,0)
  7418   ^.1
  7419   "^DD",9.6, 9.67,.01,1 ,1,0)
  7420   9.67^B
  7421   "^DD",9.6, 9.67,.01,1 ,1,1)
  7422   S ^XPD(9.6 ,DA(1),"KR N","B",$E( X,1,30),DA )=""
  7423   "^DD",9.6, 9.67,.01,1 ,1,2)
  7424   K ^XPD(9.6 ,DA(1),"KR N","B",$E( X,1,30),DA )
  7425   "^DD",9.6, 9.67,.01,2 1,0)
  7426   ^^2^2^2940 414^
  7427   "^DD",9.6, 9.67,.01,2 1,1,0)
  7428   The name o f a VA Fil eman file  that will  be used as  a compone nt
  7429   "^DD",9.6, 9.67,.01,2 1,2,0)
  7430   of a packa ge.
  7431   "^DD",9.6, 9.67,.01," DT")
  7432   2940815
  7433   "^DD",9.6, 9.67,10,0)
  7434   ENTRIES^9. 68A^^NM;0
  7435   "^DD",9.6, 9.67,10,21 ,0)
  7436   ^^1^1^2940 503^
  7437   "^DD",9.6, 9.67,10,21 ,1,0)
  7438   This multi ple is a l ist of eac h record t hat is bei ng sent fo r a compon ent.
  7439   "^DD",9.6, 9.68,0)
  7440   ENTRIES SU B-FIELD^^. 04^4
  7441   "^DD",9.6, 9.68,0,"DT ")
  7442   3090520
  7443   "^DD",9.6, 9.68,0,"IX ","B",9.68 ,.01)
  7444  
  7445   "^DD",9.6, 9.68,0,"NM ","ENTRIES ")
  7446  
  7447   "^DD",9.6, 9.68,0,"UP ")
  7448   9.67
  7449   "^DD",9.6, 9.68,.01,0 )
  7450   ENTRIES^MF X^^0;1^K:$ L(X)>45!($ L(X)<2) X  I $D(X) D  INPUTE^XPD ET(.X)
  7451   "^DD",9.6, 9.68,.01,1 ,0)
  7452   ^.1
  7453   "^DD",9.6, 9.68,.01,1 ,1,0)
  7454   9.68^B
  7455   "^DD",9.6, 9.68,.01,1 ,1,1)
  7456   S ^XPD(9.6 ,DA(2),"KR N",DA(1)," NM","B",X, DA)=""
  7457   "^DD",9.6, 9.68,.01,1 ,1,2)
  7458   K ^XPD(9.6 ,DA(2),"KR N",DA(1)," NM","B",X, DA)
  7459   "^DD",9.6, 9.68,.01,1 ,2,0)
  7460   ^^TRIGGER^ 9.68^.02
  7461   "^DD",9.6, 9.68,.01,1 ,2,1)
  7462   X ^DD(9.68 ,.01,1,2,1 .3) I X S  X=DIV S Y( 1)=$S($D(^ XPD(9.6,D0 ,"KRN",D1, "NM",D2,0) ):^(0),1:" ") S X=$P( Y(1),U,2), X=X S DIU= X K Y X ^D D(9.68,.01 ,1,2,1.1)  X ^DD(9.68 ,.01,1,2,1 .4)
  7463   "^DD",9.6, 9.68,.01,1 ,2,1.1)
  7464   S X=DIV S  X=DIV,Y(1) =X S X="     FILE #", Y(2)=X S X =2,X=$P(Y( 1),Y(2),X)
  7465   "^DD",9.6, 9.68,.01,1 ,2,1.3)
  7466   K DIV S DI V=X,D0=DA( 2),DIV(0)= D0,D1=DA(1 ),DIV(1)=D 1,D2=DA,DI V(2)=D2 S  Y(0)=X S Y (1)=$S($D( ^XPD(9.6,D 0,"KRN",D1 ,0)):^(0), 1:"") S X= $P(Y(1),U, 1),X=X S X =X<.44
  7467   "^DD",9.6, 9.68,.01,1 ,2,1.4)
  7468   S DIH=$S($ D(^XPD(9.6 ,DIV(0),"K RN",DIV(1) ,"NM",DIV( 2),0)):^(0 ),1:""),DI V=X S $P(^ (0),U,2)=D IV,DIH=9.6 8,DIG=.02  D ^DICR:$O (^DD(DIH,D IG,1,0))>0
  7469   "^DD",9.6, 9.68,.01,1 ,2,2)
  7470   Q
  7471   "^DD",9.6, 9.68,.01,1 ,2,"%D",0)
  7472   ^^2^2^2950 117^
  7473   "^DD",9.6, 9.68,.01,1 ,2,"%D",1, 0)
  7474   This trigg er updates  the FILE  field, #.0 2, with th e appropri ate file n umber
  7475   "^DD",9.6, 9.68,.01,1 ,2,"%D",2, 0)
  7476   for this t emplate. I t is only  triggered  for Filema n template  component s.
  7477   "^DD",9.6, 9.68,.01,1 ,2,"CREATE  CONDITION ")
  7478   INTERNAL(K ERNEL FILE S)<.44
  7479   "^DD",9.6, 9.68,.01,1 ,2,"CREATE  VALUE")
  7480   $P(ENTRIES ,"    FILE  #",2)
  7481   "^DD",9.6, 9.68,.01,1 ,2,"DELETE  VALUE")
  7482   NO EFFECT
  7483   "^DD",9.6, 9.68,.01,1 ,2,"DT")
  7484   2931020
  7485   "^DD",9.6, 9.68,.01,1 ,2,"FIELD" )
  7486   FILE
  7487   "^DD",9.6, 9.68,.01,3 )
  7488   Answer mus t be 3-45  characters  in length .
  7489   "^DD",9.6, 9.68,.01,4 )
  7490   D HELP^XPD ET
  7491   "^DD",9.6, 9.68,.01,7 .5)
  7492   D LOOKE^XP DET(.X)
  7493   "^DD",9.6, 9.68,.01,2 1,0)
  7494   ^^4^4^2950 214^^^^
  7495   "^DD",9.6, 9.68,.01,2 1,1,0)
  7496   The name o f the comp onent bein g sent.  T he compone nt must ex ist in
  7497   "^DD",9.6, 9.68,.01,2 1,2,0)
  7498   the pointe d-to file.   You can  use '*' as  a wild ca rd charact er, 
  7499   "^DD",9.6, 9.68,.01,2 1,3,0)
  7500   i.e.  XUS*  means all  component s begining  with XUS.
  7501   "^DD",9.6, 9.68,.01,2 1,4,0)
  7502   You can al so preceed  the compo nent with  '-' to del ete it fro m the list .
  7503   "^DD",9.6, 9.68,.01," DT")
  7504   2940517
  7505   "^DD",9.6, 9.68,.02,0 )
  7506   FILE^RP1'^ DIC(^0;2^Q
  7507   "^DD",9.6, 9.68,.02,5 ,1,0)
  7508   9.68^.01^2
  7509   "^DD",9.6, 9.68,.02,9 )
  7510   ^
  7511   "^DD",9.6, 9.68,.02,2 1,0)
  7512   ^^1^1^2931 020^
  7513   "^DD",9.6, 9.68,.02,2 1,1,0)
  7514   The Filema n file for  this Entr y.
  7515   "^DD",9.6, 9.68,.02," DT")
  7516   2931020
  7517   "^DD",9.6, 9.68,.03,0 )
  7518   ACTION^R*S ^0:SEND TO  SITE;1:DE LETE AT SI TE;2:USE A S LINK FOR  MENU/ITEM /SUBSCRIBE RS;3:MERGE  MENU ITEM S;4:ATTACH  TO MENU;5 :DISABLE D URING INST ALL;^0;3^Q
  7519   "^DD",9.6, 9.68,.03,1 2)
  7520   Enter a nu mber
  7521   "^DD",9.6, 9.68,.03,1 2.1)
  7522   S DIC("S") ="I $$SCRA ^XPDET(Y)"
  7523   "^DD",9.6, 9.68,.03,2 1,0)
  7524   ^^2^2^2970 121^^^
  7525   "^DD",9.6, 9.68,.03,2 1,1,0)
  7526   This is th e action y ou want pe rformed at  the insta lling site  on
  7527   "^DD",9.6, 9.68,.03,2 1,2,0)
  7528   the entry  of the com ponent you  are sendi ng for thi s package.
  7529   "^DD",9.6, 9.68,.03," DT")
  7530   3090520
  7531   "^DD",9.6, 9.68,.04,0 )
  7532   CHECKSUM^F ^^0;4^K:$L (X)>30!($L (X)<3) X
  7533   "^DD",9.6, 9.68,.04,3 )
  7534   Answer mus t be 3-30  characters  in length .
  7535   "^DD",9.6, 9.68,.04,2 1,0)
  7536   ^^1^1^2950 330^
  7537   "^DD",9.6, 9.68,.04,2 1,1,0)
  7538   This field  contains  the checks um for thi s componen t.
  7539   "^DD",9.6, 9.68,.04," DT")
  7540   2950330
  7541   "^DD",19,1 9,82,0)
  7542   DIQ(0)^S^C :Computed  Fields;R:R ecord Numb er (IEN);B :Both Comp uted Field s and Reco rd Number  (IEN);^82; E1,245^Q
  7543   "^DD",19,1 9,82,3)
  7544   Select the  code to h andle disp laying Com puted Fiel ds and Rec ord Number  (IEN).
  7545   "^DD",19,1 9,82,21,0)
  7546   ^.001^2^2^ 3170727^^^
  7547   "^DD",19,1 9,82,21,1, 0)
  7548   This field  detemines  if you wa nt Compute d Fields a nd Record  Number (IE N) display ed with ea ch record.
  7549   "^DD",19,1 9,82,21,2, 0)
  7550   Leave this  field bla nk if you  don't want  Record Nu mber or Co mputed Fie lds displa yed.
  7551   "^DD",19,1 9,82,"DT")
  7552   3170727
  7553   "^DIC",9.6 ,9.6,0)
  7554   BUILD^9.6
  7555   "^DIC",9.6 ,9.6,0,"GL ")
  7556   ^XPD(9.6,
  7557   "^DIC",9.6 ,9.6,"%D", 0)
  7558   ^^4^4^2981 028^^^^
  7559   "^DIC",9.6 ,9.6,"%D", 1,0)
  7560   This file  identifies  the eleme nts of a p ackage tha t will be  transporte d
  7561   "^DIC",9.6 ,9.6,"%D", 2,0)
  7562   by the Ker nel Instal lation & D istributio n System.   All compo nents of t he
  7563   "^DIC",9.6 ,9.6,"%D", 3,0)
  7564   package, i .e. templa tes, optio ns, Securi ty Keys, e tc., must  be listed  in 
  7565   "^DIC",9.6 ,9.6,"%D", 4,0)
  7566   in this fi le.
  7567   "^DIC",9.6 ,"B","BUIL D",9.6)
  7568  
  7569   **END**
  7570   **END**