2. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 5/7/2018 12:07:09 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.

2.1 Files compared

# Location File Last Modified
1 iter_1_build_2.zip\iter_1_build_2\DG_53_952_B2S1_V7.zip DG_53_952_B2S1_V7.KID Tue Mar 20 23:14:26 2018 UTC
2 iter_1_build_2.zip\iter_1_build_2\DG_53_952_B2S1_V7.zip DG_53_952_B2S1_V7.KID Thu May 3 15:08:55 2018 UTC

2.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 4690
Changed 1 2
Inserted 0 0
Removed 0 0

2.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

2.4 Active regular expressions

No regular expressions were active.

2.5 Comparison detail

  1   KIDS Distr ibution sa ved on Mar  20, 2018@ 13:59:38
  2   the patch  DG*5.3*952  TEST V7,  version: b uild 2, sp rint 1
  3   **KIDS**:D G*5.3*952^
  4  
  5   **INSTALL  NAME**
  6   DG*5.3*952
  7   "BLD",1051 6,0)
  8   DG*5.3*952 ^REGISTRAT ION^0^3180 320^y
  9   "BLD",1051 6,1,0)
  10   ^^4^4^3180 306^^^
  11   "BLD",1051 6,1,1,0)
  12   This patch  implement s the "OTH ER THAN HO NORABLE" a s a new se condary
  13   "BLD",1051 6,1,2,0)
  14   eligibilit y code for  patient r egistratio n. It is u sed to ide ntify and
  15   "BLD",1051 6,1,3,0)
  16   track "oth er than ho norably di scharged"  service me mbers for  emergency
  17   "BLD",1051 6,1,4,0)
  18   mental hea lth servic es in the  VA.
  19   "BLD",1051 6,4,0)
  20   ^9.64PA^33 ^3
  21   "BLD",1051 6,4,8,0)
  22   8
  23   "BLD",1051 6,4,8,2,0)
  24   ^9.641^8^1
  25   "BLD",1051 6,4,8,2,8, 0)
  26   ELIGIBILIT Y CODE  (F ile-top le vel)
  27   "BLD",1051 6,4,8,2,8, 1,0)
  28   ^9.6411^12 ^1
  29   "BLD",1051 6,4,8,2,8, 1,12,0)
  30   ADDITIONAL  ONLY
  31   "BLD",1051 6,4,8,222)
  32   y^n^p^^^^n ^^n
  33   "BLD",1051 6,4,8,224)
  34  
  35   "BLD",1051 6,4,8.1,0)
  36   8.1
  37   "BLD",1051 6,4,8.1,22 2)
  38   y^n^f^^n^^ y^o^n
  39   "BLD",1051 6,4,33,0)
  40   33
  41   "BLD",1051 6,4,33,222 )
  42   y^y^f^^^^n
  43   "BLD",1051 6,4,"APDD" ,8,8)
  44  
  45   "BLD",1051 6,4,"APDD" ,8,8,12)
  46  
  47   "BLD",1051 6,4,"B",8, 8)
  48  
  49   "BLD",1051 6,4,"B",8. 1,8.1)
  50  
  51   "BLD",1051 6,4,"B",33 ,33)
  52  
  53   "BLD",1051 6,6)
  54   7^
  55   "BLD",1051 6,6.3)
  56   30
  57   "BLD",1051 6,"INIT")
  58   EN^DG53P95 2
  59   "BLD",1051 6,"KRN",0)
  60   ^9.67PA^77 9.2^20
  61   "BLD",1051 6,"KRN",.4 ,0)
  62   .4
  63   "BLD",1051 6,"KRN",.4 01,0)
  64   .401
  65   "BLD",1051 6,"KRN",.4 02,0)
  66   .402
  67   "BLD",1051 6,"KRN",.4 02,"NM",0)
  68   ^9.68A^1^1
  69   "BLD",1051 6,"KRN",.4 02,"NM",1, 0)
  70   DG LOAD ED IT SCREEN  7    FILE  #2^2^0
  71   "BLD",1051 6,"KRN",.4 02,"NM","B ","DG LOAD  EDIT SCRE EN 7    FI LE #2",1)
  72  
  73   "BLD",1051 6,"KRN",.4 03,0)
  74   .403
  75   "BLD",1051 6,"KRN",.5 ,0)
  76   .5
  77   "BLD",1051 6,"KRN",.8 4,0)
  78   .84
  79   "BLD",1051 6,"KRN",3. 6,0)
  80   3.6
  81   "BLD",1051 6,"KRN",3. 8,0)
  82   3.8
  83   "BLD",1051 6,"KRN",9. 2,0)
  84   9.2
  85   "BLD",1051 6,"KRN",9. 8,0)
  86   9.8
  87   "BLD",1051 6,"KRN",9. 8,"NM",0)
  88   ^9.68A^6^5
  89   "BLD",1051 6,"KRN",9. 8,"NM",1,0 )
  90   DG53P952^^ 0^B7766572
  91   "BLD",1051 6,"KRN",9. 8,"NM",2,0 )
  92   DGOTHD^^0^ B57301824
  93   "BLD",1051 6,"KRN",9. 8,"NM",4,0 )
  94   DGOTHD1^^0 ^B2570530
  95   "BLD",1051 6,"KRN",9. 8,"NM",5,0 )
  96   DGOTHD2^^0 ^B28792989
  97   "BLD",1051 6,"KRN",9. 8,"NM",6,0 )
  98   DGLOCK1^^0 ^B21612457
  99   "BLD",1051 6,"KRN",9. 8,"NM","B" ,"DG53P952 ",1)
  100  
  101   "BLD",1051 6,"KRN",9. 8,"NM","B" ,"DGLOCK1" ,6)
  102  
  103   "BLD",1051 6,"KRN",9. 8,"NM","B" ,"DGOTHD", 2)
  104  
  105   "BLD",1051 6,"KRN",9. 8,"NM","B" ,"DGOTHD1" ,4)
  106  
  107   "BLD",1051 6,"KRN",9. 8,"NM","B" ,"DGOTHD2" ,5)
  108  
  109   "BLD",1051 6,"KRN",19 ,0)
  110   19
  111   "BLD",1051 6,"KRN",19 ,"NM",0)
  112   ^9.68A^3^3
  113   "BLD",1051 6,"KRN",19 ,"NM",1,0)
  114   DG REGISTR ATION MENU ^^2
  115   "BLD",1051 6,"KRN",19 ,"NM",2,0)
  116   DG OTH MEN U^^0
  117   "BLD",1051 6,"KRN",19 ,"NM",3,0)
  118   DG OTH AUT HORIZE 2ND  90 DAYS^^ 0
  119   "BLD",1051 6,"KRN",19 ,"NM","B", "DG OTH AU THORIZE 2N D 90 DAYS" ,3)
  120  
  121   "BLD",1051 6,"KRN",19 ,"NM","B", "DG OTH ME NU",2)
  122  
  123   "BLD",1051 6,"KRN",19 ,"NM","B", "DG REGIST RATION MEN U",1)
  124  
  125   "BLD",1051 6,"KRN",19 .1,0)
  126   19.1
  127   "BLD",1051 6,"KRN",10 1,0)
  128   101
  129   "BLD",1051 6,"KRN",40 9.61,0)
  130   409.61
  131   "BLD",1051 6,"KRN",77 1,0)
  132   771
  133   "BLD",1051 6,"KRN",77 9.2,0)
  134   779.2
  135   "BLD",1051 6,"KRN",87 0,0)
  136   870
  137   "BLD",1051 6,"KRN",89 89.51,0)
  138   8989.51
  139   "BLD",1051 6,"KRN",89 89.52,0)
  140   8989.52
  141   "BLD",1051 6,"KRN",89 94,0)
  142   8994
  143   "BLD",1051 6,"KRN","B ",.4,.4)
  144  
  145   "BLD",1051 6,"KRN","B ",.401,.40 1)
  146  
  147   "BLD",1051 6,"KRN","B ",.402,.40 2)
  148  
  149   "BLD",1051 6,"KRN","B ",.403,.40 3)
  150  
  151   "BLD",1051 6,"KRN","B ",.5,.5)
  152  
  153   "BLD",1051 6,"KRN","B ",.84,.84)
  154  
  155   "BLD",1051 6,"KRN","B ",3.6,3.6)
  156  
  157   "BLD",1051 6,"KRN","B ",3.8,3.8)
  158  
  159   "BLD",1051 6,"KRN","B ",9.2,9.2)
  160  
  161   "BLD",1051 6,"KRN","B ",9.8,9.8)
  162  
  163   "BLD",1051 6,"KRN","B ",19,19)
  164  
  165   "BLD",1051 6,"KRN","B ",19.1,19. 1)
  166  
  167   "BLD",1051 6,"KRN","B ",101,101)
  168  
  169   "BLD",1051 6,"KRN","B ",409.61,4 09.61)
  170  
  171   "BLD",1051 6,"KRN","B ",771,771)
  172  
  173   "BLD",1051 6,"KRN","B ",779.2,77 9.2)
  174  
  175   "BLD",1051 6,"KRN","B ",870,870)
  176  
  177   "BLD",1051 6,"KRN","B ",8989.51, 8989.51)
  178  
  179   "BLD",1051 6,"KRN","B ",8989.52, 8989.52)
  180  
  181   "BLD",1051 6,"KRN","B ",8994,899 4)
  182  
  183   "BLD",1051 6,"QUES",0 )
  184   ^9.62^^
  185   "BLD",1051 6,"REQB",0 )
  186   ^9.611^1^1
  187   "BLD",1051 6,"REQB",1 ,0)
  188   DG*5.3*314 ^2
  189   "BLD",1051 6,"REQB"," B","DG*5.3 *314",1)
  190  
  191   "DATA",8.1 ,1,0)
  192   SERVICE CO NNECTED 50 % to 100%^ P^SC 1^1^Y ^SC, 50% T O 100%^^0
  193   "DATA",8.1 ,2,0)
  194   AID & ATTE NDANCE^B^A A^2^Y^AID  & ATTENDAN CE^^1
  195   "DATA",8.1 ,3,0)
  196   SC LESS TH AN 50%^P^S C 3^3^Y^SC , LESS THA N 50%^^0
  197   "DATA",8.1 ,4,0)
  198   NSC, VA PE NSION^B^^4 ^Y^NSC, VA  PENSION^^ 1
  199   "DATA",8.1 ,5,0)
  200   NSC^B^^5^Y ^NON-SERVI CE CONNECT ED^^0
  201   "DATA",8.1 ,6,0)
  202   OTHER FEDE RAL AGENCY ^R^^4^N^OT HER FEDERA L AGENCY^^ 1
  203   "DATA",8.1 ,7,0)
  204   ALLIED VET ERAN^R^^5^ N^ALLIED V ETERAN^^1
  205   "DATA",8.1 ,8,0)
  206   HUMANITARI AN EMERGEN CY^R^^6^N^ HUMANITARI AN EMERGEN CY^^1
  207   "DATA",8.1 ,9,0)
  208   SHARING AG REEMENT^R^ ^7^N^SHARI NG AGREEME NT^^1
  209   "DATA",8.1 ,10,0)
  210   REIMBURSAB LE INSURAN CE^R^^8^N^ REIMBURSAB LE INSURAN CE^1^1
  211   "DATA",8.1 ,11,0)
  212   DOM. PATIE NT^B^^6^Y^ DOMICILIAR Y PATIENT^ 1^0
  213   "DATA",8.1 ,12,0)
  214   CHAMPVA^R^ ^1^N^CHAMP VA^^1
  215   "DATA",8.1 ,13,0)
  216   COLLATERAL  OF VET.^R ^^2^N^COLL ATERAL OF  VETERAN^^1
  217   "DATA",8.1 ,14,0)
  218   EMPLOYEE^R ^^3^N^EMPL OYEE^^1
  219   "DATA",8.1 ,15,0)
  220   HOUSEBOUND ^B^HB^2^Y^ HOUSEBOUND ^^1
  221   "DATA",8.1 ,16,0)
  222   MEXICAN BO RDER WAR^B ^MB^2^Y^ME XICAN BORD ER WAR^1^1
  223   "DATA",8.1 ,17,0)
  224   WORLD WAR  I^B^WWI^2^ Y^WORLD WA R I^^1
  225   "DATA",8.1 ,18,0)
  226   PRISONER O F WAR^B^PO W^2^Y^PRIS ONER OF WA R^^1
  227   "DATA",8.1 ,19,0)
  228   TRICARE^R^ TRI^7^N^TR ICARE^^1
  229   "DATA",8.1 ,20,0)
  230   MEDICARE^R ^MEDI^9^N^ MEDICARE^1 ^1
  231   "DATA",8.1 ,21,0)
  232   CATASTROPH ICALLY DIS ABLED^B^CD ^10^Y^CATA STROP. DIS AB.^1^1
  233   "DATA",8.1 ,22,0)
  234   PURPLE HEA RT RECIPIE NT^B^PH^2^ Y^PURPLE H EART RECIP IENT^^1
  235   "DATA",8.1 ,23,0)
  236   OTHER THAN  HONORABLE ^R^OTH^6^N ^OTHER THA N HONORABL E^^1
  237   "FIA",8)
  238   ELIGIBILIT Y CODE
  239   "FIA",8,0)
  240   ^DIC(8,
  241   "FIA",8,0, 0)
  242   8I
  243   "FIA",8,0, 1)
  244   y^n^p^^^^n ^^n
  245   "FIA",8,0, 10)
  246  
  247   "FIA",8,0, 11)
  248  
  249   "FIA",8,0, "RLRO")
  250  
  251   "FIA",8,0, "VR")
  252   5.3^DG
  253   "FIA",8,8)
  254   1
  255   "FIA",8,8, 12)
  256  
  257   "FIA",8.1)
  258   MAS ELIGIB ILITY CODE
  259   "FIA",8.1, 0)
  260   ^DIC(8.1,
  261   "FIA",8.1, 0,0)
  262   8.1I
  263   "FIA",8.1, 0,1)
  264   y^n^f^^n^^ y^o^n
  265   "FIA",8.1, 0,10)
  266  
  267   "FIA",8.1, 0,11)
  268  
  269   "FIA",8.1, 0,"RLRO")
  270  
  271   "FIA",8.1, 0,"VR")
  272   5.3^DG
  273   "FIA",8.1, 8.1)
  274   0
  275   "FIA",33)
  276   OTH ELIGIB ILITY CLOC K
  277   "FIA",33,0 )
  278   ^DGOTH(33,
  279   "FIA",33,0 ,0)
  280   33P
  281   "FIA",33,0 ,1)
  282   y^y^f^^^^n
  283   "FIA",33,0 ,10)
  284  
  285   "FIA",33,0 ,11)
  286  
  287   "FIA",33,0 ,"RLRO")
  288  
  289   "FIA",33,0 ,"VR")
  290   5.3^DG
  291   "FIA",33,3 3)
  292   0
  293   "FIA",33,3 3.01)
  294   0
  295   "FIA",33,3 3.11)
  296   0
  297   "INIT")
  298   EN^DG53P95 2
  299   "KRN",.402 ,1248,-1)
  300   0^1
  301   "KRN",.402 ,1248,0)
  302   DG LOAD ED IT SCREEN  7^3180212. 1919^^2^^^ 3180316
  303   "KRN",.402 ,1248,"%D" ,0)
  304   ^.4021^1^1 ^3110428^^ ^^
  305   "KRN",.402 ,1248,"%D" ,1,0)
  306   This templ ate is use d to enter /edit data  on regist ration scr een 7.
  307   "KRN",.402 ,1248,"DIA B",1,1,2.0 5,0)
  308   ALL
  309   "KRN",.402 ,1248,"DIA B",6,0,2,2 )
  310   PENSION AW ARD EFFECT IVE DATE// /"@"
  311   "KRN",.402 ,1248,"DIA B",7,0,2,4 )
  312   PENSION AW ARD REASON ///"@"
  313   "KRN",.402 ,1248,"DIA B",8,0,2,2 )
  314   PENSION AW ARD REASON ///"@"
  315   "KRN",.402 ,1248,"DR" ,1,2)
  316   S:DGDR'["7 01" Y="@70 2";391;D S C7^DGRPV;1 901;.301;S :X'="Y" Y= .293;.302; .3012;.305 ;I $P($G(^ DPT(DFN,.3 61)),U)="V " I $P($G( ^DPT(DFN,. 361)),U,3) ="H" S Y=" @293";.304 ;S:X'="Y"  Y=.293;.30 13;S Y=.29 3;@293;
  317   "KRN",.402 ,1248,"DR" ,1,2,1)
  318   W !,"No ed iting P&T  Data, Elig ibility re cord verif ied by HEC ";.293;S:' X Y=.313;. 292;.291;. 313;.314;@ 702;S:DGDR '["702" Y= "@703";.36 205;.36215 ;S:$P($G(^ DPT(DFN,.3 85)),U,11) ="Y" Y="@7 025";
  319   "KRN",.402 ,1248,"DR" ,1,2,2)
  320   S:($P($G(^ DPT(DFN,.3 85)),U,10) ="Y")&($P( $G(^DPT(DF N,.362)),U ,14)="N")  Y="@7025"; S:$P($G(^D PT(DFN,.38 5)),U,10)= "Y" Y="@70 22";.36235 ;I X="Y" S  Y="@7022" ;Q;.3851// /^S X="@"; Q;.3852/// ^S X="@";S  Y="@7026" ;@7022;
  321   "KRN",.402 ,1248,"DR" ,1,2,3)
  322   S:($P($G(^ DPT(DFN,.3 85)),U,10) '="Y") Y=" @7023";D E N^DDIOL("P ension Awa rd Date an d Pension  Award Reas on are edi table only  if VA Pen sion",""," !!");
  323   "KRN",.402 ,1248,"DR" ,1,2,4)
  324   D EN^DDIOL ("Indicato r is Yes a nd Pension  Award Rea son is not  'Original  Award'.   For any"," ","!");D E N^DDIOL("o ther assis tance, use  the HEC A lert proce ss.","","! ");@7023;. 3851;I X]" " S Y="@70 24";Q;.385 2///^S X=" @";S Y="@7 026";@7024 ;
  325   "KRN",.402 ,1248,"DR" ,1,2,5)
  326   .3852;I X= "" S Y="@7 026";I X=$ $GET1^DIQ( 2,DFN,.385 2,"I") S Y ="@7026";I  $$GET1^DI Q(27.18,X, .01,"E")'[ "Original  Award" D E N^DDIOL("O nly 'Origi nal Award'  may be en tered",,"! !") S Y="@ 7024";S Y= "@7026";@7 025;
  327   "KRN",.402 ,1248,"DR" ,1,2,6)
  328   D EN^DDIOL ("Pension  Award Date  and Pensi on Award R eason are  editable o nly if VA  Pension"," ","!!");D  EN^DDIOL(" Indicator  is Yes and  Pension A ward Reaso n is not ' Original A ward'.  Fo r any","", "!");
  329   "KRN",.402 ,1248,"DR" ,1,2,7)
  330   D EN^DDIOL ("other as sistance,  use the HE C Alert pr ocess.","" ,"!");@702 6;.3025;S: (X'="Y")&( $P($G(^DPT (DA,.362)) ,U,12,14)' ["Y") Y=.3 6265;.3629 5;.36265;S :X'="Y" Y= "@703";.36 26;@703;S: DGDR'["703 " Y="@704" ;.361;
  331   "KRN",.402 ,1248,"DR" ,1,2,8)
  332   D AAC1^DGL OCK2 S:DGA AC(1)']""  Y=361;.309 ;361;D STR DATE^DGOTH D(DFN);.32 3;D ^DGYZO DS S:'DGOD S Y="@704" ;11500.02; 11500.03;@ 704;S:DGDR '["704" Y= "@99";.373 1;@99;
  333   "KRN",.402 ,1248,"DR" ,2,2.0361)
  334   .01;
  335   "KRN",.402 ,1248,"DR" ,2,2.05)
  336   .01:.02
  337   "KRN",.402 ,1248,"ROU ")
  338   ^DGRPX7
  339   "KRN",.402 ,1248,"ROU OLD")
  340   DGRPX7
  341   "KRN",19,1 61,-1)
  342   2^1
  343   "KRN",19,1 61,0)
  344   DG REGISTR ATION MENU ^Registrat ion Menu^^ M^.5^^^^^^ ^5^^1^1
  345   "KRN",19,1 61,10,0)
  346   ^19.01IP^4 0^40
  347   "KRN",19,1 61,10,40,0 )
  348   2921981^OT H
  349   "KRN",19,1 61,10,40," ^")
  350   DG OTH MEN U
  351   "KRN",19,1 61,"U")
  352   REGISTRATI ON MENU
  353   "KRN",19,2 921981,-1)
  354   0^2
  355   "KRN",19,2 921981,0)
  356   DG OTH MEN U^Other Th an Honorab le Patient s Menu^^M^ ^^^^^^^
  357   "KRN",19,2 921981,1,0 )
  358   ^19.06^2^2 ^3180213^^ ^
  359   "KRN",19,2 921981,1,1 ,0)
  360   This menu  contains o ptions to  manage Oth er Than Ho norable st atus for
  361   "KRN",19,2 921981,1,2 ,0)
  362   patients.
  363   "KRN",19,2 921981,10, 0)
  364   ^19.01IP^1 ^1
  365   "KRN",19,2 921981,10, 1,0)
  366   2921982^AU TH
  367   "KRN",19,2 921981,10, 1,"^")
  368   DG OTH AUT HORIZE 2ND  90 DAYS
  369   "KRN",19,2 921981,99)
  370   64716,4777 8
  371   "KRN",19,2 921981,"U" )
  372   OTHER THAN  HONORABLE  PATIENTS 
  373   "KRN",19,2 921982,-1)
  374   0^3
  375   "KRN",19,2 921982,0)
  376   DG OTH AUT HORIZE 2ND  90 DAYS^A uthorize t he 2nd 90  days perio d^^R^^^^^^ ^^
  377   "KRN",19,2 921982,1,0 )
  378   ^^2^2^3180 213^
  379   "KRN",19,2 921982,1,1 ,0)
  380   This menu  option is  used autho rize the 2 nd 90 days  period fo r the 
  381   "KRN",19,2 921982,1,2 ,0)
  382   selected p atient.
  383   "KRN",19,2 921982,25)
  384   AUTH90DS^D GOTHD
  385   "KRN",19,2 921982,"U" )
  386   AUTHORIZE  THE 2ND 90  DAYS PERI
  387   "MBREQ")
  388   0
  389   "ORD",7,.4 02)
  390   .402;7;;;E DEOUT^DIFR OMSO(.402, DA,"",XPDA );FPRE^DIF ROMSI(.402 ,"",XPDA); EPRE^DIFRO MSI(.402,D A,$E("N",$ G(XPDNEW)) ,XPDA,"",O LDA);;EPOS T^DIFROMSI (.402,DA," ",XPDA);DE L^DIFROMSK (.402,"",% )
  391   "ORD",7,.4 02,0)
  392   INPUT TEMP LATE
  393   "ORD",18,1 9)
  394   19;18;;;OP T^XPDTA;OP TF1^XPDIA; OPTE1^XPDI A;OPTF2^XP DIA;;OPTDE L^XPDIA
  395   "ORD",18,1 9,0)
  396   OPTION
  397   "PKG",5,-1 )
  398   1^1
  399   "PKG",5,0)
  400   REGISTRATI ON^DG^PATI ENT REGIST RATION, AD MISSION, D ISCHARGE,  EMBOSSER 
  401   "PKG",5,22 ,0)
  402   ^9.49I^1^1
  403   "PKG",5,22 ,1,0)
  404   5.3^293081 3^2930930
  405   "PKG",5,22 ,1,"PAH",1 ,0)
  406   952^318032 0^52082465 5
  407   "PKG",5,22 ,1,"PAH",1 ,1,0)
  408   ^^4^4^3180 320
  409   "PKG",5,22 ,1,"PAH",1 ,1,1,0)
  410   This patch  implement s the "OTH ER THAN HO NORABLE" a s a new se condary
  411   "PKG",5,22 ,1,"PAH",1 ,1,2,0)
  412   eligibilit y code for  patient r egistratio n. It is u sed to ide ntify and
  413   "PKG",5,22 ,1,"PAH",1 ,1,3,0)
  414   track "oth er than ho norably di scharged"  service me mbers for  emergency
  415   "PKG",5,22 ,1,"PAH",1 ,1,4,0)
  416   mental hea lth servic es in the  VA.
  417   "QUES","XP F1",0)
  418   Y
  419   "QUES","XP F1","??")
  420   ^D REP^XPD H
  421   "QUES","XP F1","A")
  422   Shall I wr ite over y our |FLAG|  File
  423   "QUES","XP F1","B")
  424   YES
  425   "QUES","XP F1","M")
  426   D XPF1^XPD IQ
  427   "QUES","XP F2",0)
  428   Y
  429   "QUES","XP F2","??")
  430   ^D DTA^XPD H
  431   "QUES","XP F2","A")
  432   Want my da ta |FLAG|  yours
  433   "QUES","XP F2","B")
  434   YES
  435   "QUES","XP F2","M")
  436   D XPF2^XPD IQ
  437   "QUES","XP I1",0)
  438   YO
  439   "QUES","XP I1","??")
  440   ^D INHIBIT ^XPDH
  441   "QUES","XP I1","A")
  442   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  443   "QUES","XP I1","B")
  444   NO
  445   "QUES","XP I1","M")
  446   D XPI1^XPD IQ
  447   "QUES","XP M1",0)
  448   PO^VA(200, :EM
  449   "QUES","XP M1","??")
  450   ^D MG^XPDH
  451   "QUES","XP M1","A")
  452   Enter the  Coordinato r for Mail  Group '|F LAG|'
  453   "QUES","XP M1","B")
  454  
  455   "QUES","XP M1","M")
  456   D XPM1^XPD IQ
  457   "QUES","XP O1",0)
  458   Y
  459   "QUES","XP O1","??")
  460   ^D MENU^XP DH
  461   "QUES","XP O1","A")
  462   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  463   "QUES","XP O1","B")
  464   NO
  465   "QUES","XP O1","M")
  466   D XPO1^XPD IQ
  467   "QUES","XP Z1",0)
  468   Y
  469   "QUES","XP Z1","??")
  470   ^D OPT^XPD H
  471   "QUES","XP Z1","A")
  472   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  473   "QUES","XP Z1","B")
  474   NO
  475   "QUES","XP Z1","M")
  476   D XPZ1^XPD IQ
  477   "QUES","XP Z2",0)
  478   Y
  479   "QUES","XP Z2","??")
  480   ^D RTN^XPD H
  481   "QUES","XP Z2","A")
  482   Want to MO VE routine s to other  CPUs
  483   "QUES","XP Z2","B")
  484   NO
  485   "QUES","XP Z2","M")
  486   D XPZ2^XPD IQ
  487   "RTN")
  488   5
  489   "RTN","DG5 3P952")
  490   0^1^B77665 72
  491   "RTN","DG5 3P952",1,0 )
  492   DG53P952 ; SLC/SS - P OST-INIT ; 12/05/17
  493   "RTN","DG5 3P952",2,0 )
  494    ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 30
  495   "RTN","DG5 3P952",3,0 )
  496    ;
  497   "RTN","DG5 3P952",4,0 )
  498    ;DG*5.3*9 52 post -  install en try point
  499   "RTN","DG5 3P952",5,0 )
  500    ;
  501   "RTN","DG5 3P952",6,0 )
  502    ;ICRs Use d:
  503   "RTN","DG5 3P952",7,0 )
  504    ;DBIA #10 141 XPDUTL
  505   "RTN","DG5 3P952",8,0 )
  506    ;DBIA #20 53 Data Ba se Server  API: Editi ng Utiliti es
  507   "RTN","DG5 3P952",9,0 )
  508   EN ;
  509   "RTN","DG5 3P952",10, 0)
  510    ;skip add ing the ne w eligibil ity to the  file  #8  if it is a lready the re
  511   "RTN","DG5 3P952",11, 0)
  512    I $O(^DIC (8,"B","OT HER THAN H ONORABLE", 0))>0 D  Q
  513   "RTN","DG5 3P952",12, 0)
  514    .D BMES^X PDUTL("The  OTHER THA N HONORABL E already  exists in  the file # 8 - ")
  515   "RTN","DG5 3P952",13, 0)
  516    .D MES^XP DUTL("  sk ip adding  OTHER THAN  HONORABLE  eligibili ty to the  file #8.")
  517   "RTN","DG5 3P952",14, 0)
  518    ;
  519   "RTN","DG5 3P952",15, 0)
  520    ;otherwis e add the  new eligib ility to t he file #8
  521   "RTN","DG5 3P952",16, 0)
  522    N DGVALS, DGIEN
  523   "RTN","DG5 3P952",17, 0)
  524    D BMES^XP DUTL("Addi ng OTHER T HAN HONORA BLE eligib ility entr y to the f ile #8")
  525   "RTN","DG5 3P952",18, 0)
  526    S DGVALS( .01)="OTHE R THAN HON ORABLE"
  527   "RTN","DG5 3P952",19, 0)
  528    S DGVALS( 1)="RED"
  529   "RTN","DG5 3P952",20, 0)
  530    S DGVALS( 2)="OTH"
  531   "RTN","DG5 3P952",21, 0)
  532    S DGVALS( 3)=6
  533   "RTN","DG5 3P952",22, 0)
  534    S DGVALS( 4)="N"
  535   "RTN","DG5 3P952",23, 0)
  536    S DGVALS( 5)="OTHER  THAN HONOR ABLE"
  537   "RTN","DG5 3P952",24, 0)
  538    S DGVALS( 7)=1
  539   "RTN","DG5 3P952",25, 0)
  540    S DGVALS( 8)="OTHER  THAN HONOR ABLE"
  541   "RTN","DG5 3P952",26, 0)
  542    S DGVALS( 9)="VA STA NDARD"
  543   "RTN","DG5 3P952",27, 0)
  544    S DGVALS( 11)="VA"
  545   "RTN","DG5 3P952",28, 0)
  546    S DGVALS( 12)="YES"
  547   "RTN","DG5 3P952",29, 0)
  548    S DGIEN=$ $INSREC(8, "",.DGVALS ,,"E",,,1)
  549   "RTN","DG5 3P952",30, 0)
  550    I DGIEN<0  D
  551   "RTN","DG5 3P952",31, 0)
  552    . D BMES^ XPDUTL("Er ror:")
  553   "RTN","DG5 3P952",32, 0)
  554    . D BMES^ XPDUTL("   the OTHER  THAN HONOR ABLE eligi bility was  not added  to the fi le #8: ")
  555   "RTN","DG5 3P952",33, 0)
  556    . D MES^X PDUTL("  " _$P(DGIEN, U,2))
  557   "RTN","DG5 3P952",34, 0)
  558    ;
  559   "RTN","DG5 3P952",35, 0)
  560    I $O(^DIC (8,"B","OT HER THAN H ONORABLE", 0))>0 D  Q
  561   "RTN","DG5 3P952",36, 0)
  562    .D BMES^X PDUTL("The  OTHER THA N HONORABL E eligibil ity has be en added t o the file  #8 succes sfully.")
  563   "RTN","DG5 3P952",37, 0)
  564    Q
  565   "RTN","DG5 3P952",38, 0)
  566    ;
  567   "RTN","DG5 3P952",39, 0)
  568    ;
  569   "RTN","DG5 3P952",40, 0)
  570    ;/**
  571   "RTN","DG5 3P952",41, 0)
  572    ;Creates  a new entr y (or node  for multi ple with . 01 field)
  573   "RTN","DG5 3P952",42, 0)
  574    ;
  575   "RTN","DG5 3P952",43, 0)
  576    ;DGFILE -  file/subf ile number
  577   "RTN","DG5 3P952",44, 0)
  578    ;DGIEN -  ien of the  parent fi le entry i n which th e new subf ile entry  will be in serted
  579   "RTN","DG5 3P952",45, 0)
  580    ;DGZFDA -  array wit h values f or the fie lds
  581   "RTN","DG5 3P952",46, 0)
  582    ; format  for DGZFDA :
  583   "RTN","DG5 3P952",47, 0)
  584    ; DGZFDA( .01)=value  for #.01  field
  585   "RTN","DG5 3P952",48, 0)
  586    ; DGZFDA( 3)=value f or #3 fiel d
  587   "RTN","DG5 3P952",49, 0)
  588    ;DGRECNO  -(optional ) specify  IEN if you  want spec ific value
  589   "RTN","DG5 3P952",50, 0)
  590    ; Note: " " then the  system wi ll assign  the entry  number its elf.
  591   "RTN","DG5 3P952",51, 0)
  592    ;DGFLGS -  FLAGS par ameter for  UPDATE^DI E
  593   "RTN","DG5 3P952",52, 0)
  594    ;DGLCKGL  - fully sp ecified gl obal refer ence to lo ck
  595   "RTN","DG5 3P952",53, 0)
  596    ;DGLCKTM  - time out  for LOCK,  if LOCKTI ME=0 then  the functi on will no t lock the  file 
  597   "RTN","DG5 3P952",54, 0)
  598    ;DGNEWRE  - optional , flag = i f 1 then a llow to cr eate a new  top level  record 
  599   "RTN","DG5 3P952",55, 0)
  600    ;  
  601   "RTN","DG5 3P952",56, 0)
  602    ;output :
  603   "RTN","DG5 3P952",57, 0)
  604    ; positiv e number -  record #  created
  605   "RTN","DG5 3P952",58, 0)
  606    ; <=0 - f ailure^err or message
  607   "RTN","DG5 3P952",59, 0)
  608    ;
  609   "RTN","DG5 3P952",60, 0)
  610    ;Example:
  611   "RTN","DG5 3P952",61, 0)
  612    ;S DGVALS (.01)="OTH D" W $$INS REC^DG5395 2(8.1,"",. DGVALS,,,, ,1)
  613   "RTN","DG5 3P952",62, 0)
  614   INSREC(DGF ILE,DGIEN, DGZFDA,DGR ECNO,DGFLG S,DGLCKGL, DGLCKTM,DG NEWRE) ;*/
  615   "RTN","DG5 3P952",63, 0)
  616    I ('$G(DG FILE)) Q " 0^Invalid  parameter"
  617   "RTN","DG5 3P952",64, 0)
  618    I +$G(DGN EWRE)=0 I  $G(DGRECNO )>0,'$G(DG IEN) Q "0^ Invalid pa rameter"
  619   "RTN","DG5 3P952",65, 0)
  620    N DGSSI,D GIENS,DGER R,DGFDA,DI ERR
  621   "RTN","DG5 3P952",66, 0)
  622    N DGLOCK  S DGLOCK=0
  623   "RTN","DG5 3P952",67, 0)
  624    I '$G(DGR ECNO) N DG RECNO S DG RECNO=$G(D GRECNO)
  625   "RTN","DG5 3P952",68, 0)
  626    I DGIEN'= "" S DGIEN S="+1,"_DG IEN_"," I  $L(DGRECNO )>0 S DGSS I(1)=+DGRE CNO
  627   "RTN","DG5 3P952",69, 0)
  628    I DGIEN=" " S DGIENS ="+1," I $ L(DGRECNO) >0 S DGSSI (1)=+DGREC NO
  629   "RTN","DG5 3P952",70, 0)
  630    M DGFDA(D GFILE,DGIE NS)=DGZFDA
  631   "RTN","DG5 3P952",71, 0)
  632    I $L($G(D GLCKGL)) L  +@DGLCKGL :(+$G(DGLC KTM)) S DG LOCK=$T I  'DGLOCK Q  -2  ;lock  failure
  633   "RTN","DG5 3P952",72, 0)
  634    D UPDATE^ DIE($G(DGF LGS),"DGFD A","DGSSI" ,"DGERR")
  635   "RTN","DG5 3P952",73, 0)
  636    I DGLOCK  L -@DGLCKG L
  637   "RTN","DG5 3P952",74, 0)
  638    I $D(DGER R) Q "-1^" _$G(DGERR( "DIERR",1, "TEXT",1), "Update Er ror")
  639   "RTN","DG5 3P952",75, 0)
  640    Q +$G(DGS SI(1))
  641   "RTN","DG5 3P952",76, 0)
  642    ;
  643   "RTN","DGL OCK1")
  644   0^6^B21612 457
  645   "RTN","DGL OCK1",1,0)
  646   DGLOCK1 ;A LB/MRL - P ATIENT FIL E DATA EDI T CHECK ;  28 JUL 86
  647   "RTN","DGL OCK1",2,0)
  648    ;;5.3;Reg istration; **121,314, 952**;Aug  13, 1993;B uild 30
  649   "RTN","DGL OCK1",3,0)
  650   AOD ;AO De lete
  651   "RTN","DGL OCK1",4,0)
  652    I $D(^DPT (DFN,.321) ),$P(^(.32 1),U,2)="Y " W !?4,*7 ,"Can't de lete as lo ng as Agen t Orange e xposure is  indicated ." K X
  653   "RTN","DGL OCK1",5,0)
  654    Q
  655   "RTN","DGL OCK1",6,0)
  656   COMD ;Comb at Delete
  657   "RTN","DGL OCK1",7,0)
  658    I $D(^DPT (DFN,.52)) ,$P(^(.52) ,U,11)="Y"  W !?4,*7, "Can't del ete as lon g as Comba t Service  is indicat ed." K X
  659   "RTN","DGL OCK1",8,0)
  660    Q
  661   "RTN","DGL OCK1",9,0)
  662   INED ;Inel igible Del ete
  663   "RTN","DGL OCK1",10,0 )
  664    I $D(^DPT (DFN,.15)) ,$P(^(.15) ,U,2)]"" W  !?4,*7,"C an't delet e this fie ld as long  as 'INELI GIBLE DATE ' is on fi le." K X
  665   "RTN","DGL OCK1",11,0 )
  666    Q
  667   "RTN","DGL OCK1",12,0 )
  668   IRD ;ION R ad Delete
  669   "RTN","DGL OCK1",13,0 )
  670    I $D(^DPT (DFN,.321) ),$P(^(.32 1),U,3)="Y " W !?4,*7 ,"Can't de lete as lo ng as Ioni zing Radia tion expos ure is ind icated." K  X
  671   "RTN","DGL OCK1",14,0 )
  672    Q
  673   "RTN","DGL OCK1",15,0 )
  674   POWD ;POW  Delete
  675   "RTN","DGL OCK1",16,0 )
  676    I $D(^DPT (DFN,.52)) ,$P(^(.52) ,U,5)="Y"  W !?4,*7," Still iden tified as  former POW ...Change  status to  delete." K  X
  677   "RTN","DGL OCK1",17,0 )
  678    Q
  679   "RTN","DGL OCK1",18,0 )
  680   TADD ;Temp  Add Delet e
  681   "RTN","DGL OCK1",19,0 )
  682    I $D(^DPT (DFN,.121) ),$P(^(.12 1),U,9)="Y " W !?4,*7 ,"Answer N O to the ' WANT TO EN TER TEMPOR ARY ADDRES S' prompt,  then dele te." K X
  683   "RTN","DGL OCK1",20,0 )
  684    Q
  685   "RTN","DGL OCK1",21,0 )
  686   VND ;Viet  Svc Delete
  687   "RTN","DGL OCK1",22,0 )
  688    I $D(^DPT (DFN,.321) ),$P(^(.32 1),U,1)="Y " W !?4,*7 ,"Can't de lete as lo ng as Viet nam Servic e is still  indicated ." K X
  689   "RTN","DGL OCK1",23,0 )
  690    Q
  691   "RTN","DGL OCK1",24,0 )
  692   SVDEL ;Pan ama, Grena da, Lebano n, Persian  Gulf Svc  Delete
  693   "RTN","DGL OCK1",25,0 )
  694    ;DGX = pi ece positi on of corr esponding  service in dicated? f ield
  695   "RTN","DGL OCK1",26,0 )
  696    I $D(^DPT (DFN,.322) ),$P(^(.32 2),U,DGX)= "Y" W !?4, *7,"Can't  delete as  long as ", $S(DGX=1:" Lebanon",D GX=4:"Gren ada",DGX=7 :"Panama", 1:"Persian  Gulf"),"  is still i ndicated."  K X
  697   "RTN","DGL OCK1",27,0 )
  698    K DGX
  699   "RTN","DGL OCK1",28,0 )
  700    Q
  701   "RTN","DGL OCK1",29,0 )
  702   EC S DGEC= $S('$D(^DP T(DFN,.36) ):"",$D(^D IC(8,+$P(^ DPT(DFN,.3 6),U,1),0) ):$P(^(0), U,9),1:"")  I DGEC=5  W !?4,*7," Eligibilit y Code is  'NSC'...Ca n't be YES ." K X,DGE C Q
  703   "RTN","DGL OCK1",30,0 )
  704    K DGEC Q
  705   "RTN","DGL OCK1",31,0 )
  706   POS ;Scree n
  707   "RTN","DGL OCK1",32,0 )
  708    K DGEC D  SV1^DGLOCK  I $D(X) S  DIC("S")= "I '$P(^(0 ),""^"",8) ,$D(^DPT(D A,.36)),$D (^DIC(21,+ Y,""E"",+$ P(^(.36),U ,1)))" D ^ DIC K DIC  S DIC=DIE, X=+Y K:Y<0  X D:'$D(X ) POSH I $ D(X),$D(^D IC(21,X,0) ),$P(^(0), U,7)]"" D  POS1 Q
  709   "RTN","DGL OCK1",33,0 )
  710    Q
  711   "RTN","DGL OCK1",34,0 )
  712   POS1 S XX= $P(^DIC(21 ,X,0),U,7)  I $P(^DPT (DA,0),U,3 )]"" I $P( ^(0),U,3)' >XX!($D(^X USEC("DG E LIGIBILITY ",DUZ))) K  XX Q
  713   "RTN","DGL OCK1",35,0 )
  714    W !?5,*7, "Applicant  is too yo ung to hav e served i n that per iod of ser vice.",!?5 ,"See your  superviso r if you r equire ass istance."  K X,XX Q
  715   "RTN","DGL OCK1",36,0 )
  716   POSH S DGE C=$S('$D(^ DPT(DFN,.3 6)):"",$D( ^DIC(8,+$P (^(.36),U, 1),0)):$P( ^(0),U,1), 1:"") W !? 5,"Current  Eligibili ty Code" W :DGEC]"" " : ",DGEC I  DGEC']""  W " is not  defined.   Must be d efined in  order",!?5 ,"to enter  a POS."
  717   "RTN","DGL OCK1",37,0 )
  718    K DGEC Q
  719   "RTN","DGL OCK1",38,0 )
  720   SC S DGSCO N=$S('$D(^ DPT(DFN,.3 )):0,$P(^( .3),U,1)=" Y":1,1:0)  I 'DGSCON  W !?4,*7," Not possib le, applic ant is not  service-c onnected."  K X,DGSCO N Q
  721   "RTN","DGL OCK1",39,0 )
  722    K DGSCON  Q
  723   "RTN","DGL OCK1",40,0 )
  724    ;
  725   "RTN","DGL OCK1",41,0 )
  726   ECD ;prima ry eligibi lity code  input tran sform
  727   "RTN","DGL OCK1",42,0 )
  728    ;
  729   "RTN","DGL OCK1",43,0 )
  730    N DGNODE, DGPC,DGSER ,DGVT,DGXX
  731   "RTN","DGL OCK1",44,0 )
  732    S DGVT=$G (^DPT(DFN, "VET")),DG SER=$S('$D (^DPT(DFN, .3)):0,$P( ^(.3),U,1) ="Y":1,1:0 )
  733   "RTN","DGL OCK1",45,0 )
  734    I DGVT']" " K X W !? 4,*7,"'VET ERAN (Y/N) ' prompt m ust be ans wered to s elect an E ligibility  Code'" Q
  735   "RTN","DGL OCK1",46,0 )
  736    ;screen o ut all ent ries with  the wrong  "veteran"  type, and  inactive a nd those t hat can be  selected  only as ad ditional
  737   "RTN","DGL OCK1",47,0 )
  738    S DIC("S" )="I $P(^D IC(8,+Y,0) ,U,5)=DGVT ,'$P(^(0), U,7),'$P(^ (0),U,13)"  I DGVT="N " G ECDS
  739   "RTN","DGL OCK1",48,0 )
  740    I DGSER S  DGPC=$S(+ $P(^DPT(DF N,.3),U,2) >49:1,1:0) ,DGXX=$S(D GPC:1,1:3) ,DIC("S")= DIC("S")_" ,($P(^(0), U,9)="_DGX X_")" G EC DS ;sc onl y
  741   "RTN","DGL OCK1",49,0 )
  742    I $P($G(^ DPT(DFN,.5 2)),"^",5) ="Y" S DIC ("S")=DIC( "S")_",($P (^(0),U,9) =18)" G EC DS ;pow on ly
  743   "RTN","DGL OCK1",50,0 )
  744    S DGXX="^ 1^3^18^" ;  no sc<50,  sc 50-100 , pow
  745   "RTN","DGL OCK1",51,0 )
  746    I $P($G(^ DPT(DFN,.5 3)),U)="Y"  S DIC("S" )=DIC("S") _",($P(^(0 ),U,9)=22) " G ECDS ; checks for  PH Indica tor
  747   "RTN","DGL OCK1",52,0 )
  748    S DGXX=DG XX_"22^" ; adds PH to  DGXX stri ng
  749   "RTN","DGL OCK1",53,0 )
  750    S DGNODE= $G(^DPT(DF N,.362))
  751   "RTN","DGL OCK1",54,0 )
  752    I $P(DGNO DE,"^",12) '="Y" S DG XX=DGXX_"2 ^"
  753   "RTN","DGL OCK1",55,0 )
  754    I $P(DGNO DE,"^",14) '="Y" S DG XX=DGXX_"4 ^"
  755   "RTN","DGL OCK1",56,0 )
  756    I $P(DGNO DE,"^",13) '="Y" S DG XX=DGXX_"1 5^"
  757   "RTN","DGL OCK1",57,0 )
  758    F I=12:1: 14 I $P(DG NODE,"^",I )="Y" S DG XX=DGXX_"5 ^"_$S(I'=1 4:"4^",1:" ")
  759   "RTN","DGL OCK1",58,0 )
  760    I $P($G(^ DPT(DFN,0) ),"^",3)>2 200101 S D GXX=DGXX_" 16^17^" ;  WWI or mex ican borde r only
  761   "RTN","DGL OCK1",59,0 )
  762    S DIC("S" )=DIC("S") _",("""_DG XX_"""'[(U _$P(^(0),U ,9)_U))"
  763   "RTN","DGL OCK1",60,0 )
  764   ECDS D ^DI C K DIC S  DIC=DIE,X= +Y K:Y<0 X
  765   "RTN","DGL OCK1",61,0 )
  766    ;
  767   "RTN","DGL OCK1",62,0 )
  768    ;catastro phic disab ility can  not be pri mary
  769   "RTN","DGL OCK1",63,0 )
  770    I $G(X),$ $NATNAME^D GENELA(X)= "CATASTROP HICALLY DI SABLED" K  X Q
  771   "RTN","DGL OCK1",64,0 )
  772    ;other th an honorab le cannot  be primary
  773   "RTN","DGL OCK1",65,0 )
  774    I $G(X),$ $NATNAME^D GENELA(X)= "OTHER THA N HONORABL E" K X Q
  775   "RTN","DGL OCK1",66,0 )
  776    ;
  777   "RTN","DGL OCK1",67,0 )
  778    Q
  779   "RTN","DGO THD")
  780   0^2^B57301 824
  781   "RTN","DGO THD",1,0)
  782   DGOTHD ;SL C/SS/RM -  OTHD (OTHE R THAN HON ORABLE DIS CHARGE) AP Is ;3/6/18   14:34
  783   "RTN","DGO THD",2,0)
  784    ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 30
  785   "RTN","DGO THD",3,0)
  786    ;
  787   "RTN","DGO THD",4,0)
  788    Q
  789   "RTN","DGO THD",5,0)
  790    ;
  791   "RTN","DGO THD",6,0)
  792    ;ask for  the starti ng date fo r the OTH  clock
  793   "RTN","DGO THD",7,0)
  794    ;called f rom [DG LO AD EDIT SC REEN 7]
  795   "RTN","DGO THD",8,0)
  796   STRDATE(DG DFN) ;
  797   "RTN","DGO THD",9,0)
  798    I '$G(DGD FN) Q
  799   "RTN","DGO THD",10,0)
  800    N DGSTRDT ,Y
  801   "RTN","DGO THD",11,0)
  802    I '$$ISOT HD(DGDFN)  Q
  803   "RTN","DGO THD",12,0)
  804    I $$HASCL OCK^DGOTHD 2(DGDFN) Q
  805   "RTN","DGO THD",13,0)
  806    S DGSTRDT =$$ASKDT^D GOTHD2("En ter the st arting dat e for the  OTH clock:  ","T")
  807   "RTN","DGO THD",14,0)
  808    I DGSTRDT '>0 Q
  809   "RTN","DGO THD",15,0)
  810    D FRSTCLC K^DGOTHD1( DGDFN,DGST RDT)
  811   "RTN","DGO THD",16,0)
  812    Q
  813   "RTN","DGO THD",17,0)
  814    ;
  815   "RTN","DGO THD",18,0)
  816    ;Authoriz e 2nd 90 d ays period
  817   "RTN","DGO THD",19,0)
  818   AUTH90DS ;
  819   "RTN","DGO THD",20,0)
  820    N DGLOOP
  821   "RTN","DGO THD",21,0)
  822    S DGLOOP= 0
  823   "RTN","DGO THD",22,0)
  824    ;keep ask ing until  empty inpu t
  825   "RTN","DGO THD",23,0)
  826    F  D  Q:D GLOOP=1
  827   "RTN","DGO THD",24,0)
  828    . N DGARR ,DGSTRDT,D GIEN33,DGD FN,DGRES,D G365,DG90, DGLFT1ST,D GOK,DGLOOP 2,DGRES2,D GIEN365
  829   "RTN","DGO THD",25,0)
  830    . S DGIEN 33=$$SELPA T^DGOTHD2( .DGARR)
  831   "RTN","DGO THD",26,0)
  832    . I DGIEN 33<0 S DGL OOP=1 Q
  833   "RTN","DGO THD",27,0)
  834    . I +$G(D GARR)'>0 S  DGLOOP=1  Q
  835   "RTN","DGO THD",28,0)
  836    . S DGDFN =$$GETPAT^ DGOTHD2(DG IEN33)
  837   "RTN","DGO THD",29,0)
  838    . S DGRES =$$OTHDCLC K(DGDFN,DT )
  839   "RTN","DGO THD",30,0)
  840    . I DGRES <0 W !!,"E rror"_$S($ L($P(DGRES ,U,2))>0:" : "_$P(DGR ES,U,2),1: ""),!,"Ple ase select  another p atient.",!  Q
  841   "RTN","DGO THD",31,0)
  842    . I DGRES =0 W !!,"P atient is  not eligib le for OTH .",!,"Plea se select  another pa tient.",!  Q
  843   "RTN","DGO THD",32,0)
  844    . S DG365 =$P(DGRES, U,1)
  845   "RTN","DGO THD",33,0)
  846    . I DG365 >1 W !!,"W arning: Th e patient  has more t han one 36 5 days OTH  periods!" ,!,"Author ization ca n be enter ed only fo r the last  365 days  period.",!
  847   "RTN","DGO THD",34,0)
  848    . S DG90= $P(DGRES,U ,2)
  849   "RTN","DGO THD",35,0)
  850    . I DG90= 2 W !!,"Th e patient  is in the  second 90  day period  at the mo ment.",!," Please sel ect anothe r patient. ",! Q
  851   "RTN","DGO THD",36,0)
  852    . I DG90= 3 W !!,"Th e patient  has used a ll 180 day s (2 90 da ys periods ) in this  365 day pe riod",!,"a nd cannot  be authori zed for th e more 90  days perio ds.",!,"Pl ease selec t another  patient.", ! Q
  853   "RTN","DGO THD",37,0)
  854    . S DGIEN 365=$$CHCK 365^DGOTHD 2(DGIEN33, DG365)
  855   "RTN","DGO THD",38,0)
  856    . I DGIEN 365>0 I $$ HAS2AUTH^D GOTHD2(DGI EN33,DGIEN 365,2)>0 W  !!,"The p atient was  authorize d previous ly.",!,"Pl ease selec t another  patient.", ! Q
  857   "RTN","DGO THD",39,0)
  858    . I $$YES NO^DGOTHD2 ("Are you  authorizin g the pati ent for th e 2nd OTH  period of  OTH?(Y/N)" )'=1 Q
  859   "RTN","DGO THD",40,0)
  860    . S DGSTR DT=-1 ;by  default -  don't star t the 2nd  period
  861   "RTN","DGO THD",41,0)
  862    . S DGLOO P2=1
  863   "RTN","DGO THD",42,0)
  864    . F  D  Q :DGLOOP2'= 1
  865   "RTN","DGO THD",43,0)
  866    . . K DGR ES2,DGSTRD T,DGLFT1ST
  867   "RTN","DGO THD",44,0)
  868    . . S DGS TRDT=-1
  869   "RTN","DGO THD",45,0)
  870    . . S DGL OOP2=$$YES NO^DGOTHD2 ("Do you w ant to set  the start  date for  the 2nd OT H period o f OTH?(Y/N )")
  871   "RTN","DGO THD",46,0)
  872    . . I DGL OOP2'=1 Q
  873   "RTN","DGO THD",47,0)
  874    . . S DGS TRDT=$$ASK DT^DGOTHD2 ("Start da te for the  authorize d 2nd 90 d ays period : ","T")
  875   "RTN","DGO THD",48,0)
  876    . . S DGR ES2=$$OTHD CLCK(DGDFN ,DGSTRDT)
  877   "RTN","DGO THD",49,0)
  878    . . S DGL FT1ST=$S($ P(DGRES2,U ,5)>0:+$P( DGRES2,U,5 ),1:0) ;da ys left in  the 1st p eriod
  879   "RTN","DGO THD",50,0)
  880    . . I DGL FT1ST>0 W  !!,"The pa tient has  "_DGLFT1ST _" days le ft in the  1st period  on the da te ",$$DAT E^DGOTHD2( DGSTRDT),! ,"selected  for the a uthorizati on.",!,"Pl ease selec t another  date for a uthorizati on.",! Q
  881   "RTN","DGO THD",51,0)
  882    . . S DGL OOP2=0
  883   "RTN","DGO THD",52,0)
  884    . S DGOK= $$SETAUTH^ DGOTHD1(DG DFN,DGSTRD T,DG365,2, $G(DUZ),$$ NOW^XLFDT( ))
  885   "RTN","DGO THD",53,0)
  886    . I DGOK' =1 W !!,"E rror"_$S($ L($P(DGOK, U,2))>0:":  "_$P(DGOK ,U,2),1:"" ),! Q
  887   "RTN","DGO THD",54,0)
  888    . I DGSTR DT>0 W !!, "The patie nt has bee n authoriz ed for the  second 90  day perio d with the  starting  date ",$$D ATE^DGOTHD 2(DGSTRDT) ,".",! Q
  889   "RTN","DGO THD",55,0)
  890    . W !!,"T he patient  has been  authorized  for the s econd 90 d ay period. ",!
  891   "RTN","DGO THD",56,0)
  892    Q
  893   "RTN","DGO THD",57,0)
  894    ;
  895   "RTN","DGO THD",58,0)
  896    ;
  897   "RTN","DGO THD",59,0)
  898    ;Function ality:
  899   "RTN","DGO THD",60,0)
  900    ; Impleme nts ICR# 6 873
  901   "RTN","DGO THD",61,0)
  902    ; This fu nction is  called fro m GET^OROT HCL to sup port
  903   "RTN","DGO THD",62,0)
  904    ; the "OR  OTHD CLOC K GET" RPC
  905   "RTN","DGO THD",63,0)
  906    ;It check s if the p atient is  eligible f or OTHD
  907   "RTN","DGO THD",64,0)
  908    ;and retu rns the OT HD status  on the giv en date
  909   "RTN","DGO THD",65,0)
  910    ;
  911   "RTN","DGO THD",66,0)
  912    ;
  913   "RTN","DGO THD",67,0)
  914    ;Paramete rs:
  915   "RTN","DGO THD",68,0)
  916    ; DGDFN -  the patie nt's IEN i n the file  (#2)
  917   "RTN","DGO THD",69,0)
  918    ; DGDATE  - the date  to calcul ate status
  919   "RTN","DGO THD",70,0)
  920    ;           default  = DT (toda y)
  921   "RTN","DGO THD",71,0)
  922    ;
  923   "RTN","DGO THD",72,0)
  924    ;Return v alues:
  925   "RTN","DGO THD",73,0)
  926    ;
  927   "RTN","DGO THD",74,0)
  928    ;return 0  
  929   "RTN","DGO THD",75,0)
  930    ;  if pat ient is no t eligible  for OTHD  in registr ation
  931   "RTN","DGO THD",76,0)
  932    ;  if pat ient does  not have a n entry in  the OTHD  clock file  (#33)
  933   "RTN","DGO THD",77,0)
  934    ;
  935   "RTN","DGO THD",78,0)
  936    ;
  937   "RTN","DGO THD",79,0)
  938    ;Returns  the inform ation to d isplay inf ormation a bout the O THD clock 
  939   "RTN","DGO THD",80,0)
  940    ;The retu rn string  is of the  following  format:
  941   "RTN","DGO THD",81,0)
  942    ; if some  kind of e rror condi tion is en countered,  return
  943   "RTN","DGO THD",82,0)
  944       ;  -1^ error mess age
  945   "RTN","DGO THD",83,0)
  946    ; else re turn p1^p2 ^p3^p4^p5^ p6^p7^p8 w here:
  947   "RTN","DGO THD",84,0)
  948    ;  p1 = 1  .. n
  949   "RTN","DGO THD",85,0)
  950    ;   1..n  - the late st sequenc e number o f the 365  period
  951   "RTN","DGO THD",86,0)
  952    ;  p2 = 1 ,2,or 3
  953   "RTN","DGO THD",87,0)
  954    ;   1 if  the patien t is in th e first 90  day perio d
  955   "RTN","DGO THD",88,0)
  956    ;   2 if  the patien t is in th e second 9 0 day peri od
  957   "RTN","DGO THD",89,0)
  958    ;   3 if  the patien t has used  all 180 d ays in thi s 365 day  period
  959   "RTN","DGO THD",90,0)
  960    ;  p3 = F M date for  the start  of the cl ock for th e first 90  day perio d
  961   "RTN","DGO THD",91,0)
  962    ;  p4 = F M date for  the end o f the cloc k for the  first 90 d ay period
  963   "RTN","DGO THD",92,0)
  964    ;  p5 = t he number  of days le ft in the  first 90 d ay period
  965   "RTN","DGO THD",93,0)
  966    ;  p6 = F M date for  the start  of the cl ock for th e second 9 0 day peri od
  967   "RTN","DGO THD",94,0)
  968    ;  p7 = F M date for  the end o f the cloc k for the  second 90  day period
  969   "RTN","DGO THD",95,0)
  970    ;  p8 = t he number  of days le ft in the  second 90  day period
  971   "RTN","DGO THD",96,0)
  972    ;  p9 = F M date  of  the autho rization f or the 2nd  period (n ull if no  authorizat ion)
  973   "RTN","DGO THD",97,0)
  974    ;
  975   "RTN","DGO THD",98,0)
  976   OTHDCLCK(D GDFN,DGDAT E) ;
  977   "RTN","DGO THD",99,0)
  978    N DGN,RET ,DGIEN33,D GRET,DGLS3 65D,DGLS36 5I,DG90A,D GARR,DGDIF
  979   "RTN","DGO THD",100,0 )
  980    N DGP0,DG P1,DGP2,DG P3,DGP4,DG P5,DGP6,DG P7,DGP8,DG P9,DGAUTH
  981   "RTN","DGO THD",101,0 )
  982    I $$ISOTH D^DGOTHD(D GDFN)=0 Q  0
  983   "RTN","DGO THD",102,0 )
  984    S DGDATE= $S($G(DGDA TE)>0:DGDA TE,1:DT)
  985   "RTN","DGO THD",103,0 )
  986    S DGIEN33 =+$O(^DGOT H(33,"B",D GDFN,0))
  987   "RTN","DGO THD",104,0 )
  988    I DGIEN33 =0 Q "0"
  989   "RTN","DGO THD",105,0 )
  990    D GETS^DI Q(33,DGIEN 33_",",".0 1;.02;.03; 1*","I","D GARR")
  991   "RTN","DGO THD",106,0 )
  992    I $G(DGAR R(33,DGIEN 33_",",.02 ,"I"))'=1  Q 0  ;not  eligible f or OTHD be cause OTHD  clock has  been inac tivated
  993   "RTN","DGO THD",107,0 )
  994    I $G(DGAR R(33,DGIEN 33_",",.03 ,"I"))=1 Q  0  ;not e ligible fo r OTHD bec ause VBA A DJUDICATIO N has been  COMPLETED
  995   "RTN","DGO THD",108,0 )
  996    S DGLS365 D=+$O(^DGO TH(33,DGIE N33,1,"B", 999),-1)
  997   "RTN","DGO THD",109,0 )
  998    I DGLS365 D'>0 Q "-1 ^no 365 da ys clocks  started"
  999   "RTN","DGO THD",110,0 )
  1000    S DGLS365 I=+$O(^DGO TH(33,DGIE N33,1,"B", DGLS365D,0 ))
  1001   "RTN","DGO THD",111,0 )
  1002    S DGN=0 F   S DGN=+$ O(^DGOTH(3 3,DGIEN33, 1,DGLS365I ,1,"B",DGN )) Q:DGN=0   S DG90A( DGN)=+$O(^ DGOTH(33,D GIEN33,1,D GLS365I,1, "B",DGN,0) )
  1003   "RTN","DGO THD",112,0 )
  1004    I '$D(DG9 0A) Q "-1^ there are  no 90 days  periods f or the 365  days peri od # "_DGL S365D
  1005   "RTN","DGO THD",113,0 )
  1006    I '$D(DG9 0A(1)) Q " -1^missing  the 1st 9 0 days per iod for th e 365 days  period #  "_DGLS365D
  1007   "RTN","DGO THD",114,0 )
  1008    I $O(DG90 A(2)) Q "- 1^there ar e more tha n two 90 d ays period s for the  365 days p eriod # "_ DGLS365D
  1009   "RTN","DGO THD",115,0 )
  1010    S (DGP0,D GP1,DGP2,D GP3,DGP4,D GP5,DGP6,D GP7,DGP8,D GP9,DGAUTH )=""
  1011   "RTN","DGO THD",116,0 )
  1012    S DGP1=DG LS365D
  1013   "RTN","DGO THD",117,0 )
  1014    ;calculat ion for th e 1st 90 d ays period
  1015   "RTN","DGO THD",118,0 )
  1016    S DGP3=$G (DGARR(33. 11,DG90A(1 )_","_DGLS 365I_","_D GIEN33_"," ,.02,"I")) ,DGP4=$$FM ADD^XLFDT( DGP3,90),D GDIF=$$FMD IFF^XLFDT( DGP4,DGDAT E,1),DGP5= $S(DGDIF>0 :DGDIF,1:0 )
  1017   "RTN","DGO THD",119,0 )
  1018    ;calculat ion for th e 2nd 90 d ays period  if any
  1019   "RTN","DGO THD",120,0 )
  1020    I $D(DG90 A(2)) D
  1021   "RTN","DGO THD",121,0 )
  1022    . S DGP6= $G(DGARR(3 3.11,DG90A (2)_","_DG LS365I_"," _DGIEN33_" ,",.02,"I" )) I DGP6> 0 S DGP7=$ $FMADD^XLF DT(DGP6,90 ),DGDIF=$$ FMDIFF^XLF DT(DGP7,DG DATE,1),DG P8=$S(DGP5 >0:90,DGDI F>0:DGDIF, 1:0)
  1023   "RTN","DGO THD",122,0 )
  1024    . S DGAUT H=$G(DGARR (33.11,DG9 0A(2)_","_ DGLS365I_" ,"_DGIEN33 _",",.03," I"))
  1025   "RTN","DGO THD",123,0 )
  1026    . I DGAUT H'="" S DG P9=$P($G(D GARR(33.11 ,DG90A(2)_ ","_DGLS36 5I_","_DGI EN33_",",. 04,"I"))," .")
  1027   "RTN","DGO THD",124,0 )
  1028    S DGP2=$S (((DGP5=0) &($D(DG90A (2))&(DGP6 >0))&(DGP8 =0)):3,($D (DG90A(2)) &(DGP6>0)) :2,'$D(DG9 0A(1)):-1, DGP3'>0:-1 ,1:1)
  1029   "RTN","DGO THD",125,0 )
  1030    I DGP5>0  S DGP2=1
  1031   "RTN","DGO THD",126,0 )
  1032    S DGRET=D GP1_U_DGP2 _U_DGP3_U_ DGP4_U_DGP 5_U_DGP6_U _DGP7_U_DG P8_U_DGP9
  1033   "RTN","DGO THD",127,0 )
  1034    Q DGRET
  1035   "RTN","DGO THD",128,0 )
  1036    ;
  1037   "RTN","DGO THD",129,0 )
  1038    ;Function ality:
  1039   "RTN","DGO THD",130,0 )
  1040    ; checks  OTHD eligi bility
  1041   "RTN","DGO THD",131,0 )
  1042    ;
  1043   "RTN","DGO THD",132,0 )
  1044    ;ICR:
  1045   "RTN","DGO THD",133,0 )
  1046    ; Private  ICR #TBD
  1047   "RTN","DGO THD",134,0 )
  1048    ; between  DG and YS  namespace s
  1049   "RTN","DGO THD",135,0 )
  1050    ;
  1051   "RTN","DGO THD",136,0 )
  1052    ;Paramete rs:
  1053   "RTN","DGO THD",137,0 )
  1054    ; DFN - p atient's I EN in the  file (#2)
  1055   "RTN","DGO THD",138,0 )
  1056    ;
  1057   "RTN","DGO THD",139,0 )
  1058    ;Return v alues:
  1059   "RTN","DGO THD",140,0 )
  1060    ; 0 - not  eligible  for OTHD
  1061   "RTN","DGO THD",141,0 )
  1062    ; 1 - eli gible for  OTHD
  1063   "RTN","DGO THD",142,0 )
  1064    ;
  1065   "RTN","DGO THD",143,0 )
  1066   ISOTHD(DFN ) ;
  1067   "RTN","DGO THD",144,0 )
  1068    N VAEL,DG IEN,DGOTHD
  1069   "RTN","DGO THD",145,0 )
  1070    D ELIG^VA DPT
  1071   "RTN","DGO THD",146,0 )
  1072    S DGIEN=0 ,DGOTHD=0
  1073   "RTN","DGO THD",147,0 )
  1074    F  S DGIE N=+$O(VAEL (1,DGIEN))  Q:DGIEN=0   I $P(VAE L(1,DGIEN) ,U,2)="OTH ER THAN HO NORABLE" S  DGOTHD=1  Q
  1075   "RTN","DGO THD",148,0 )
  1076    ;B2S1
  1077   "RTN","DGO THD",149,0 )
  1078    ;check if  eligible  for OTH ba sed on the  Enrolment  status (f ile 27.11,  field #.0 4 -> 27.15 )
  1079   "RTN","DGO THD",150,0 )
  1080    ;I $$ELIG 4OTH(DFN)
  1081   "RTN","DGO THD",151,0 )
  1082    Q DGOTHD
  1083   "RTN","DGO THD",152,0 )
  1084    ;
  1085   "RTN","DGO THD",153,0 )
  1086    ;
  1087   "RTN","DGO THD",154,0 )
  1088    ;B2S1
  1089   "RTN","DGO THD",155,0 )
  1090    ;check if  (still) e ligible fo r OTH
  1091   "RTN","DGO THD",156,0 )
  1092   ELIG4OTH(D PTDFN) ;
  1093   "RTN","DGO THD",157,0 )
  1094    N ENRCOMP
  1095   "RTN","DGO THD",158,0 )
  1096    ;is enrol lment stat us compati ble with O TH?
  1097   "RTN","DGO THD",159,0 )
  1098    S ENRCOMP =$$ENSTCMP T(DPTDFN)
  1099   "RTN","DGO THD",160,0 )
  1100    ;if enrol lment stat us compati ble or not  compatibl e
  1101   "RTN","DGO THD",161,0 )
  1102    I +ENRCOM P1=-1 Q +E NRCOMP1
  1103   "RTN","DGO THD",162,0 )
  1104    ;if compa tibility w asn't dete rmined or  enrollment  status ca nnot be us ed for OTH  compatibi lity 
  1105   "RTN","DGO THD",163,0 )
  1106    ;
  1107   "RTN","DGO THD",164,0 )
  1108    Q
  1109   "RTN","DGO THD",165,0 )
  1110    ;
  1111   "RTN","DGO THD",166,0 )
  1112    ;
  1113   "RTN","DGO THD",167,0 )
  1114    ;Check if  the enrol lment stat us compati ble with O TH
  1115   "RTN","DGO THD",168,0 )
  1116    ;Returns
  1117   "RTN","DGO THD",169,0 )
  1118    ; -1 : no  enrollmen t status o r unknown  status
  1119   "RTN","DGO THD",170,0 )
  1120    ; 0^Enrom ment statu s : NOT el igible if  the enroll ment statu s one of t he followi ng
  1121   "RTN","DGO THD",171,0 )
  1122    ;
  1123   "RTN","DGO THD",172,0 )
  1124    ;ENTRY                                                    ENROLL MENT
  1125   "RTN","DGO THD",173,0 )
  1126    ;NUMBER   NAME                                            CATEGO RY
  1127   "RTN","DGO THD",174,0 )
  1128    ;------   ---------- ---------- ---------- ---------- --  ------ ----
  1129   "RTN","DGO THD",175,0 )
  1130    ;   2     VERIFIED                                        ENROLL ED                     
  1131   "RTN","DGO THD",176,0 )
  1132    ;   3     INACTIVE                                                                         
  1133   "RTN","DGO THD",177,0 )
  1134    ;   4     REJECTED                                                                         
  1135   "RTN","DGO THD",178,0 )
  1136    ;   5     SUSPENDED                                                                        
  1137   "RTN","DGO THD",179,0 )
  1138    ;   6     DECEASED                                        NOT EN ROLLED
  1139   "RTN","DGO THD",180,0 )
  1140    ;   7     CANCELLED/ DECLINED                             NOT EN ROLLED
  1141   "RTN","DGO THD",181,0 )
  1142    ;   8     EXPIRED                                                                          
  1143   "RTN","DGO THD",182,0 )
  1144    ;   10     NOT ELIGI BLE                                  NOT EN ROLLED
  1145   "RTN","DGO THD",183,0 )
  1146    ;   11     REJECTED;  FISCAL YE AR                        NOT EN ROLLED
  1147   "RTN","DGO THD",184,0 )
  1148    ;   12     REJECTED;  MID-CYCLE                           NOT EN ROLLED
  1149   "RTN","DGO THD",185,0 )
  1150    ;   13     REJECTED;  STOP NEW  ENROLLMENT S              NOT EN ROLLED
  1151   "RTN","DGO THD",186,0 )
  1152    ;   14     REJECTED;  INITIAL A PPLICATION  BY VAMC       NOT EN ROLLED
  1153   "RTN","DGO THD",187,0 )
  1154    ;   16     PENDING;  MEANS TEST  REQUIRED                 IN PRO CESS
  1155   "RTN","DGO THD",188,0 )
  1156    ;   19     NOT ELIGI BLE; REFUS ED TO PAY  COPAY          NOT EN ROLLED
  1157   "RTN","DGO THD",189,0 )
  1158    ;   20     NOT ELIGI BLE; INELI GIBLE DATE                NOT EN ROLLED
  1159   "RTN","DGO THD",190,0 )
  1160    ;   21     PENDING;  PURPLE HEA RT UNCONFI RMED           IN PRO CESS
  1161   "RTN","DGO THD",191,0 )
  1162    ;   22     REJECTED;  BELOW ENR OLLMENT GR OUP THRESH OLD NOT EN ROLLED
  1163   "RTN","DGO THD",192,0 )
  1164    ;   23     NOT APPLI CABLE                                NOT EN ROLLED
  1165   "RTN","DGO THD",193,0 )
  1166    ;   24     CLOSED AP PLICATION                            NOT EN ROLLED
  1167   "RTN","DGO THD",194,0 )
  1168    ;
  1169   "RTN","DGO THD",195,0 )
  1170    ; 1^Enrom ment statu s :  Compa tible with  OTH if th e enrollme nt status  one of the  following
  1171   "RTN","DGO THD",196,0 )
  1172    ;ENTRY                                                    ENROLL MENT
  1173   "RTN","DGO THD",197,0 )
  1174    ;NUMBER   NAME                                            CATEGO RY
  1175   "RTN","DGO THD",198,0 )
  1176    ;------   ---------- ---------- ---------- ---------- --  ------ ----
  1177   "RTN","DGO THD",199,0 )
  1178    ;   1     UNVERIFIED                                      IN PRO CESS
  1179   "RTN","DGO THD",200,0 )
  1180    ;   9     PENDING                                         IN PRO CESS
  1181   "RTN","DGO THD",201,0 )
  1182    ;   15     PENDING;  NO ELIGIBI LITY CODE                 IN PRO CESS
  1183   "RTN","DGO THD",202,0 )
  1184    ;   17     PENDING;  ELIGIBILIT Y STATUS I S UNVERIFI ED  IN PRO CESS
  1185   "RTN","DGO THD",203,0 )
  1186    ;   18     PENDING;  OTHER                                IN PRO CESS
  1187   "RTN","DGO THD",204,0 )
  1188    ;
  1189   "RTN","DGO THD",205,0 )
  1190    ;
  1191   "RTN","DGO THD",206,0 )
  1192   ENRINFO(DP TDFN) ;
  1193   "RTN","DGO THD",207,0 )
  1194    N DGENR,E SSTR,DGSTA T,DGCATEG
  1195   "RTN","DGO THD",208,0 )
  1196    I '$$GET^ DGENA($$FI NDCUR^DGEN A(+DPTDFN) ,.DGENR) Q  -1
  1197   "RTN","DGO THD",209,0 )
  1198    S DGSTAT= DGENR("STA TUS")
  1199   "RTN","DGO THD",210,0 )
  1200    S DGCATEG =$$CATEGOR Y^DGENA4(+ DPTDFN,DGS TAT)
  1201   "RTN","DGO THD",211,0 )
  1202    ;S ESSTR= $P(DGSTAT, U,2)_U_DGC ATEG_U_$G( DGENR("SOU RCE"))_U_$ G(DGENR("P RIORITY")) _U_$G(DGEN R("ELIG"," CODE"))_U_ $G(DGENR(" PRIORREC") )
  1203   "RTN","DGO THD",212,0 )
  1204    S ESSTR=$ P(DGSTAT,U ,2)_U_"Cat egory="_DG CATEG_", S ource="_$S ($G(DGENR( "SOURCE")) =1:"VAMC", $G(DGENR(" SOURCE"))= 2:"HEC",1: "Other VAM C")_", Pri ority="
  1205   "RTN","DGO THD",213,0 )
  1206    S ESSTR=E SSTR_$G(DG ENR("PRIOR ITY"))_",  Prim.elig= "_$P($G(^D IC(8,($G(D GENR("ELIG ","CODE")) ),0)),U)_" , Prior el ig="_$G(DG ENR("PRIOR REC"))
  1207   "RTN","DGO THD",214,0 )
  1208    S DGSTAT= U_DGSTAT_U
  1209   "RTN","DGO THD",215,0 )
  1210    ;compatib le with OT H
  1211   "RTN","DGO THD",216,0 )
  1212    I "^1^9^1 5^17^18^"[ DGSTAT Q " 1^"_$P(DGS TAT,U,2)_U _ESSTR
  1213   "RTN","DGO THD",217,0 )
  1214    ;not comp atible wit h OTH
  1215   "RTN","DGO THD",218,0 )
  1216    I "^2^3^4 ^5^6^7^8^1 0^11^12^13 ^14^16^19^ 20^21^22^2 3^24^"[DGS TAT Q "0^" _$P(DGSTAT ,U,2)_U_ES STR
  1217   "RTN","DGO THD",219,0 )
  1218    ;if categ ory is pen ding then  compatible
  1219   "RTN","DGO THD",220,0 )
  1220    I DGCATEG ="P" Q 1
  1221   "RTN","DGO THD",221,0 )
  1222    Q "-1^"_$ P(DGSTAT,U ,2)_U_ESST R
  1223   "RTN","DGO THD",222,0 )
  1224    ;
  1225   "RTN","DGO THD",223,0 )
  1226    ;
  1227   "RTN","DGO THD",224,0 )
  1228   ENSTCMPT(D PTDFN) ;
  1229   "RTN","DGO THD",225,0 )
  1230    N DGSTAT
  1231   "RTN","DGO THD",226,0 )
  1232    S DGSTAT= $$STATUS^D GENA($G(DP TDFN))
  1233   "RTN","DGO THD",227,0 )
  1234    I DGSTAT= "" Q -1  ; no enrollm ent status  or unknow n status
  1235   "RTN","DGO THD",228,0 )
  1236    S DGSTAT= U_DGSTAT_U
  1237   "RTN","DGO THD",229,0 )
  1238    ;compatib le with OT H
  1239   "RTN","DGO THD",230,0 )
  1240    I "^1^9^1 5^17^18^"[ DGSTAT Q " 1^"_$P(DGS TAT,U,2)
  1241   "RTN","DGO THD",231,0 )
  1242    ;not comp atible wit h OTH
  1243   "RTN","DGO THD",232,0 )
  1244    I "^2^3^4 ^5^6^7^8^1 0^11^12^13 ^14^16^19^ 20^21^22^2 3^24^"[DGS TAT Q "0^" _$P(DGSTAT ,U,2)
  1245   "RTN","DGO THD",233,0 )
  1246    Q "-1^"_$ P(DGSTAT,U ,2)
  1247   "RTN","DGO THD",234,0 )
  1248    ;
  1249   "RTN","DGO THD",235,0 )
  1250    ;
  1251   "RTN","DGO THD",236,0 )
  1252    ;
  1253   "RTN","DGO THD",237,0 )
  1254    ;
  1255   "RTN","DGO THD",238,0 )
  1256    ;     "AP P"            Enrollm ent Applic ation Date
  1257   "RTN","DGO THD",239,0 )
  1258    ;     "DA TE"           Enrollm ent Date
  1259   "RTN","DGO THD",240,0 )
  1260    ;     "EN D"            Enrollm ent End Da te
  1261   "RTN","DGO THD",241,0 )
  1262    ;     "DF N"            Patient  IEN
  1263   "RTN","DGO THD",242,0 )
  1264    ;     "SO URCE"         Enrollm ent Source
  1265   "RTN","DGO THD",243,0 )
  1266    ;     "ST ATUS"         Enrollm ent Status
  1267   "RTN","DGO THD",244,0 )
  1268    ;     "RE ASON"         Reason  Canceled/D eclined
  1269   "RTN","DGO THD",245,0 )
  1270    ;     "RE MARKS"        Cancele d/Declined  Remarks
  1271   "RTN","DGO THD",246,0 )
  1272    ;     "FA CREC"         Facilit y Received
  1273   "RTN","DGO THD",247,0 )
  1274    ;     "PR IORITY"       Enrollm ent Priori ty
  1275   "RTN","DGO THD",248,0 )
  1276    ;     "SU BGRP"         Enrollm ent Sub-Gr oup
  1277   "RTN","DGO THD",249,0 )
  1278    ;     "RC ODE"          Reason  for Closed  Applicati on ;;DJE D G*5.3*940  - Closed A pplication
  1279   "RTN","DGO THD",250,0 )
  1280    ;     "EF FDATE"        Effecti ve Date
  1281   "RTN","DGO THD",251,0 )
  1282    ;     "PR IORREC"       Prior E nrollment  Record
  1283   "RTN","DGO THD",252,0 )
  1284    ;     "EL IG","CODE"              Primary  Eligibilit y Code
  1285   "RTN","DGO THD",253,0 )
  1286    ;     "EL IG","CODE" ,<code ien > Eligibil ity Codes
  1287   "RTN","DGO THD",254,0 )
  1288    ;     "EL IG","SC"                Service  Connected
  1289   "RTN","DGO THD",255,0 )
  1290    ;     "EL IG","SCPER "            Service  Connected  Percentage
  1291   "RTN","DGO THD",256,0 )
  1292    ;     "EL IG","POW"               POW Stat us Indicat ed
  1293   "RTN","DGO THD",257,0 )
  1294    ;     "EL IG","A&A"               Receivin g A&A Bene fits
  1295   "RTN","DGO THD",258,0 )
  1296    ;     "EL IG","HB"                Receivin g Housebou nd Benefit s
  1297   "RTN","DGO THD",259,0 )
  1298    ;     "EL IG","VAPEN "            Receivin g a VA Pen sion
  1299   "RTN","DGO THD",260,0 )
  1300    ;     "EL IG","VACKA MT"          Total An nual VA Ch eck Amount
  1301   "RTN","DGO THD",261,0 )
  1302    ;     "EL IG","DISRE T"           Military  Disabilit y Retireme nt
  1303   "RTN","DGO THD",262,0 )
  1304    ;     "EL IG","DISLO D"           Discharg ed Due to  Disability
  1305   "RTN","DGO THD",263,0 )
  1306    ;     "EL IG","MEDIC AID"         Medicaid
  1307   "RTN","DGO THD",264,0 )
  1308    ;     "EL IG","AO"                Exposed  to Agent O range
  1309   "RTN","DGO THD",265,0 )
  1310    ;     "EL IG","AOEXP LOC"         Agent Or ange Expos ure Locati on
  1311   "RTN","DGO THD",266,0 )
  1312    ;     "EL IG","IR"                Radiatio n Exposure  Indicated
  1313   "RTN","DGO THD",267,0 )
  1314    ;     "EL IG","RADEX PM"          Radiatio n Exposure  Method
  1315   "RTN","DGO THD",268,0 )
  1316    ;     "EL IG","EC"                SW Asia  Cond - was  Env Con,  DG*5.3*688
  1317   "RTN","DGO THD",269,0 )
  1318    ;     "EL IG","MTSTA "            Means Te st Status
  1319   "RTN","DGO THD",270,0 )
  1320    ;     "EL IG","VCD"               Veteran  Catastroph ically Dis abled?
  1321   "RTN","DGO THD",271,0 )
  1322    ;     "EL IG","PH"                Purple H eart Indic ated?
  1323   "RTN","DGO THD",272,0 )
  1324    ;     "EL IG","UNEMP LOY"         Unemploy able
  1325   "RTN","DGO THD",273,0 )
  1326    ;     "EL IG","CVELE DT"          Combat V eteran End  Date
  1327   "RTN","DGO THD",274,0 )
  1328    ;     "EL IG","SHAD"              SHAD Ind icated
  1329   "RTN","DGO THD",275,0 )
  1330    ;     "EL IG","MOH"               Medal of  Honor Ind icated
  1331   "RTN","DGO THD",276,0 )
  1332    ;     "EL IG","CLE"               Camp Lej eune Indic ated?    D G*5.3*909
  1333   "RTN","DGO THD",277,0 )
  1334    ;     "EL IG","CLEDT "            Camp Lej eune Date           D G*5.3*909
  1335   "RTN","DGO THD",278,0 )
  1336    ;     "EL IG","CLEST "            Camp Lej eune Chang e Site   D G*5.3*909
  1337   "RTN","DGO THD",279,0 )
  1338    ;     "EL IG","CLESO R"           Camp Lej eune Sourc e        D G*5.3*909
  1339   "RTN","DGO THD",280,0 )
  1340    ;     "DA TETIME"       Date/Ti me Entered
  1341   "RTN","DGO THD",281,0 )
  1342    ;     "US ER"           Entered  By
  1343   "RTN","DGO THD",282,0 )
  1344    ;DGOTHD
  1345   "RTN","DGO THD1")
  1346   0^4^B25705 30
  1347   "RTN","DGO THD1",1,0)
  1348   DGOTHD1 ;S LC/SS - OT HD (OTHER  THAN HONOR ABLE DISCH ARGE) APIs  ; 12/27/1 7
  1349   "RTN","DGO THD1",2,0)
  1350    ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 30
  1351   "RTN","DGO THD1",3,0)
  1352    ;
  1353   "RTN","DGO THD1",4,0)
  1354    Q
  1355   "RTN","DGO THD1",5,0)
  1356    ;
  1357   "RTN","DGO THD1",6,0)
  1358    ;set 90 d ays clock  with autho rization 
  1359   "RTN","DGO THD1",7,0)
  1360   SETAUTH(DG DFN,DGSTRD T,DG365N,D GCL90N,DGA UDUZ,DGAUD T) ;
  1361   "RTN","DGO THD1",8,0)
  1362    N DGIEN33 ,DGIEN365
  1363   "RTN","DGO THD1",9,0)
  1364    ;does the  patient h ave the cl ock?
  1365   "RTN","DGO THD1",10,0 )
  1366    S DGIEN33 =$$HASCLOC K^DGOTHD2( DGDFN) I D GIEN33'>0  Q -1  ; No  clock rec ord
  1367   "RTN","DGO THD1",11,0 )
  1368    S DGIEN36 5=$$CHCK36 5^DGOTHD2( DGIEN33,DG 365N)
  1369   "RTN","DGO THD1",12,0 )
  1370    I DGIEN36 5<0 Q -1   ; OTH cloc k entry in  the file  #33 doesn' t exist
  1371   "RTN","DGO THD1",13,0 )
  1372    I DGIEN36 5=0 Q -2   ; this 365  clock doe s not exis t
  1373   "RTN","DGO THD1",14,0 )
  1374    ;create 9 0 days clo ck
  1375   "RTN","DGO THD1",15,0 )
  1376    S DGIEN90 =$$CR90CLK ^DGOTHD2(+ DGIEN33,+D GIEN365,DG CL90N,DGST RDT,DGAUDU Z,DGAUDT)
  1377   "RTN","DGO THD1",16,0 )
  1378    ;if error  then retu rn error
  1379   "RTN","DGO THD1",17,0 )
  1380    I DGIEN90 <0 Q DGIEN 90
  1381   "RTN","DGO THD1",18,0 )
  1382    Q 1
  1383   "RTN","DGO THD1",19,0 )
  1384    ;
  1385   "RTN","DGO THD1",20,0 )
  1386    ;
  1387   "RTN","DGO THD1",21,0 )
  1388    ;Set the  very first  clock 
  1389   "RTN","DGO THD1",22,0 )
  1390    ;Paramete rs:
  1391   "RTN","DGO THD1",23,0 )
  1392    ; DGDFN -  patient I EN
  1393   "RTN","DGO THD1",24,0 )
  1394    ; DGSTRTD T - starti ng date
  1395   "RTN","DGO THD1",25,0 )
  1396    ;Return v alues:
  1397   "RTN","DGO THD1",26,0 )
  1398    ; <0 if e rror
  1399   "RTN","DGO THD1",27,0 )
  1400    ; 1 if ev erything w as created  properly
  1401   "RTN","DGO THD1",28,0 )
  1402   FRSTCLCK(D GDFN,DGSTR DT) ;
  1403   "RTN","DGO THD1",29,0 )
  1404    N DGIEN33 ,DGIEN365, DGIEN90
  1405   "RTN","DGO THD1",30,0 )
  1406    ;does the  patient h ave the cl ock?
  1407   "RTN","DGO THD1",31,0 )
  1408    S DGIEN33 =$$HASCLOC K^DGOTHD2( DGDFN) I D GIEN33>0 Q  -2  ; alr eady has c lock
  1409   "RTN","DGO THD1",32,0 )
  1410    ;if not t hen create  it
  1411   "RTN","DGO THD1",33,0 )
  1412    I DGIEN33 =0 S DGIEN 33=$$CROTH CLK^DGOTHD 2(DGDFN)
  1413   "RTN","DGO THD1",34,0 )
  1414    ;if error  then retu rn error
  1415   "RTN","DGO THD1",35,0 )
  1416    I DGIEN33 <0 Q DGIEN 33
  1417   "RTN","DGO THD1",36,0 )
  1418    ;create t he very fi rst 365 da ys clock
  1419   "RTN","DGO THD1",37,0 )
  1420    S DGIEN36 5=$$CR365C LK^DGOTHD2 (+DGIEN33, 1,DGSTRDT)
  1421   "RTN","DGO THD1",38,0 )
  1422    ;if error  then retu rn error
  1423   "RTN","DGO THD1",39,0 )
  1424    I DGIEN36 5<0 Q DGIE N365
  1425   "RTN","DGO THD1",40,0 )
  1426    ;create t he very fi rst 90 day s clock
  1427   "RTN","DGO THD1",41,0 )
  1428    S DGIEN90 =$$CR90CLK ^DGOTHD2(+ DGIEN33,+D GIEN365,1, DGSTRDT)
  1429   "RTN","DGO THD1",42,0 )
  1430    ;if error  then retu rn error
  1431   "RTN","DGO THD1",43,0 )
  1432    I DGIEN90 <0 Q DGIEN 90
  1433   "RTN","DGO THD1",44,0 )
  1434    Q 1
  1435   "RTN","DGO THD1",45,0 )
  1436    ;
  1437   "RTN","DGO THD1",46,0 )
  1438    ;
  1439   "RTN","DGO THD1",47,0 )
  1440    ;
  1441   "RTN","DGO THD1",48,0 )
  1442    ;DGOTHD1
  1443   "RTN","DGO THD2")
  1444   0^5^B28792 989
  1445   "RTN","DGO THD2",1,0)
  1446   DGOTHD2 ;S LC/SS - OT HD (OTHER  THAN HONOR ABLE DISCH ARGE) APIs  ; 12/27/1 7
  1447   "RTN","DGO THD2",2,0)
  1448    ;;5.3;Reg istration; **952**;Au g 13, 1993 ;Build 30
  1449   "RTN","DGO THD2",3,0)
  1450    ;
  1451   "RTN","DGO THD2",4,0)
  1452    Q
  1453   "RTN","DGO THD2",5,0)
  1454    ;
  1455   "RTN","DGO THD2",6,0)
  1456    ;create t he new OTH  clock
  1457   "RTN","DGO THD2",7,0)
  1458    ;DGDFN -  patient's  IEN
  1459   "RTN","DGO THD2",8,0)
  1460    ;returns 
  1461   "RTN","DGO THD2",9,0)
  1462    ;IEN of t he file #3 3
  1463   "RTN","DGO THD2",10,0 )
  1464    ;or -1^er ror messag e
  1465   "RTN","DGO THD2",11,0 )
  1466   CROTHCLK(D GDFN) ;
  1467   "RTN","DGO THD2",12,0 )
  1468    N DGVALS, DGIEN33
  1469   "RTN","DGO THD2",13,0 )
  1470    I $$CHCKP AT(DGDFN)' >0 Q -2  ; patient do es not exi st
  1471   "RTN","DGO THD2",14,0 )
  1472    S DGVALS( .01)=DGDFN
  1473   "RTN","DGO THD2",15,0 )
  1474    S DGVALS( .02)=1 ;se t to ACTIV E
  1475   "RTN","DGO THD2",16,0 )
  1476    S DGVALS( .03)=0 ;VB A ADJUDICA TION not c ompleted
  1477   "RTN","DGO THD2",17,0 )
  1478    S DGVALS( .04)=$S($G (DUZ)>0:+D UZ,1:.5) ; the user,  otherwise  - POSTMAST ER
  1479   "RTN","DGO THD2",18,0 )
  1480    S DGVALS( .05)=$$NOW ^XLFDT() ; now
  1481   "RTN","DGO THD2",19,0 )
  1482    S DGIEN=$ $INSREC(33 ,"",.DGVAL S)
  1483   "RTN","DGO THD2",20,0 )
  1484    Q DGIEN
  1485   "RTN","DGO THD2",21,0 )
  1486    ;
  1487   "RTN","DGO THD2",22,0 )
  1488    ;create t he new 365  days cloc k
  1489   "RTN","DGO THD2",23,0 )
  1490    ;DGIEN33  - IEN of t he file #3 3
  1491   "RTN","DGO THD2",24,0 )
  1492    ;CLCKNO -  clock #
  1493   "RTN","DGO THD2",25,0 )
  1494    ;DGSTRDT  - start da te
  1495   "RTN","DGO THD2",26,0 )
  1496   CR365CLK(D GIEN33,CLC KNO,DGSTRD T) ;
  1497   "RTN","DGO THD2",27,0 )
  1498    N IEN365, DGVALS
  1499   "RTN","DGO THD2",28,0 )
  1500    S IEN365= $$CHCK365( DGIEN33,CL CKNO)
  1501   "RTN","DGO THD2",29,0 )
  1502    I IEN365< 0 Q -1  ;  OTH clock  entry in t he file #3 3 doesn't  exist
  1503   "RTN","DGO THD2",30,0 )
  1504    I IEN365> 0 Q -2  ;  this 365 c lock alrea dy exists
  1505   "RTN","DGO THD2",31,0 )
  1506    S DGVALS( .01)=CLCKN O
  1507   "RTN","DGO THD2",32,0 )
  1508    S DGVALS( .02)=DGSTR DT ;start  date
  1509   "RTN","DGO THD2",33,0 )
  1510    S DGVALS( .05)=$S($G (DUZ)>0:+D UZ,1:.5) ; the user,  otherwise  - POSTMAST ER
  1511   "RTN","DGO THD2",34,0 )
  1512    S DGVALS( .06)=$$NOW ^XLFDT() ; now
  1513   "RTN","DGO THD2",35,0 )
  1514    S DGIEN=$ $INSREC(33 .01,DGIEN3 3,.DGVALS)
  1515   "RTN","DGO THD2",36,0 )
  1516    Q DGIEN
  1517   "RTN","DGO THD2",37,0 )
  1518    ;
  1519   "RTN","DGO THD2",38,0 )
  1520    ;create t he new 90  days clock
  1521   "RTN","DGO THD2",39,0 )
  1522    ;DGIEN33  - ien file  #33
  1523   "RTN","DGO THD2",40,0 )
  1524    ;DGI3301  - ien subf ile #33.01
  1525   "RTN","DGO THD2",41,0 )
  1526    ;CLCKNO -  90 days c lock #
  1527   "RTN","DGO THD2",42,0 )
  1528    ;DGSTRDT  - start da te, if neg ative or z ero then d o not set  the start  date
  1529   "RTN","DGO THD2",43,0 )
  1530    ;DGAUDUZ  - authoriz ation user
  1531   "RTN","DGO THD2",44,0 )
  1532    ;DGAUDT -  authoriza tion date
  1533   "RTN","DGO THD2",45,0 )
  1534   CR90CLK(DG IEN33,DGI3 301,CLCKNO ,DGSTRDT,D GAUDUZ,DGA UDT) ;
  1535   "RTN","DGO THD2",46,0 )
  1536    N IEN90,D GVALS
  1537   "RTN","DGO THD2",47,0 )
  1538    S IEN90=$ $CHCK90(DG IEN33,DGI3 301,CLCKNO )
  1539   "RTN","DGO THD2",48,0 )
  1540    I IEN90<0  Q -1  ; O TH clock e ntry in th e file #33  doesn't e xist
  1541   "RTN","DGO THD2",49,0 )
  1542    I IEN90>0  Q -2  ; t his 90 clo ck already  exists
  1543   "RTN","DGO THD2",50,0 )
  1544    S DGVALS( .01)=CLCKN O
  1545   "RTN","DGO THD2",51,0 )
  1546    I DGSTRDT >0 S DGVAL S(.02)=DGS TRDT ;star t date
  1547   "RTN","DGO THD2",52,0 )
  1548    I $G(DGAU DUZ)>0 S D GVALS(.03) =+DGAUDUZ  ;the autho rized user
  1549   "RTN","DGO THD2",53,0 )
  1550    I $G(DGAU DT)>0 S DG VALS(.04)= DGAUDT ;
  1551   "RTN","DGO THD2",54,0 )
  1552    S DGVALS( .05)=$S($G (DUZ)>0:+D UZ,1:.5) ; the user,  otherwise  - POSTMAST ER
  1553   "RTN","DGO THD2",55,0 )
  1554    S DGVALS( .06)=$$NOW ^XLFDT() ; now
  1555   "RTN","DGO THD2",56,0 )
  1556    S DGIEN=$ $INSREC(33 .11,DGI330 1_","_DGIE N33,.DGVAL S)
  1557   "RTN","DGO THD2",57,0 )
  1558    Q DGIEN
  1559   "RTN","DGO THD2",58,0 )
  1560    ;
  1561   "RTN","DGO THD2",59,0 )
  1562    ;check if  the patie nt has 2nd  period au thorizatio n
  1563   "RTN","DGO THD2",60,0 )
  1564    ;DGIEN33  - ien file  #33
  1565   "RTN","DGO THD2",61,0 )
  1566    ;DGI3301  - ien subf ile #33.01
  1567   "RTN","DGO THD2",62,0 )
  1568    ;CLCKNO -  90 days c lock #
  1569   "RTN","DGO THD2",63,0 )
  1570   HAS2AUTH(D GIEN33,DGI 3301,CLCKN O) ;
  1571   "RTN","DGO THD2",64,0 )
  1572    N DGIEN90 ,DGRETDAT
  1573   "RTN","DGO THD2",65,0 )
  1574    S DGIEN90 =$$CHCK90( DGIEN33,DG I3301,CLCK NO)
  1575   "RTN","DGO THD2",66,0 )
  1576    I DGIEN90 '>0 Q -1   ; OTH cloc k entry in  the file  #33 doesn' t exist
  1577   "RTN","DGO THD2",67,0 )
  1578    S DGRETDA T=$G(^DGOT H(33,DGIEN 33,1,DGI33 01,1,DGIEN 90,0))
  1579   "RTN","DGO THD2",68,0 )
  1580    Q $P(DGRE TDAT,U,3,4 )
  1581   "RTN","DGO THD2",69,0 )
  1582    ;
  1583   "RTN","DGO THD2",70,0 )
  1584    ;does the  patient h ave clock?
  1585   "RTN","DGO THD2",71,0 )
  1586    ;DGDFN -  patient IE N
  1587   "RTN","DGO THD2",72,0 )
  1588   HASCLOCK(D GDFN) ;
  1589   "RTN","DGO THD2",73,0 )
  1590    Q +$O(^DG OTH(33,"B" ,DGDFN,0))
  1591   "RTN","DGO THD2",74,0 )
  1592    ;
  1593   "RTN","DGO THD2",75,0 )
  1594    ;how many  365 days  clock the  patient ha s?
  1595   "RTN","DGO THD2",76,0 )
  1596    ;DGIEN33  - ien of # 33
  1597   "RTN","DGO THD2",77,0 )
  1598   CLCKS365(D GIEN33) ;
  1599   "RTN","DGO THD2",78,0 )
  1600    Q $O(^DGO TH(33,DGIE N33,1,"B", 99),-1)
  1601   "RTN","DGO THD2",79,0 )
  1602    ;
  1603   "RTN","DGO THD2",80,0 )
  1604    ;returns 
  1605   "RTN","DGO THD2",81,0 )
  1606    ;-1 : if  OTH clock  entry in t he file #3 3 doesn't  exist
  1607   "RTN","DGO THD2",82,0 )
  1608    ;0  : if  365 days c lock with  the number  CLCKNO do esn't exis t
  1609   "RTN","DGO THD2",83,0 )
  1610    ;>0 : IEN  of the 36 5 days clo ck with th e number C LCKNO
  1611   "RTN","DGO THD2",84,0 )
  1612   CHCK365(DG IEN33,CLCK NO) ;
  1613   "RTN","DGO THD2",85,0 )
  1614    I +$D(^DG OTH(33,DGI EN33,0))'> 0 Q -1  ;c lock doesn 't exist
  1615   "RTN","DGO THD2",86,0 )
  1616    Q +$O(^DG OTH(33,DGI EN33,1,"B" ,CLCKNO,0) )
  1617   "RTN","DGO THD2",87,0 )
  1618    ;
  1619   "RTN","DGO THD2",88,0 )
  1620    ;returns 
  1621   "RTN","DGO THD2",89,0 )
  1622    ;-1 : if  OTH clock  entry in t he file #3 3 doesn't  exist
  1623   "RTN","DGO THD2",90,0 )
  1624    ;0  : if  90 days cl ock with t he number  CLCKNO doe sn't exist
  1625   "RTN","DGO THD2",91,0 )
  1626    ;>0 : IEN  of the 90  days cloc k with the  number CL CKNO
  1627   "RTN","DGO THD2",92,0 )
  1628   CHCK90(DGI EN33,DGI33 01,CLCKNO)  ;
  1629   "RTN","DGO THD2",93,0 )
  1630    I +$D(^DG OTH(33,DGI EN33,0))'> 0 Q -1  ;c lock doesn 't exist
  1631   "RTN","DGO THD2",94,0 )
  1632    I +$D(^DG OTH(33,DGI EN33,1,DGI 3301,0))'> 0 Q -1  ;c lock doesn 't exist
  1633   "RTN","DGO THD2",95,0 )
  1634    Q +$O(^DG OTH(33,DGI EN33,1,DGI 3301,1,"B" ,CLCKNO,0) )
  1635   "RTN","DGO THD2",96,0 )
  1636    ;check DF N
  1637   "RTN","DGO THD2",97,0 )
  1638   CHCKPAT(DG DFN) ;
  1639   "RTN","DGO THD2",98,0 )
  1640    Q +$D(^DP T(DGDFN,0) )
  1641   "RTN","DGO THD2",99,0 )
  1642    ;
  1643   "RTN","DGO THD2",100, 0)
  1644    ;get pati ent IEN by  ien of th e file #33
  1645   "RTN","DGO THD2",101, 0)
  1646   GETPAT(DGI EN33) ;
  1647   "RTN","DGO THD2",102, 0)
  1648    Q $P($G(^ DGOTH(33,D GIEN33,0)) ,U)
  1649   "RTN","DGO THD2",103, 0)
  1650    ;
  1651   "RTN","DGO THD2",104, 0)
  1652    ;input:
  1653   "RTN","DGO THD2",105, 0)
  1654    ;DGPROM -  prompt te xt
  1655   "RTN","DGO THD2",106, 0)
  1656    ;DGDFVL -  default v alue (opti onal)
  1657   "RTN","DGO THD2",107, 0)
  1658    ;returns:
  1659   "RTN","DGO THD2",108, 0)
  1660    ; "respon se^"
  1661   "RTN","DGO THD2",109, 0)
  1662   PROMPT(DGP ROM,DGDFVL ) ;
  1663   "RTN","DGO THD2",110, 0)
  1664    N DGRET,D IR,X,Y,DIR UT,DIROUT, DTOUT,DUOU T
  1665   "RTN","DGO THD2",111, 0)
  1666    S DGRET=" ^"
  1667   "RTN","DGO THD2",112, 0)
  1668    S DIR(0)= "F^::2",DI R("A")=DGP ROM
  1669   "RTN","DGO THD2",113, 0)
  1670    I $L($G(D GDFVL))>0  S DIR("B") =$G(DGDFVL )
  1671   "RTN","DGO THD2",114, 0)
  1672    D ^DIR I  $D(DIRUT)  Q "^"
  1673   "RTN","DGO THD2",115, 0)
  1674    S $P(DGRE T,U)=Y
  1675   "RTN","DGO THD2",116, 0)
  1676    Q DGRET
  1677   "RTN","DGO THD2",117, 0)
  1678    ;
  1679   "RTN","DGO THD2",118, 0)
  1680   ASKDT(DGPR OM,DGDFVL)  ;
  1681   "RTN","DGO THD2",119, 0)
  1682    N DIRUT,D IROUT,DUOU T,DTOUT,Y
  1683   "RTN","DGO THD2",120, 0)
  1684    S DIR(0)= "DA^::EX", DIR("A")=D GPROM
  1685   "RTN","DGO THD2",121, 0)
  1686    S DIR("B" )=DGDFVL
  1687   "RTN","DGO THD2",122, 0)
  1688    D ^DIR
  1689   "RTN","DGO THD2",123, 0)
  1690    Q:$D(DUOU T)!($D(DTO UT)) "^"
  1691   "RTN","DGO THD2",124, 0)
  1692    Q Y\1
  1693   "RTN","DGO THD2",125, 0)
  1694    ;
  1695   "RTN","DGO THD2",126, 0)
  1696    ; Ask
  1697   "RTN","DGO THD2",127, 0)
  1698    ; Input:
  1699   "RTN","DGO THD2",128, 0)
  1700    ;  DGQSTR  - questio n
  1701   "RTN","DGO THD2",129, 0)
  1702    ;  DGDFL  - default  answer
  1703   "RTN","DGO THD2",130, 0)
  1704    ; Output:  
  1705   "RTN","DGO THD2",131, 0)
  1706    ; 1 YES
  1707   "RTN","DGO THD2",132, 0)
  1708    ; 0 NO
  1709   "RTN","DGO THD2",133, 0)
  1710    ; -1 if c ancelled
  1711   "RTN","DGO THD2",134, 0)
  1712   YESNO(DGQS TR,DGDFL)  ; Default  - YES
  1713   "RTN","DGO THD2",135, 0)
  1714    N DIR,Y,D UOUT,DIROU T,DIRUT,DT OUT
  1715   "RTN","DGO THD2",136, 0)
  1716    S DIR(0)= "Y"
  1717   "RTN","DGO THD2",137, 0)
  1718    S DIR("A" )=DGQSTR
  1719   "RTN","DGO THD2",138, 0)
  1720    S:$L($G(D GDFL)) DIR ("B")=DGDF L
  1721   "RTN","DGO THD2",139, 0)
  1722    D ^DIR
  1723   "RTN","DGO THD2",140, 0)
  1724    Q $S($G(D UOUT)!$G(D UOUT)!(Y=" ^"):-1,1:Y )
  1725   "RTN","DGO THD2",141, 0)
  1726    ;
  1727   "RTN","DGO THD2",142, 0)
  1728    ;
  1729   "RTN","DGO THD2",143, 0)
  1730    ;date in  external f ormat
  1731   "RTN","DGO THD2",144, 0)
  1732   DATE(X) ; 
  1733   "RTN","DGO THD2",145, 0)
  1734    N Y S Y=" " I $G(X)? 7N.E S Y=$ E(X,4,5)_" /"_$E(X,6, 7)_"/"_$E( X,2,3)
  1735   "RTN","DGO THD2",146, 0)
  1736    Q Y
  1737   "RTN","DGO THD2",147, 0)
  1738    ;
  1739   "RTN","DGO THD2",148, 0)
  1740    ;This pro cedure is  used to pe rform a pa tient look up for an  existing p atient in  the (#33)  file.
  1741   "RTN","DGO THD2",149, 0)
  1742    ;Paramete rs: 
  1743   "RTN","DGO THD2",150, 0)
  1744    ;  None
  1745   "RTN","DGO THD2",151, 0)
  1746    ;Returns:
  1747   "RTN","DGO THD2",152, 0)
  1748    ; in DGPA T array wh ere
  1749   "RTN","DGO THD2",153, 0)
  1750    ;  DGPAT  = IEN of p atient in  PATIENT (# 33) file o n success,  -1 on fai lure
  1751   "RTN","DGO THD2",154, 0)
  1752    ;  DGPAT( 0) = zero  node of en try select ed
  1753   "RTN","DGO THD2",155, 0)
  1754    ; return  value IEN  of patient  in PATIEN T (#33) fi le on succ ess, -1 on  failure
  1755   "RTN","DGO THD2",156, 0)
  1756   SELPAT(DGP AT) ;
  1757   "RTN","DGO THD2",157, 0)
  1758    ;- int in put vars f or ^DIC ca ll
  1759   "RTN","DGO THD2",158, 0)
  1760    N DIC,DTO UT,DUPOT,X ,Y
  1761   "RTN","DGO THD2",159, 0)
  1762    S DIC="^D GOTH(33,", DIC(0)="AE MQZV"
  1763   "RTN","DGO THD2",160, 0)
  1764    ;screen o ut all tha t are not  ACTIVE
  1765   "RTN","DGO THD2",161, 0)
  1766    S DIC("S" )="I $P(^( 0),U,2)=1"
  1767   "RTN","DGO THD2",162, 0)
  1768    ;- lookup  patient
  1769   "RTN","DGO THD2",163, 0)
  1770    D ^DIC K  DIC
  1771   "RTN","DGO THD2",164, 0)
  1772    ;- result  of lookup
  1773   "RTN","DGO THD2",165, 0)
  1774    S DGPAT=Y
  1775   "RTN","DGO THD2",166, 0)
  1776    ;- if suc cess, setu p return a rray using  output va rs from ^D IC call
  1777   "RTN","DGO THD2",167, 0)
  1778    I (+DGPAT >0) D  Q + Y
  1779   "RTN","DGO THD2",168, 0)
  1780    . S DGPAT =+Y               ;pa tient ien
  1781   "RTN","DGO THD2",169, 0)
  1782    . S DGPAT (0)=$G(Y(0 ))     ;ze ro node of  patient i n (#33) fi le
  1783   "RTN","DGO THD2",170, 0)
  1784    Q -1
  1785   "RTN","DGO THD2",171, 0)
  1786    ;
  1787   "RTN","DGO THD2",172, 0)
  1788    ;/**
  1789   "RTN","DGO THD2",173, 0)
  1790    ;Creates  a new entr y (or node  for multi ple with . 01 field)
  1791   "RTN","DGO THD2",174, 0)
  1792    ;
  1793   "RTN","DGO THD2",175, 0)
  1794    ;DGFILE -  file/subf ile number
  1795   "RTN","DGO THD2",176, 0)
  1796    ;DGIEN -  ien of the  parent fi le entry i n which th e new subf ile entry  will be in serted
  1797   "RTN","DGO THD2",177, 0)
  1798    ;DGZFDA -  array wit h values f or the fie lds
  1799   "RTN","DGO THD2",178, 0)
  1800    ; format  for DGZFDA :
  1801   "RTN","DGO THD2",179, 0)
  1802    ; DGZFDA( .01)=value  for #.01  field
  1803   "RTN","DGO THD2",180, 0)
  1804    ; DGZFDA( 3)=value f or #3 fiel d
  1805   "RTN","DGO THD2",181, 0)
  1806    ;DGRECNO  -(optional ) specify  IEN if you  want spec ific value
  1807   "RTN","DGO THD2",182, 0)
  1808    ; Note: " " then the  system wi ll assign  the entry  number its elf.
  1809   "RTN","DGO THD2",183, 0)
  1810    ;DGFLGS -  FLAGS par ameter for  UPDATE^DI E
  1811   "RTN","DGO THD2",184, 0)
  1812    ;DGLCKGL  - fully sp ecified gl obal refer ence to lo ck
  1813   "RTN","DGO THD2",185, 0)
  1814    ;DGLCKTM  - time out  for LOCK,  if LOCKTI ME=0 then  the functi on will no t lock the  file 
  1815   "RTN","DGO THD2",186, 0)
  1816    ;DGNEWRE  - optional , flag = i f 1 then a llow to cr eate a new  top level  record 
  1817   "RTN","DGO THD2",187, 0)
  1818    ;  
  1819   "RTN","DGO THD2",188, 0)
  1820    ;output :
  1821   "RTN","DGO THD2",189, 0)
  1822    ; positiv e number -  record #  created
  1823   "RTN","DGO THD2",190, 0)
  1824    ; <=0 - f ailure^err or message
  1825   "RTN","DGO THD2",191, 0)
  1826    ;
  1827   "RTN","DGO THD2",192, 0)
  1828    ;Example:
  1829   "RTN","DGO THD2",193, 0)
  1830    ;top leve l:
  1831   "RTN","DGO THD2",194, 0)
  1832    ;S DGVALS (.01)="OTH D" W $$INS REC^DG5395 2(8.1,"",. DGVALS,,,, ,1)
  1833   "RTN","DGO THD2",195, 0)
  1834    ;2nd leve l:
  1835   "RTN","DGO THD2",196, 0)
  1836    ;K DGVALS  S DGVALS( .01)=1 W $ $INSREC^DG OTHD2(33.0 1,"8",.DGV ALS)
  1837   "RTN","DGO THD2",197, 0)
  1838    ;3rd leve l:
  1839   "RTN","DGO THD2",198, 0)
  1840    ;K DGVALS  S DGVALS( .01)=1 W $ $INSREC^DG OTHD2(33.1 1,"1,8",.D GVALS)
  1841   "RTN","DGO THD2",199, 0)
  1842   INSREC(DGF ILE,DGIEN, DGZFDA,DGR ECNO,DGFLG S,DGLCKGL, DGLCKTM,DG NEWRE) ;*/
  1843   "RTN","DGO THD2",200, 0)
  1844    I ('$G(DG FILE)) Q " 0^Invalid  parameter"
  1845   "RTN","DGO THD2",201, 0)
  1846    I +$G(DGN EWRE)=0 I  $G(DGRECNO )>0,'$G(DG IEN) Q "0^ Invalid pa rameter"
  1847   "RTN","DGO THD2",202, 0)
  1848    N DGSSI,D GIENS,DGER R,DGFDA,DI ERR
  1849   "RTN","DGO THD2",203, 0)
  1850    N DGLOCK  S DGLOCK=0
  1851   "RTN","DGO THD2",204, 0)
  1852    I '$G(DGR ECNO) N DG RECNO S DG RECNO=$G(D GRECNO)
  1853   "RTN","DGO THD2",205, 0)
  1854    I DGIEN'= "" S DGIEN S="+1,"_DG IEN_"," I  $L(DGRECNO )>0 S DGSS I(1)=+DGRE CNO
  1855   "RTN","DGO THD2",206, 0)
  1856    I DGIEN=" " S DGIENS ="+1," I $ L(DGRECNO) >0 S DGSSI (1)=+DGREC NO
  1857   "RTN","DGO THD2",207, 0)
  1858    M DGFDA(D GFILE,DGIE NS)=DGZFDA
  1859   "RTN","DGO THD2",208, 0)
  1860    I $L($G(D GLCKGL)) L  +@DGLCKGL :(+$G(DGLC KTM)) S DG LOCK=$T I  'DGLOCK Q  -2  ;lock  failure
  1861   "RTN","DGO THD2",209, 0)
  1862    D UPDATE^ DIE($G(DGF LGS),"DGFD A","DGSSI" ,"DGERR")
  1863   "RTN","DGO THD2",210, 0)
  1864    I DGLOCK  L -@DGLCKG L
  1865   "RTN","DGO THD2",211, 0)
  1866    I $D(DGER R) Q "-1^" _$G(DGERR( "DIERR",1, "TEXT",1), "Update Er ror")
  1867   "RTN","DGO THD2",212, 0)
  1868    Q +$G(DGS SI(1))
  1869   "RTN","DGO THD2",213, 0)
  1870    ;
  1871   "RTN","DGO THD2",214, 0)
  1872    ;DGOTHD2
  1873   "SEC","^DI C",33,33,0 ,"AUDIT")
  1874   @
  1875   "SEC","^DI C",33,33,0 ,"DD")
  1876   @
  1877   "SEC","^DI C",33,33,0 ,"DEL")
  1878   @
  1879   "SEC","^DI C",33,33,0 ,"LAYGO")
  1880   @
  1881   "SEC","^DI C",33,33,0 ,"RD")
  1882   @
  1883   "SEC","^DI C",33,33,0 ,"WR")
  1884   @
  1885   "VER")
  1886   8.0^22.2
  1887   "^DD",8,8, 12,0)
  1888   ADDITIONAL  ONLY^S^0: NO;1:YES;^ 0;13^Q
  1889   "^DD",8,8, 12,3)
  1890   Answer YES  if the el igibility  can only b e used as  an additio nal eligib ility and  never as a  primary.
  1891   "^DD",8,8, 12,21,0)
  1892   ^^4^4^3180 123^
  1893   "^DD",8,8, 12,21,1,0)
  1894   Answer YES  if the el igibility  can only b e used as  an additio nal
  1895   "^DD",8,8, 12,21,2,0)
  1896   eligibilit y and neve r can be u sed as a p rimary eli gibility. 
  1897   "^DD",8,8, 12,21,3,0)
  1898   Answer NO  or leave t he field b lank if th e eligibil ity can be  used for  both
  1899   "^DD",8,8, 12,21,4,0)
  1900   primary an d addition al eligibi lity.
  1901   "^DD",8,8, 12,"DT")
  1902   3180122
  1903   "^DD",8.1, 8.1,0)
  1904   FIELD^NL^7 ^8
  1905   "^DD",8.1, 8.1,0,"DDA ")
  1906   N
  1907   "^DD",8.1, 8.1,0,"DT" )
  1908   3180309
  1909   "^DD",8.1, 8.1,0,"ID" ,3)
  1910   W:$D(^("0" )) ?35,$P( ^("0"),U,4 )
  1911   "^DD",8.1, 8.1,0,"IX" ,"B",8.1,. 01)
  1912  
  1913   "^DD",8.1, 8.1,0,"IX" ,"C",8.1,3 )
  1914  
  1915   "^DD",8.1, 8.1,0,"NM" ,"MAS ELIG IBILITY CO DE")
  1916  
  1917   "^DD",8.1, 8.1,0,"PT" ,8,8)
  1918  
  1919   "^DD",8.1, 8.1,0,"PT" ,27.11,50. 01)
  1920  
  1921   "^DD",8.1, 8.1,0,"PT" ,375,2.07)
  1922  
  1923   "^DD",8.1, 8.1,0,"VRP K")
  1924   DG
  1925   "^DD",8.1, 8.1,.01,0)
  1926   NAME^RFJ30 I^^0;1^K:$ L(X)>30!($ L(X)<3)!'( X'?1P.E) X
  1927   "^DD",8.1, 8.1,.01,1, 0)
  1928   ^.1
  1929   "^DD",8.1, 8.1,.01,1, 1,0)
  1930   8.1^B
  1931   "^DD",8.1, 8.1,.01,1, 1,1)
  1932   S ^DIC(8.1 ,"B",$E(X, 1,30),DA)= ""
  1933   "^DD",8.1, 8.1,.01,1, 1,2)
  1934   K ^DIC(8.1 ,"B",$E(X, 1,30),DA)
  1935   "^DD",8.1, 8.1,.01,3)
  1936   Answer mus t be 3-30  characters  in length .
  1937   "^DD",8.1, 8.1,.01,21 ,0)
  1938   ^.001^1^1^ 3171227^^^ ^
  1939   "^DD",8.1, 8.1,.01,21 ,1,0)
  1940   This is th e official  name of t he MAS eli gibility c ode.
  1941   "^DD",8.1, 8.1,.01,"D EL",1,0)
  1942   I 1 W !?5, "Deleting  a MAS ELIG IBILITY fi le entry i s not allo wed"
  1943   "^DD",8.1, 8.1,.01,"D T")
  1944   3180123
  1945   "^DD",8.1, 8.1,.01,"L AYGO",1,0)
  1946   W !?5,*7," Adding ent ries to th e MAS ELIG IBILITY fi le is not  allowed??"  I 0
  1947   "^DD",8.1, 8.1,1,0)
  1948   CARD COLOR ^RS^P:PURP LE;B:BLUE; R:RED;^0;2 ^Q
  1949   "^DD",8.1, 8.1,1,21,0 )
  1950   ^^2^2^2891 018^
  1951   "^DD",8.1, 8.1,1,21,1 ,0)
  1952   This field  indicates  the color  of the pa tient's ca rd for the
  1953   "^DD",8.1, 8.1,1,21,2 ,0)
  1954   MAS eligib ility.
  1955   "^DD",8.1, 8.1,1,"DT" )
  1956   2961023
  1957   "^DD",8.1, 8.1,2,0)
  1958   ABBREVIATI ON^FI^^0;3 ^K:$L(X)>4 !($L(X)<1)  X
  1959   "^DD",8.1, 8.1,2,3)
  1960   ANSWER MUS T BE 1-4 C HARACTERS  IN LENGTH
  1961   "^DD",8.1, 8.1,2,21,0 )
  1962   ^^3^3^2910 415^
  1963   "^DD",8.1, 8.1,2,21,1 ,0)
  1964   This field  may conta in an abbr eviation f or the eli gibility
  1965   "^DD",8.1, 8.1,2,21,2 ,0)
  1966   name.  It  may be use d in place  of the na me in sele cted
  1967   "^DD",8.1, 8.1,2,21,3 ,0)
  1968   prints.
  1969   "^DD",8.1, 8.1,2,"DT" )
  1970   3180123
  1971   "^DD",8.1, 8.1,3,0)
  1972   VA CODE NU MBER^RNJ2, 0I^^0;4^K: +X'=X!(X>1 0)!(X<1)!( X?.E1"."1N .N) X
  1973   "^DD",8.1, 8.1,3,1,0)
  1974   ^.1
  1975   "^DD",8.1, 8.1,3,1,1, 0)
  1976   8.1^C
  1977   "^DD",8.1, 8.1,3,1,1, 1)
  1978   S ^DIC(8.1 ,"C",$E(X, 1,30),DA)= ""
  1979   "^DD",8.1, 8.1,3,1,1, 2)
  1980   K ^DIC(8.1 ,"C",$E(X, 1,30),DA)
  1981   "^DD",8.1, 8.1,3,3)
  1982   Type a Num ber betwee n 1 and 10 , 0 Decima l Digits
  1983   "^DD",8.1, 8.1,3,21,0 )
  1984   ^^2^2^2910 415^
  1985   "^DD",8.1, 8.1,3,21,1 ,0)
  1986   This field  contains  the VA COD E NUMBER t hat has be en assigne d
  1987   "^DD",8.1, 8.1,3,21,2 ,0)
  1988   to this el igibility.
  1989   "^DD",8.1, 8.1,3,"DT" )
  1990   2970730
  1991   "^DD",8.1, 8.1,4,0)
  1992   TYPE^RSI^N :NON-VETER AN;Y:VETER AN;^0;5^Q
  1993   "^DD",8.1, 8.1,4,21,0 )
  1994   ^^3^3^2970 723^^
  1995   "^DD",8.1, 8.1,4,21,1 ,0)
  1996   This field  indicates  the type  of patient  that can  be assigne d
  1997   "^DD",8.1, 8.1,4,21,2 ,0)
  1998   this eligi bility. Th e patient  is either  a 'veteran ' or a
  1999   "^DD",8.1, 8.1,4,21,3 ,0)
  2000   'non-veter an' type.
  2001   "^DD",8.1, 8.1,4,"DT" )
  2002   3180123
  2003   "^DD",8.1, 8.1,5,0)
  2004   PRINT NAME ^RFI^^0;6^ K:$L(X)>25 !($L(X)<1)  X
  2005   "^DD",8.1, 8.1,5,3)
  2006   Enter abbr eviated El igibility  Code name  for ouput  in limited  space.
  2007   "^DD",8.1, 8.1,5,21,0 )
  2008   ^^2^2^2910 415^
  2009   "^DD",8.1, 8.1,5,21,1 ,0)
  2010   This field  contains  a shorten  eligibilit y name tha t is used  for
  2011   "^DD",8.1, 8.1,5,21,2 ,0)
  2012   output tha t has limi ted space  to print.
  2013   "^DD",8.1, 8.1,5,"DT" )
  2014   2891018
  2015   "^DD",8.1, 8.1,6,0)
  2016   INACTIVE^S I^1:YES;^0 ;7^Q
  2017   "^DD",8.1, 8.1,6,21,0 )
  2018   ^^2^2^2910 415^
  2019   "^DD",8.1, 8.1,6,21,1 ,0)
  2020   If the eli gibility i s inactive  then this  field wil l be set t o
  2021   "^DD",8.1, 8.1,6,21,2 ,0)
  2022   'YES'.
  2023   "^DD",8.1, 8.1,6,"DT" )
  2024   2920504
  2025   "^DD",8.1, 8.1,7,0)
  2026   SELECT AS  ADDITIONAL ^SI^0:NO;1 :YES;^0;8^ Q
  2027   "^DD",8.1, 8.1,7,21,0 )
  2028   ^^8^8^2910 415^
  2029   "^DD",8.1, 8.1,7,21,1 ,0)
  2030   This field  indicates  whether p atients ma y be assig ned this e ligibility
  2031   "^DD",8.1, 8.1,7,21,2 ,0)
  2032   as an 'add itional' e ligibility .
  2033   "^DD",8.1, 8.1,7,21,3 ,0)
  2034    
  2035   "^DD",8.1, 8.1,7,21,4 ,0)
  2036   If the fie ld is set  to 'NO' or  is not fi lled in, t hen the el igibility  can
  2037   "^DD",8.1, 8.1,7,21,5 ,0)
  2038   only be as signed as  a primary  eligibilit y.
  2039   "^DD",8.1, 8.1,7,21,6 ,0)
  2040    
  2041   "^DD",8.1, 8.1,7,21,7 ,0)
  2042   If set to  'YES', the n the elig ibility ca n be used  as both a
  2043   "^DD",8.1, 8.1,7,21,8 ,0)
  2044   primary an d an 'addi tional' el igibility.
  2045   "^DD",8.1, 8.1,7,"DT" )
  2046   2910604
  2047   "^DD",33,3 3,0)
  2048   FIELD^^.05 ^6
  2049   "^DD",33,3 3,0,"DT")
  2050   3180309
  2051   "^DD",33,3 3,0,"IX"," B",33,.01)
  2052  
  2053   "^DD",33,3 3,0,"NM"," OTH ELIGIB ILITY CLOC K")
  2054  
  2055   "^DD",33,3 3,0,"VRPK" )
  2056   DG
  2057   "^DD",33,3 3,.01,0)
  2058   PATIENT^RP 2'^DPT(^0; 1^Q
  2059   "^DD",33,3 3,.01,1,0)
  2060   ^.1
  2061   "^DD",33,3 3,.01,1,1, 0)
  2062   33^B
  2063   "^DD",33,3 3,.01,1,1, 1)
  2064   S ^DGOTH(3 3,"B",$E(X ,1,30),DA) =""
  2065   "^DD",33,3 3,.01,1,1, 2)
  2066   K ^DGOTH(3 3,"B",$E(X ,1,30),DA)
  2067   "^DD",33,3 3,.01,3)
  2068   Select the  patient w ith OTH el igibility  clock.
  2069   "^DD",33,3 3,.01,21,0 )
  2070   ^.001^2^2^ 3180207^^
  2071   "^DD",33,3 3,.01,21,1 ,0)
  2072   Patient wi th OTH 90  DAYS ELIGI BILITY tha t receives  mental he alth care  in 
  2073   "^DD",33,3 3,.01,21,2 ,0)
  2074   the VA fac ility.
  2075   "^DD",33,3 3,.01,23,0 )
  2076   ^.001^1^1^ 3180207^^^ ^
  2077   "^DD",33,3 3,.01,23,1 ,0)
  2078   Pointer to  the PATIE NT file (# 2).
  2079   "^DD",33,3 3,.01,"DT" )
  2080   3180207
  2081   "^DD",33,3 3,.02,0)
  2082   STATUS^S^0 :INACTIVE; 1:ACTIVE;2 :PENDING A UTHORIZATI ON;^0;2^Q
  2083   "^DD",33,3 3,.02,3)
  2084   Enter stat us of the  OTH clock  for the pa tient.
  2085   "^DD",33,3 3,.02,21,0 )
  2086   ^.001^1^1^ 3180206^^
  2087   "^DD",33,3 3,.02,21,1 ,0)
  2088   The curren t status o f the OTH  clock for  the patien t.
  2089   "^DD",33,3 3,.02,"DT" )
  2090   3180206
  2091   "^DD",33,3 3,.03,0)
  2092   VBA ADJUDI CATION^S^0 :NOT COMPL ETED;1:COM PLETED;^0; 3^Q
  2093   "^DD",33,3 3,.03,3)
  2094   Enter stat us of the  VBA adjudi cation for  the patie nt.
  2095   "^DD",33,3 3,.03,21,0 )
  2096   ^^1^1^3180 207^
  2097   "^DD",33,3 3,.03,21,1 ,0)
  2098   Status of  the VBA ad judication  for the p atient.
  2099   "^DD",33,3 3,.03,"DT" )
  2100   3180207
  2101   "^DD",33,3 3,.04,0)
  2102   CREATED BY ^P200'^VA( 200,^0;4^Q
  2103   "^DD",33,3 3,.04,3)
  2104   Enter the  user who c reated the  OTH clock  for the p atient.
  2105   "^DD",33,3 3,.04,21,0 )
  2106   ^^1^1^3180 206^
  2107   "^DD",33,3 3,.04,21,1 ,0)
  2108   The user w ho created  the OTH c lock for t he patient .
  2109   "^DD",33,3 3,.04,"DT" )
  2110   3180206
  2111   "^DD",33,3 3,.05,0)
  2112   DATE CREAT ED^D^^0;5^ S %DT="EST X" D ^%DT  S X=Y K:Y< 1 X
  2113   "^DD",33,3 3,.05,3)
  2114   Enter date  and time  the clock  was create d.
  2115   "^DD",33,3 3,.05,21,0 )
  2116   ^^1^1^3180 206^
  2117   "^DD",33,3 3,.05,21,1 ,0)
  2118   The date a nd time wh en the clo ck was cre ated.
  2119   "^DD",33,3 3,.05,"DT" )
  2120   3180206
  2121   "^DD",33,3 3,1,0)
  2122   OTH 365 DA YS CLOCK^3 3.01^^1;0
  2123   "^DD",33,3 3,1,21,0)
  2124   ^.001^1^1^ 3180207^^^ ^
  2125   "^DD",33,3 3,1,21,1,0 )
  2126   This multi ple contai ns data fo r tracking  365 days  clock stat us.
  2127   "^DD",33,3 3,1,"DT")
  2128   3180207
  2129   "^DD",33,3 3.01,0)
  2130   OTH 365 DA YS CLOCK S UB-FIELD^^ .06^7
  2131   "^DD",33,3 3.01,0,"DT ")
  2132   3180207
  2133   "^DD",33,3 3.01,0,"IX ","B",33.0 1,.01)
  2134  
  2135   "^DD",33,3 3.01,0,"NM ","OTH 365  DAYS CLOC K")
  2136  
  2137   "^DD",33,3 3.01,0,"UP ")
  2138   33
  2139   "^DD",33,3 3.01,.01,0 )
  2140   365 DAYS P ERIOD NUMB ER^MNJ3,0^ ^0;1^K:+X' =X!(X>100) !(X<1)!(X? .E1"."1N.N ) X
  2141   "^DD",33,3 3.01,.01,1 ,0)
  2142   ^.1
  2143   "^DD",33,3 3.01,.01,1 ,1,0)
  2144   33.01^B
  2145   "^DD",33,3 3.01,.01,1 ,1,1)
  2146   S ^DGOTH(3 3,DA(1),1, "B",$E(X,1 ,30),DA)=" "
  2147   "^DD",33,3 3.01,.01,1 ,1,2)
  2148   K ^DGOTH(3 3,DA(1),1, "B",$E(X,1 ,30),DA)
  2149   "^DD",33,3 3.01,.01,3 )
  2150   Type a num ber betwee n 1 and 10 0.
  2151   "^DD",33,3 3.01,.01,2 1,0)
  2152   ^^2^2^3180 207^
  2153   "^DD",33,3 3.01,.01,2 1,1,0)
  2154   This the s equential  number of  the OTH el igibility  365 days c lock for 
  2155   "^DD",33,3 3.01,.01,2 1,2,0)
  2156   the patien t.
  2157   "^DD",33,3 3.01,.01," DT")
  2158   3180206
  2159   "^DD",33,3 3.01,.02,0 )
  2160   START DATE ^D^^0;2^S  %DT="EX" D  ^%DT S X= Y K:Y<1 X
  2161   "^DD",33,3 3.01,.02,3 )
  2162   Enter the  date when  the 365 da ys clock s tarted.
  2163   "^DD",33,3 3.01,.02,2 1,0)
  2164   ^.001^1^1^ 3180206^^^
  2165   "^DD",33,3 3.01,.02,2 1,1,0)
  2166   Date when  the 365 da ys clock s tarted.
  2167   "^DD",33,3 3.01,.02," DT")
  2168   3180206
  2169   "^DD",33,3 3.01,.03,0 )
  2170   AUTHORIZED  BY^P200'^ VA(200,^0; 3^Q
  2171   "^DD",33,3 3.01,.03,3 )
  2172   Enter the  user who a uthorized  the 365 da ys period.
  2173   "^DD",33,3 3.01,.03,2 1,0)
  2174   ^^1^1^3180 206^
  2175   "^DD",33,3 3.01,.03,2 1,1,0)
  2176   The user w ho authori zed the 36 5 days per iod.
  2177   "^DD",33,3 3.01,.03," DT")
  2178   3180206
  2179   "^DD",33,3 3.01,.04,0 )
  2180   DATE AUTHO RIZED^D^^0 ;4^S %DT=" ESTX" D ^% DT S X=Y K :Y<1 X
  2181   "^DD",33,3 3.01,.04,3 )
  2182   Enter date  and time  the 365 da ys clock w as authori zed.
  2183   "^DD",33,3 3.01,.04,2 1,0)
  2184   ^^1^1^3180 206^
  2185   "^DD",33,3 3.01,.04,2 1,1,0)
  2186   The date a nd time wh en the 365  days cloc k was auth orized.
  2187   "^DD",33,3 3.01,.04," DT")
  2188   3180206
  2189   "^DD",33,3 3.01,.05,0 )
  2190   ENTERED OR  EDITED BY ^P200'^VA( 200,^0;5^Q
  2191   "^DD",33,3 3.01,.05,3 )
  2192   Enter the  user who c reated or  edited las t time the  365 days  clock.
  2193   "^DD",33,3 3.01,.05,2 1,0)
  2194   ^^1^1^3180 206^
  2195   "^DD",33,3 3.01,.05,2 1,1,0)
  2196   The user w ho created  or edited  last time  the 365 d ays clock.
  2197   "^DD",33,3 3.01,.05," DT")
  2198   3180206
  2199   "^DD",33,3 3.01,.06,0 )
  2200   DATE ENTER ED OR EDIT ED^D^^0;6^ S %DT="EST X" D ^%DT  S X=Y K:Y< 1 X
  2201   "^DD",33,3 3.01,.06,3 )
  2202   Enter the  date and t ime when t he 365 day s clock wa s entered  or edited  last time.
  2203   "^DD",33,3 3.01,.06,2 1,0)
  2204   ^^1^1^3180 206^
  2205   "^DD",33,3 3.01,.06,2 1,1,0)
  2206   The date a nd time wh en the 365  days cloc k was ente red or edi ted last t ime.
  2207   "^DD",33,3 3.01,.06," DT")
  2208   3180206
  2209   "^DD",33,3 3.01,1,0)
  2210   OTH 90 DAY S CLOCK^33 .11^^1;0
  2211   "^DD",33,3 3.01,1,21, 0)
  2212   ^.001^1^1^ 3180207^^^ ^
  2213   "^DD",33,3 3.01,1,21, 1,0)
  2214   This multi ple contai ns data fo r tracking  90 days c lock statu s.
  2215   "^DD",33,3 3.01,1,"DT ")
  2216   3180207
  2217   "^DD",33,3 3.11,0)
  2218   OTH 90 DAY S CLOCK SU B-FIELD^^. 06^6
  2219   "^DD",33,3 3.11,0,"DT ")
  2220   3180207
  2221   "^DD",33,3 3.11,0,"IX ","B",33.1 1,.01)
  2222  
  2223   "^DD",33,3 3.11,0,"NM ","OTH 90  DAYS CLOCK ")
  2224  
  2225   "^DD",33,3 3.11,0,"UP ")
  2226   33.01
  2227   "^DD",33,3 3.11,.01,0 )
  2228   90 DAYS PE RIOD NUMBE R^MNJ1,0^^ 0;1^K:+X'= X!(X>2)!(X <1)!(X?.E1 "."1N.N) X
  2229   "^DD",33,3 3.11,.01,1 ,0)
  2230   ^.1
  2231   "^DD",33,3 3.11,.01,1 ,1,0)
  2232   33.11^B
  2233   "^DD",33,3 3.11,.01,1 ,1,1)
  2234   S ^DGOTH(3 3,DA(2),1, DA(1),1,"B ",$E(X,1,3 0),DA)=""
  2235   "^DD",33,3 3.11,.01,1 ,1,2)
  2236   K ^DGOTH(3 3,DA(2),1, DA(1),1,"B ",$E(X,1,3 0),DA)
  2237   "^DD",33,3 3.11,.01,3 )
  2238   Enter the  sequential  number of  the OTH e ligibility  90 days c lock.
  2239   "^DD",33,3 3.11,.01,2 1,0)
  2240   ^^2^2^3180 207^
  2241   "^DD",33,3 3.11,.01,2 1,1,0)
  2242   This the s equential  number of  the OTH el igibility  90 days cl ock for 
  2243   "^DD",33,3 3.11,.01,2 1,2,0)
  2244   the patien t.
  2245   "^DD",33,3 3.11,.01," DT")
  2246   3180207
  2247   "^DD",33,3 3.11,.02,0 )
  2248   START DATE ^D^^0;2^S  %DT="EX" D  ^%DT S X= Y K:Y<1 X
  2249   "^DD",33,3 3.11,.02,3 )
  2250   Enter the  date when  the 90 day s clock st arted.
  2251   "^DD",33,3 3.11,.02,2 1,0)
  2252   ^^1^1^3180 206^
  2253   "^DD",33,3 3.11,.02,2 1,1,0)
  2254   Date when  the 90 day s clock st arted.
  2255   "^DD",33,3 3.11,.02," DT")
  2256   3180206
  2257   "^DD",33,3 3.11,.03,0 )
  2258   AUTHORIZED  BY^P200'^ VA(200,^0; 3^Q
  2259   "^DD",33,3 3.11,.03,3 )
  2260   Enter the  user who a uthorized  the 90 day s period.
  2261   "^DD",33,3 3.11,.03,2 1,0)
  2262   ^^1^1^3180 206^
  2263   "^DD",33,3 3.11,.03,2 1,1,0)
  2264   The user w ho authori zed the 90  days peri od.
  2265   "^DD",33,3 3.11,.03," DT")
  2266   3180206
  2267   "^DD",33,3 3.11,.04,0 )
  2268   DATE AUTHO RIZED^D^^0 ;4^S %DT=" ESTX" D ^% DT S X=Y K :Y<1 X
  2269   "^DD",33,3 3.11,.04,3 )
  2270   Enter date  and time  the 90 day s clock wa s authoriz ed.
  2271   "^DD",33,3 3.11,.04,2 1,0)
  2272   ^^1^1^3180 206^
  2273   "^DD",33,3 3.11,.04,2 1,1,0)
  2274   The date a nd time wh en the 90  days clock  was autho rized.
  2275   "^DD",33,3 3.11,.04," DT")
  2276   3180206
  2277   "^DD",33,3 3.11,.05,0 )
  2278   ENTERED OR  EDITED BY ^P200'^VA( 200,^0;5^Q
  2279   "^DD",33,3 3.11,.05,3 )
  2280   Enter the  user who c reated or  edited las t time the  90 days c lock.
  2281   "^DD",33,3 3.11,.05,2 1,0)
  2282   ^^1^1^3180 206^
  2283   "^DD",33,3 3.11,.05,2 1,1,0)
  2284   The user w ho created  or edited  last time  the 90 da ys clock.
  2285   "^DD",33,3 3.11,.05," DT")
  2286   3180206
  2287   "^DD",33,3 3.11,.06,0 )
  2288   DATE ENTER ED OR EDIT ED^D^^0;6^ S %DT="EST X" D ^%DT  S X=Y K:Y< 1 X
  2289   "^DD",33,3 3.11,.06,3 )
  2290   Enter the  date and t ime when t he 90 days  clock was  entered o r edited l ast time.
  2291   "^DD",33,3 3.11,.06,2 1,0)
  2292   ^^1^1^3180 206^
  2293   "^DD",33,3 3.11,.06,2 1,1,0)
  2294   The date a nd time wh en the 90  days clock  was enter ed or edit ed last ti me.
  2295   "^DD",33,3 3.11,.06," DT")
  2296   3180206
  2297   "^DIC",8.1 ,8.1,0)
  2298   MAS ELIGIB ILITY CODE ^8.1I
  2299   "^DIC",8.1 ,8.1,0,"GL ")
  2300   ^DIC(8.1,
  2301   "^DIC",8.1 ,8.1,"%D", 0)
  2302   ^1.001^12^ 12^3171227 ^^^^
  2303   "^DIC",8.1 ,8.1,"%D", 1,0)
  2304   The MAS EL IGIBILITY  CODE file  consists o f those co des which  have been
  2305   "^DIC",8.1 ,8.1,"%D", 2,0)
  2306   establishe d by  DNS     MAS.    Currently  there are  18 eligibi lity codes
  2307   "^DIC",8.1 ,8.1,"%D", 3,0)
  2308   in use by  the Dept o f Veterans  Affairs.   Addition  to this fi le of
  2309   "^DIC",8.1 ,8.1,"%D", 4,0)
  2310   local code s or modif ication of  those cod es distrib uted by th e MAS
  2311   "^DIC",8.1 ,8.1,"%D", 5,0)
  2312   package de velopers c ould have  a negative  impact on  the perfo rmance
  2313   "^DIC",8.1 ,8.1,"%D", 6,0)
  2314   of the MAS  module as  well as o ther modul es.
  2315   "^DIC",8.1 ,8.1,"%D", 7,0)
  2316    
  2317   "^DIC",8.1 ,8.1,"%D", 8,0)
  2318   If local c odes are d esired, th e site can  enter the m in
  2319   "^DIC",8.1 ,8.1,"%D", 9,0)
  2320   the ELIGIB ILITY CODE  file (#8) .  Each co de entered  in
  2321   "^DIC",8.1 ,8.1,"%D", 10,0)
  2322   the ELIGIB ILITY CODE  file must  point to  an entry i n
  2323   "^DIC",8.1 ,8.1,"%D", 11,0)
  2324   MAS ELIGIB ILITY CODE  file via  the MAS EL IGIBILITY  CODE
  2325   "^DIC",8.1 ,8.1,"%D", 12,0)
  2326   field.
  2327   "^DIC",8.1 ,"B","MAS  ELIGIBILIT Y CODE",8. 1)
  2328  
  2329   "^DIC",33, 33,0)
  2330   OTH ELIGIB ILITY CLOC K^33
  2331   "^DIC",33, 33,0,"GL")
  2332   ^DGOTH(33,
  2333   "^DIC",33, 33,"%",0)
  2334   ^1.005^^0
  2335   "^DIC",33, 33,"%D",0)
  2336   ^1.001^3^3 ^3180207^^
  2337   "^DIC",33, 33,"%D",1, 0)
  2338   This file  contains d ata requir ed for tra cking the  status of  the 
  2339   "^DIC",33, 33,"%D",2, 0)
  2340   eligibilit y for emer gency Ment al Health  care for p atients wi th Other T han 
  2341   "^DIC",33, 33,"%D",3, 0)
  2342   Honorable  Discharge  type.
  2343   "^DIC",33, "B","OTH E LIGIBILITY  CLOCK",33 )
  2344  
  2345   **END**
  2346   **END**